Mercurial > hg > skillbot
comparison skillbot.pl @ 1:19e0bf2f7ada
Renaming to skillbot
author | Dominic Cleal <dominic@computerkb.co.uk> |
---|---|
date | Sat, 06 Dec 2008 13:53:42 +0000 |
parents | twitfolk.pl@d6521d5ea884 |
children | dddb84241032 |
comparison
equal
deleted
inserted
replaced
0:d6521d5ea884 | 1:19e0bf2f7ada |
---|---|
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 } |