Mercurial > hg > skillbot-df

comparison twitfolk.pl @ 0:d6521d5ea884

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import of Andy Smith's twitfolk bot
author Dominic Cleal <dominic@computerkb.co.uk>
date Sat, 06 Dec 2008 13:49:48 +0000
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:d6521d5ea884
1 #!/usr/bin/perl
2
3 # vim:set ts=4 shiftwidth=4 cindent:
4
5 =pod
6
7 twitfolk
8
9 Gate tweets from your Twitter friends into an IRC channel. Currently can be
10 found on irc://irc.bitfolk.com/bitfolk as the user "Twitfolk".
11
12 Copyright ©2008 Andy Smith <andy+twitfolk.pl@bitfolk.com>
13
14 Artistic license same as Perl.
15
16 $Id: twitfolk.pl 802 2008-11-29 00:07:38Z andy $
17 =cut
18
19 use strict;
20 use warnings;
21
22 use Net::Twitter;
23 use Data::Dumper;
24 use Net::IRC;
25 use HTML::Entities;
26 use POSIX;
27 use Encode;
28
29 require 'timers.pl';
30
31 # Config variables
32 my %config;
33
34 my %friends;
35
36 my $last_tweet = 0;
37
38 open(CONFIG, "< twitfolk.conf") or die "can't open twitfolk.conf for reading: $!";
39 while(<CONFIG>) {
40 chomp;
41 s/#.*//;
42 s/^\s+//;
43 s/\s+$//;
44 next unless length;
45 my ($var, $value) = split(/\s*=\s*/, $_, 2);
46 $config{$var} = $value;
47 }
48 close(CONFIG) or die "can't close twitfolk.conf: $!";
49
50 my $version = '0.00001';
51 my $ircname = "twitfolk v$version";
52
53 my $DEBUG = $ENV{'IRC_DEBUG'} || 0;
54 my $time_to_die = 0;
55
56 justme();
57 daemonize();
58
59 open(PIDFILE, "> $config{'pidfile'}") or die "can't write $config{'pidfile'}: $!";
60 print PIDFILE "$$\n";
61 close(PIDFILE) or die "can't close $config{'pidfile'}: $!";
62
63 my $twit = Net::Twitter->new(username => $config{twitter_user},
64 password => $config{twitter_pass});
65
66 die "Can't connect to Twitter: $!" unless $twit;
67
68 #$twit->update(sprintf("Connecting to irc://%s/", $config{target_server}));
69 #$twit->http_code == 200 or die "Twitter->update: $twit->http_message()";
70
71 sync_friends(undef);
72 update_friends(undef);
73
74 $last_tweet = init_last_tweet();
75
76 my $irc = new Net::IRC;
77
78 my $conn = $irc->newconn(Server => $config{'target_server'},
79 Port => $config{'target_port'},
80 Nick => $config{'nick'},
81 Ircname => $ircname,
82 Username => $config{'username'},
83 Password => $config{'target_pass'})
84 or die "can't connect to $config{'target_server'}:$config{'target_port'}: $@\n";
85
86 binmode $conn->{_socket}, ":bytes";
87
88 init_handlers($conn);
89 init_timers();
90
91 until ($time_to_die) {
92 $irc->do_one_loop();
93 do_timers_once($conn);
94 do_timers_repeat($conn);
95 }
96
97 if ($conn) {
98 $conn->quit("Caught SIGINT, bye.");
99 }
100
101 cleanup_and_die();
102
103 sub cleanup_and_die {
104 unlink($config{'pidfile'});
105 exit();
106 }
107
108 sub init_handlers
109 {
110 my ($self) = shift;
111
112 $self->add_handler('notice', \&on_notice);
113 $self->add_handler([ 251,252,253,254,302,255 ], \&on_init);
114 $self->add_handler('disconnect', \&on_disconnect);
115 $self->add_handler(376, \&on_connect);
116 $self->add_handler(433, \&on_nick_taken);
117 $self->add_handler('cversion', \&on_cversion);
118 $self->add_handler('cping', \&on_ping);
119 $self->add_handler('join', \&on_join);
120 }
121
122 sub irc_debug
123 {
124 my ($fmt, @args) = @_;
125
126 return unless $DEBUG;
127
128 $fmt = '%s| *** ' . $fmt . "\n";
129
130 print sprintf($fmt, scalar gmtime(), @args);
131 }
132
133 =pod
134
135 Timers to set going when we start.
136
137 =cut
138 sub init_timers
139 {
140 # Join channels fort eh first time, ~15 secs after connect
141 add_one_shot_timer(15, sub { my ($timer, $self) = @_; join_channels($self); });
142
143 # Check we are in the right channels every 10 minutes
144 add_repeat_timer(600, sub { my ($timer, $self) = @_; join_channels($self); });
145
146 # Read the "friends" config file every 6 minutes and make sure we have
147 # friended them all
148 add_repeat_timer(360, sub { my ($timer, $self) = @_; update_friends($self); });
149
150 # Ask Twitter who our friends are every hour and make sure they are
151 # known to us
152 add_repeat_timer(3600, sub { my ($timer, $self) = @_; sync_friends($self); });
153
154 # Check for new tweets every 5 minutes. API allows 100 calls every 60
155 # minutes so should be okay
156 add_repeat_timer(300, sub { my ($timer, $self) = @_; check_tweets($self); });
157 }
158
159 sub nickserv_id_now
160 {
161 my ($self) = shift;
162
163 $self->privmsg("NickServ", sprintf("IDENTIFY %s", $config{nick_pass}));
164 }
165
166 sub nickserv_release
167 {
168 my ($self) = shift;
169
170 $self->privmsg("NickServ", sprintf("RELEASE %s %s", $config{nick},
171 $config{nick_pass}));
172 }
173
174 sub on_connect
175 {
176 my $self = shift;
177
178 =pod
179 $twit->update(sprintf("Connected to irc://%s/, joining channels", $config{target_server}));
180 $twit->http_code == 200 or print sprintf("%s| *** %s\n", scalar gmtime(), $twit->http_message);
181 =cut
182
183 $self->away($config{away}) if ($config{away});
184 join_channels($self);
185 }
186
187 sub join_channels
188 {
189 my $self = shift;
190 $self->join('#' . $config{channel});
191 }
192
193 sub on_join
194 {
195 my ($self, $event) = @_;
196
197 # print Dumper($event);
198 if ($event->nick eq $config{nick}) {
199 =pod
200 $twit->update("In channel, checking for tweets");
201 $twit->http_code == 200 or print sprintf("%s| *** %s\n", scalar gmtime(), $twit->http_message);
202 =cut
203
204 # Now we're in, check for tweets as a one-off
205 add_one_shot_timer(10, sub { my ($timer, $self) = @_; check_tweets($self); });
206 }
207 }
208
209 sub on_ping
210 {
211 my ($self, $event) = @_;
212 my $their_nick = $event->nick;
213
214 $self->ctcp_reply($their_nick, "PING " . join (' ', ($event->args)));
215 }
216
217 sub on_init
218 {
219 my ($self, $event) = @_;
220 my (@args) = ($event->args);
221 shift (@args);
222
223 # irc_debug(@args);
224 }
225
226 sub on_disconnect
227 {
228 my ($self, $event) = @_;
229
230 irc_debug("Disconnected from %s (%s). Attempting to reconnect...",
231 $event->from, ($event->args())[0]);
232
233 while (! $self->connect()) {
234 irc_debug("%s", $@);
235 }
236 }
237
238 sub on_notice
239 {
240 my ($self, $event) = @_;
241 my ($their_nick) = $event->nick;
242 my ($notice_txt) = join(' ', $event->args);
243
244 $_ = $their_nick;
245
246 irc_debug("Got notice from %s: %s", $_, $notice_txt);
247
248 if (/^NickServ$/i) {
249 do_nickserv_notice($self, $notice_txt);
250 }
251 }
252
253 sub do_nickserv_notice
254 {
255 my ($self, $notice) = @_;
256
257 $_ = $notice;
258
259 if (/This nick is owned by someone else/ ||
260 /This nickname is registered and protected/i) {
261 irc_debug("ID to NickServ at request of NickServ");
262 nickserv_id_now($self);
263 } elsif (/Your nick has been recovered/i) {
264 irc_debug("NickServ told me I recovered my nick, RELEASE'ing now");
265 nickserv_release($self);
266 } elsif (/Your nick has been released from custody/i) {
267 irc_debug("NickServ told me my nick is released, /nick'ing now");
268 $self->nick($config{nick});
269 } else {
270 irc_debug("Ignoring NickServ notice: %s", $notice);
271 }
272 }
273
274 sub on_nick_taken
275 {
276 my ($self) = shift;
277
278 $self->nick($config{nick} . $$);
279 nickserv_recover($self);
280 }
281
282 sub on_cversion
283 {
284 my ($self, $event) = @_;
285
286 my $vstring = sprintf("VERSION twitfolk v%s " .
287 "(\002grifferz\002 is responsible for this atrocity)", $version);
288
289 $self->ctcp_reply($event->nick, $vstring);
290 }
291
292 sub justme
293 {
294 if (open(PIDFILE, "< $config{pidfile}")) {
295 my $pid;
296 chop($pid = <PIDFILE>);
297 close(PIDFILE) or die "couldn't close $config{pidfile}: $1";
298
299 if (kill(0, $pid)) {
300 print "$0 already running (pid $pid), bailing out\n";
301 cleanup_and_die();
302 }
303 }
304 }
305
306 sub handle_sig_int_term
307 {
308 $time_to_die = 1;
309 }
310
311 =pod
312
313 Splurge the perl error to IRC for the amusement of others.
314
315 =cut
316 sub handle_perl_death
317 {
318 die @_ if $^S;
319 my $msg = shift;
320
321 if ($conn) {
322 $conn->quit($msg . ", died");
323 }
324 }
325
326 sub daemonize
327 {
328 $SIG{__DIE__} = \&handle_perl_death;
329 $SIG{INT} = $SIG{TERM} = \&handle_sig_int_term;
330
331 # Only daemonize if not running debug mode
332 return if ($DEBUG);
333
334 my $pid = fork();
335
336 exit if $pid;
337 die "Couldn't fork: $!" unless defined($pid);
338
339 close(STDOUT);
340 close(STDERR);
341
342 POSIX::setsid() or die "Can't start a new session: $!";
343 }
344
345 =pod
346
347 Read a list of friends from the friends_file. These will be friended in
348 Twitter if they aren't already. Format is:
349
350 screen_name IRC_nick
351
352 Start a line with # for a comment. Any kind of white space is okay.
353
354 =cut
355 sub update_friends
356 {
357 my $self = shift;
358
359 open(FF, "< $config{friends_file}") or die "Couldn't open friends_file: $!";
360
361 while (<FF>) {
362 next if (/^#/);
363
364 if (/^(\S+)\s+(\S+)/) {
365 my $f = lc($1);
366 my $nick = $2;
367
368 if (! $friends{$f}) {
369 my $u = $twit->show_user($f);
370
371 if ($twit->http_code != 200) {
372 irc_debug("twitter->show_user(%s) failed: %s", $f,
373 $twit->http_message);
374 next;
375 }
376
377 my $id = $u->{id};
378 $friends{$f}->{id} = $id;
379
380 irc_debug("Twitter: Adding new friend '%s' (%lu)", $f,
381 $id);
382
383 $twit->create_friend($id);
384
385 if ($twit->http_code != 200) {
386 irc_debug("twitter-> create_friend($id) failed: %s",
387 $twit->http_message);
388 }
389 }
390
391 $friends{$f}->{nick} = $nick;
392 }
393 }
394
395 close(FF) or warn "Something weird when closing friends_file: $!";
396 }
397
398 =pod
399
400 Learn friends from those already added in Twitter, just in case they got added
401 from outside as well. Might make this update the friends file at some point.
402
403 =cut
404 sub sync_friends
405 {
406 my $self = shift;
407
408 my $twitter_friends = $twit->friends({
409 id => $config{twitter_id}
410 });
411
412 if ($twit->http_code != 200) {
413 irc_debug("twitter->friends() failed: %s", $twit->http_message);
414 return;
415 }
416
417 foreach my $f (@{ $twitter_friends }) {
418 my $screen_name = lc($f->{screen_name});
419 my $id = $f->{id};
420
421 $friends{$screen_name}->{id} = $id;
422
423 if (! defined $friends{$screen_name}->{nick}) {
424 $friends{$screen_name}->{nick} = $screen_name;
425 }
426
427 irc_debug("Twitter: Already following '%s' (%lu)", $screen_name,
428 $friends{$screen_name}->{id});
429 }
430
431 }
432
433 =pod
434
435 Get a friends timeline and announce it to IRC. Only does $max at once and only
436 requests 10 * $max from Twitter.
437
438 =cut
439 sub check_tweets
440 {
441 my $self = shift;
442 my $tweets = undef;
443
444 # Ask for 10 times as many tweets as we will ever say, but no more than
445 # 200
446 my $max = $config{max_tweets} >= 20 ? 200 : $config{max_tweets} * 10;
447 my $count = 0;
448
449 # Ask for the timeline of friend's statuses, only since the last tweet
450 # if we know its id
451 if ($last_tweet != 0) {
452 $tweets = $twit->friends_timeline({
453 since_id => $last_tweet,
454 count => $max,
455 });
456 } else {
457 $tweets = $twit->friends_timeline({
458 count => $max,
459 });
460 }
461
462 if ($twit->http_code != 200) {
463 irc_debug("twitter->friend_timelines() failed: %s",
464 $twit->http_message);
465 return;
466 }
467
468 =pod
469
470 $tweets should now be a reference to an array of:
471
472 {
473 'source' => 'web',
474 'favorited' => $VAR1->[0]{'favorited'},
475 'truncated' => $VAR1->[0]{'favorited'},
476 'created_at' => 'Tue Oct 28 22:22:14 +0000 2008',
477 'text' => '@deltafan121 Near Luton, which is just outside London.',
478 'user' => {
479 'location' => 'Bedfordshire, United Kingdom',
480 'followers_count' => 10,
481 'profile_image_url' => 'http://s3.amazonaws.com/twitter_production/profile_images/62344418/SP_A0089_2_normal.jpg',
482 'protected' => $VAR1->[0]{'favorited'},
483 'name' => 'Robert Leverington',
484 'url' => 'http://robertleverington.com/',
485 'id' => 14450923,
486 'description' => '',
487 'screen_name' => 'roberthl'
488 },
489 'in_reply_to_user_id' => 14662919,
490 'id' => 979630447,
491 'in_reply_to_status_id' => 979535561
492 }
493 =cut
494
495 =pod
496 But I guess we better check, since this happened one time at band camp:
497
498 Tue Nov 18 07:58:41 2008| *** twitter->friend_timelines() failed: Can't connect to twitter.com:80 (connect: timeout)
499 Tue Nov 18 08:03:41 2008| *** twitter->friend_timelines() failed: Can't connect to twitter.com:80 (connect: timeout)
500 Tue Nov 18 08:08:50 2008| *** twitter->friend_timelines() failed: read timeout
501 Tue Nov 18 08:13:41 2008| *** twitter->friend_timelines() failed: Can't connect to twitter.com:80 (connect: timeout)
502 Tue Nov 18 08:18:41 2008| *** twitter->friend_timelines() failed: Can't connect to twitter.com:80 (connect: timeout)
503 Tue Nov 18 08:23:43 2008| *** twitter->friend_timelines() failed: Can't connect to twitter.com:80 (connect: timeout)
504 Not an ARRAY reference at ./twitfolk.pl line 494.
505 =cut
506
507 if (ref($tweets) ne "ARRAY") {
508 irc_debug("twitter->friend_timelines() didn't return an arrayref!");
509 return;
510 }
511
512 irc_debug("Got %u new tweets", scalar @{ $tweets });
513
514 # Iterate through them all, sorted by id low to high
515 foreach my $tweet (sort { $a->{id} <=> $b->{id} } @{ $tweets }) {
516 if ($count >= $config{max_tweets}) {
517 irc_debug("Already did %u tweets, stopping there", $count);
518 last;
519 }
520
521 if (lc($tweet->{user}->{screen_name}) eq 'bitfolk') {
522 irc_debug("Skipping tweet from myself");
523 next;
524 }
525
526 if ($tweet->{id} <= $last_tweet) {
527 # Why does Twitter still return tweets that are <= since_id?
528 irc_debug("Tweet %lu: ignored as somehow <= %lu !?",
529 $tweet->{id}, $last_tweet);
530 next;
531 }
532
533 my $screen_name = lc($tweet->{user}->{screen_name});
534 my $text = decode_entities($tweet->{text});
535 my $nick;
536
537 if (! exists($friends{$screen_name})) {
538 irc_debug("I don't have a nickname for Twitter user %s!",
539 $screen_name);
540 $nick = $screen_name;
541 } else {
542 $nick = $friends{$screen_name}->{nick};
543 }
544
545 irc_debug("Tweet %lu: [%s] %s", $tweet->{id}, $screen_name, $text);
546
547 if ($text =~ /[\n\r]/) {
548 irc_debug("Tweet %lu contains dangerous characters; removing!",
549 $tweet->{id});
550 $text =~ s/[\n\r]/ /g;
551 }
552
553 $self->notice('#' . $config{channel}, sprintf("[%s] %s", $nick,
554 encode("utf8", $text)));
555
556 # Save the highest (most recent) id for next time
557 $last_tweet = $tweet->{id} if ($tweet->{id} > $last_tweet);
558 $count++;
559 }
560
561 # Save the new id to the last_tweet file if there were any tweets
562 update_last_tweet($last_tweet) if ($count);
563 }
564
565 =pod
566
567 Read the last tweet id from a file so that no tweets should be repeated
568
569 =cut
570 sub init_last_tweet
571 {
572 return 0 if (! -f $config{tweet_id_file});
573
574 open(LT, "< $config{tweet_id_file}") or die "Couldn't open tweet_id_file: $!";
575
576 my $id = 0;
577
578 while (<LT>) {
579 if (/^(\d+)/) {
580 $id = $1;
581 last;
582 } else {
583 die "Weird format $_ in tweet_id_file";
584 }
585 }
586
587 close(LT) or warn "Something weird when closing tweet_id_file: $!";
588
589 irc_debug("Last tweet id = %lu", $id);
590
591 return $id;
592 }
593
594 =pod
595
596 Save the id of the most recent tweet so that it won't be repeated should
597 the bot crash or whatever
598
599 =cut
600 sub update_last_tweet
601 {
602 my $id = shift;
603
604 open(LT, "> $config{tweet_id_file}") or die "Couldn't open tweet_id_file: $!";
605 print LT "$id\n";
606 close(LT) or warn "Something weird when closing tweet_id_file: $!";
607 }
608
609
610 END {
611 cleanup_and_die();
612 }