Mercurial > hg > skillbot
comparison skillbot.pl @ 5:dddb84241032
Bot can now read skills from the API for its friends
author | Dominic Cleal <dominic@computerkb.co.uk> |
---|---|
date | Sat, 06 Dec 2008 14:48:58 +0000 |
parents | 19e0bf2f7ada |
children | 6b73a2781c15 |
comparison
equal
deleted
inserted
replaced
4:5cba712b27aa | 5:dddb84241032 |
---|---|
2 | 2 |
3 # vim:set ts=4 shiftwidth=4 cindent: | 3 # vim:set ts=4 shiftwidth=4 cindent: |
4 | 4 |
5 =pod | 5 =pod |
6 | 6 |
7 twitfolk | 7 skillbot |
8 | 8 |
9 Gate tweets from your Twitter friends into an IRC channel. Currently can be | 9 Provides notifications of EVE Online skill completions over IRC. |
10 found on irc://irc.bitfolk.com/bitfolk as the user "Twitfolk". | 10 |
11 Based on Andy Smith's twitfolk bot: | |
12 $Id: twitfolk.pl 802 2008-11-29 00:07:38Z andy $ | |
11 | 13 |
12 Copyright ©2008 Andy Smith <andy+twitfolk.pl@bitfolk.com> | 14 Copyright ©2008 Andy Smith <andy+twitfolk.pl@bitfolk.com> |
15 Portions copyright ©2008 Dominic Cleal <dominic@computerkb.co.uk> | |
13 | 16 |
14 Artistic license same as Perl. | 17 Artistic license same as Perl. |
15 | |
16 $Id: twitfolk.pl 802 2008-11-29 00:07:38Z andy $ | |
17 =cut | 18 =cut |
18 | 19 |
19 use strict; | 20 use strict; |
20 use warnings; | 21 use warnings; |
21 | 22 |
22 use Net::Twitter; | 23 use WebService::EveOnline; |
23 use Data::Dumper; | 24 use Data::Dumper; |
24 use Net::IRC; | 25 use Net::IRC; |
25 use HTML::Entities; | 26 use HTML::Entities; |
26 use POSIX; | 27 use POSIX; |
27 use Encode; | 28 use Encode; |
31 # Config variables | 32 # Config variables |
32 my %config; | 33 my %config; |
33 | 34 |
34 my %friends; | 35 my %friends; |
35 | 36 |
36 my $last_tweet = 0; | 37 open(CONFIG, "< skillbot.conf") or die "can't open skillbot.conf for reading: $!"; |
37 | |
38 open(CONFIG, "< twitfolk.conf") or die "can't open twitfolk.conf for reading: $!"; | |
39 while(<CONFIG>) { | 38 while(<CONFIG>) { |
40 chomp; | 39 chomp; |
41 s/#.*//; | 40 s/#.*//; |
42 s/^\s+//; | 41 s/^\s+//; |
43 s/\s+$//; | 42 s/\s+$//; |
44 next unless length; | 43 next unless length; |
45 my ($var, $value) = split(/\s*=\s*/, $_, 2); | 44 my ($var, $value) = split(/\s*=\s*/, $_, 2); |
46 $config{$var} = $value; | 45 $config{$var} = $value; |
47 } | 46 } |
48 close(CONFIG) or die "can't close twitfolk.conf: $!"; | 47 close(CONFIG) or die "can't close skillbot.conf: $!"; |
49 | 48 |
50 my $version = '0.00001'; | 49 my $version = '0.01'; |
51 my $ircname = "twitfolk v$version"; | 50 my $ircname = "skillbot v$version"; |
52 | 51 |
53 my $DEBUG = $ENV{'IRC_DEBUG'} || 0; | 52 my $DEBUG = $ENV{'IRC_DEBUG'} || 0; |
54 my $time_to_die = 0; | 53 my $time_to_die = 0; |
55 | 54 |
56 justme(); | 55 justme(); |
58 | 57 |
59 open(PIDFILE, "> $config{'pidfile'}") or die "can't write $config{'pidfile'}: $!"; | 58 open(PIDFILE, "> $config{'pidfile'}") or die "can't write $config{'pidfile'}: $!"; |
60 print PIDFILE "$$\n"; | 59 print PIDFILE "$$\n"; |
61 close(PIDFILE) or die "can't close $config{'pidfile'}: $!"; | 60 close(PIDFILE) or die "can't close $config{'pidfile'}: $!"; |
62 | 61 |
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); | 62 update_friends(undef); |
73 | |
74 $last_tweet = init_last_tweet(); | |
75 | 63 |
76 my $irc = new Net::IRC; | 64 my $irc = new Net::IRC; |
77 | 65 |
78 my $conn = $irc->newconn(Server => $config{'target_server'}, | 66 my $conn = $irc->newconn(Server => $config{'target_server'}, |
79 Port => $config{'target_port'}, | 67 Port => $config{'target_port'}, |
142 | 130 |
143 # Check we are in the right channels every 10 minutes | 131 # Check we are in the right channels every 10 minutes |
144 add_repeat_timer(600, sub { my ($timer, $self) = @_; join_channels($self); }); | 132 add_repeat_timer(600, sub { my ($timer, $self) = @_; join_channels($self); }); |
145 | 133 |
146 # Read the "friends" config file every 6 minutes and make sure we have | 134 # Read the "friends" config file every 6 minutes and make sure we have |
147 # friended them all | 135 # API sessions for them all |
148 add_repeat_timer(360, sub { my ($timer, $self) = @_; update_friends($self); }); | 136 add_repeat_timer(360, sub { my ($timer, $self) = @_; update_friends($self); }); |
149 | 137 |
150 # Ask Twitter who our friends are every hour and make sure they are | 138 # Check for new skills every 5 minutes. |
151 # known to us | 139 add_repeat_timer(300, sub { my ($timer, $self) = @_; check_training($self); }); |
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 } | 140 } |
158 | 141 |
159 sub nickserv_id_now | 142 sub nickserv_id_now |
160 { | 143 { |
161 my ($self) = shift; | 144 my ($self) = shift; |
200 $twit->update("In channel, checking for tweets"); | 183 $twit->update("In channel, checking for tweets"); |
201 $twit->http_code == 200 or print sprintf("%s| *** %s\n", scalar gmtime(), $twit->http_message); | 184 $twit->http_code == 200 or print sprintf("%s| *** %s\n", scalar gmtime(), $twit->http_message); |
202 =cut | 185 =cut |
203 | 186 |
204 # Now we're in, check for tweets as a one-off | 187 # Now we're in, check for tweets as a one-off |
205 add_one_shot_timer(10, sub { my ($timer, $self) = @_; check_tweets($self); }); | 188 add_one_shot_timer(10, sub { my ($timer, $self) = @_; check_training($self); }); |
206 } | 189 } |
207 } | 190 } |
208 | 191 |
209 sub on_ping | 192 sub on_ping |
210 { | 193 { |
345 =pod | 328 =pod |
346 | 329 |
347 Read a list of friends from the friends_file. These will be friended in | 330 Read a list of friends from the friends_file. These will be friended in |
348 Twitter if they aren't already. Format is: | 331 Twitter if they aren't already. Format is: |
349 | 332 |
350 screen_name IRC_nick | 333 character_name user_id api_key IRC_nick |
351 | 334 |
352 Start a line with # for a comment. Any kind of white space is okay. | 335 Start a line with # for a comment. Columns must be tab separated. |
353 | 336 |
354 =cut | 337 =cut |
355 sub update_friends | 338 sub update_friends |
356 { | 339 { |
357 my $self = shift; | 340 my $self = shift; |
359 open(FF, "< $config{friends_file}") or die "Couldn't open friends_file: $!"; | 342 open(FF, "< $config{friends_file}") or die "Couldn't open friends_file: $!"; |
360 | 343 |
361 while (<FF>) { | 344 while (<FF>) { |
362 next if (/^#/); | 345 next if (/^#/); |
363 | 346 |
364 if (/^(\S+)\s+(\S+)/) { | 347 if (/^([^\t]+)\t+([0-9]+)\t+([A-F0-9]{64})\t+([^\t]+)/i) { |
365 my $f = lc($1); | 348 my $c = $1; |
366 my $nick = $2; | 349 my $uid = $2; |
367 | 350 my $key = uc($3); |
368 if (! $friends{$f}) { | 351 my $nick = $4; |
369 my $u = $twit->show_user($f); | 352 |
370 | 353 if (! $friends{$c}) { |
371 if ($twit->http_code != 200) { | 354 my $api = WebService::EveOnline->new( { user_id => $uid, |
372 irc_debug("twitter->show_user(%s) failed: %s", $f, | 355 api_key => $key } ); |
373 $twit->http_message); | 356 |
357 foreach my $character ($api->characters) { | |
358 next if $c ne $character->name; | |
359 $friends{$c}->{char} = $character; | |
360 last; | |
361 } | |
362 | |
363 unless (defined $friends{$c}->{char}) | |
364 { | |
365 irc_debug("EVE: Unable to find character %s for ID %lu", | |
366 $c, $uid); | |
374 next; | 367 next; |
375 } | 368 } |
376 | 369 |
377 my $id = $u->{id}; | 370 $friends{$c}->{api} = $api; |
378 $friends{$f}->{id} = $id; | 371 |
379 | 372 irc_debug("EVE: Adding new friend '%s' =~ %s", $c, $nick); |
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 } | 373 } |
390 | 374 |
391 $friends{$f}->{nick} = $nick; | 375 $friends{$c}->{nick} = $nick; |
392 } | 376 } |
393 } | 377 } |
394 | 378 |
395 close(FF) or warn "Something weird when closing friends_file: $!"; | 379 close(FF) or warn "Something weird when closing friends_file: $!"; |
396 } | 380 } |
397 | 381 |
398 =pod | 382 =pod |
399 | 383 |
400 Learn friends from those already added in Twitter, just in case they got added | 384 Check for any characters that aren't known to be training, then call the API |
401 from outside as well. Might make this update the friends file at some point. | 385 to see if they've started, setting timers. |
402 | 386 |
403 =cut | 387 =cut |
404 sub sync_friends | 388 sub check_training |
405 { | 389 { |
406 my $self = shift; | 390 my $self = shift; |
407 | 391 |
408 my $twitter_friends = $twit->friends({ | 392 foreach my $f (keys %friends) { |
409 id => $config{twitter_id} | 393 # Skip skills training that we've learnt about |
410 }); | 394 next if defined $friends{$f}->{skill}; |
411 | 395 |
412 if ($twit->http_code != 200) { | 396 my $skill = $friends{$f}->{char}->skill->in_training; |
413 irc_debug("twitter->friends() failed: %s", $twit->http_message); | 397 # Nothing training |
414 return; | 398 next unless $skill; |
415 } | 399 |
416 | 400 irc_debug("Character %s is training %s (%s)", |
417 foreach my $f (@{ $twitter_friends }) { | 401 $friends{$f}->{char}->name, $skill->name, |
418 my $screen_name = lc($f->{screen_name}); | 402 $skill->time_remaining); |
419 my $id = $f->{id}; | 403 |
420 | 404 my $text = $skill->name; |
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]/) { | 405 if ($text =~ /[\n\r]/) { |
548 irc_debug("Tweet %lu contains dangerous characters; removing!", | |
549 $tweet->{id}); | |
550 $text =~ s/[\n\r]/ /g; | 406 $text =~ s/[\n\r]/ /g; |
551 } | 407 } |
552 | 408 |
553 $self->notice('#' . $config{channel}, sprintf("[%s] %s", $nick, | 409 $self->notice('#' . $config{channel}, sprintf("[%s] %s", $friends{$f}->{nick}, |
554 encode("utf8", $text))); | 410 encode("utf8", $text))); |
555 | 411 } |
556 # Save the highest (most recent) id for next time | 412 } |
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 | 413 |
610 END { | 414 END { |
611 cleanup_and_die(); | 415 cleanup_and_die(); |
612 } | 416 } |