Mercurial > hg > skillbot
view 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 |
line wrap: on
line source
#!/usr/bin/perl # vim:set ts=4 shiftwidth=4 cindent: =pod twitfolk Gate tweets from your Twitter friends into an IRC channel. Currently can be found on irc://irc.bitfolk.com/bitfolk as the user "Twitfolk". Copyright ©2008 Andy Smith <andy+twitfolk.pl@bitfolk.com> Artistic license same as Perl. $Id: twitfolk.pl 802 2008-11-29 00:07:38Z andy $ =cut use strict; use warnings; use Net::Twitter; use Data::Dumper; use Net::IRC; use HTML::Entities; use POSIX; use Encode; require 'timers.pl'; # Config variables my %config; my %friends; my $last_tweet = 0; open(CONFIG, "< twitfolk.conf") or die "can't open twitfolk.conf for reading: $!"; while(<CONFIG>) { chomp; s/#.*//; s/^\s+//; s/\s+$//; next unless length; my ($var, $value) = split(/\s*=\s*/, $_, 2); $config{$var} = $value; } close(CONFIG) or die "can't close twitfolk.conf: $!"; my $version = '0.00001'; my $ircname = "twitfolk v$version"; my $DEBUG = $ENV{'IRC_DEBUG'} || 0; my $time_to_die = 0; justme(); daemonize(); open(PIDFILE, "> $config{'pidfile'}") or die "can't write $config{'pidfile'}: $!"; print PIDFILE "$$\n"; close(PIDFILE) or die "can't close $config{'pidfile'}: $!"; my $twit = Net::Twitter->new(username => $config{twitter_user}, password => $config{twitter_pass}); die "Can't connect to Twitter: $!" unless $twit; #$twit->update(sprintf("Connecting to irc://%s/", $config{target_server})); #$twit->http_code == 200 or die "Twitter->update: $twit->http_message()"; sync_friends(undef); update_friends(undef); $last_tweet = init_last_tweet(); my $irc = new Net::IRC; my $conn = $irc->newconn(Server => $config{'target_server'}, Port => $config{'target_port'}, Nick => $config{'nick'}, Ircname => $ircname, Username => $config{'username'}, Password => $config{'target_pass'}) or die "can't connect to $config{'target_server'}:$config{'target_port'}: $@\n"; binmode $conn->{_socket}, ":bytes"; init_handlers($conn); init_timers(); until ($time_to_die) { $irc->do_one_loop(); do_timers_once($conn); do_timers_repeat($conn); } if ($conn) { $conn->quit("Caught SIGINT, bye."); } cleanup_and_die(); sub cleanup_and_die { unlink($config{'pidfile'}); exit(); } sub init_handlers { my ($self) = shift; $self->add_handler('notice', \&on_notice); $self->add_handler([ 251,252,253,254,302,255 ], \&on_init); $self->add_handler('disconnect', \&on_disconnect); $self->add_handler(376, \&on_connect); $self->add_handler(433, \&on_nick_taken); $self->add_handler('cversion', \&on_cversion); $self->add_handler('cping', \&on_ping); $self->add_handler('join', \&on_join); } sub irc_debug { my ($fmt, @args) = @_; return unless $DEBUG; $fmt = '%s| *** ' . $fmt . "\n"; print sprintf($fmt, scalar gmtime(), @args); } =pod Timers to set going when we start. =cut sub init_timers { # Join channels fort eh first time, ~15 secs after connect add_one_shot_timer(15, sub { my ($timer, $self) = @_; join_channels($self); }); # Check we are in the right channels every 10 minutes add_repeat_timer(600, sub { my ($timer, $self) = @_; join_channels($self); }); # Read the "friends" config file every 6 minutes and make sure we have # friended them all add_repeat_timer(360, sub { my ($timer, $self) = @_; update_friends($self); }); # Ask Twitter who our friends are every hour and make sure they are # known to us add_repeat_timer(3600, sub { my ($timer, $self) = @_; sync_friends($self); }); # Check for new tweets every 5 minutes. API allows 100 calls every 60 # minutes so should be okay add_repeat_timer(300, sub { my ($timer, $self) = @_; check_tweets($self); }); } sub nickserv_id_now { my ($self) = shift; $self->privmsg("NickServ", sprintf("IDENTIFY %s", $config{nick_pass})); } sub nickserv_release { my ($self) = shift; $self->privmsg("NickServ", sprintf("RELEASE %s %s", $config{nick}, $config{nick_pass})); } sub on_connect { my $self = shift; =pod $twit->update(sprintf("Connected to irc://%s/, joining channels", $config{target_server})); $twit->http_code == 200 or print sprintf("%s| *** %s\n", scalar gmtime(), $twit->http_message); =cut $self->away($config{away}) if ($config{away}); join_channels($self); } sub join_channels { my $self = shift; $self->join('#' . $config{channel}); } sub on_join { my ($self, $event) = @_; # print Dumper($event); if ($event->nick eq $config{nick}) { =pod $twit->update("In channel, checking for tweets"); $twit->http_code == 200 or print sprintf("%s| *** %s\n", scalar gmtime(), $twit->http_message); =cut # Now we're in, check for tweets as a one-off add_one_shot_timer(10, sub { my ($timer, $self) = @_; check_tweets($self); }); } } sub on_ping { my ($self, $event) = @_; my $their_nick = $event->nick; $self->ctcp_reply($their_nick, "PING " . join (' ', ($event->args))); } sub on_init { my ($self, $event) = @_; my (@args) = ($event->args); shift (@args); # irc_debug(@args); } sub on_disconnect { my ($self, $event) = @_; irc_debug("Disconnected from %s (%s). Attempting to reconnect...", $event->from, ($event->args())[0]); while (! $self->connect()) { irc_debug("%s", $@); } } sub on_notice { my ($self, $event) = @_; my ($their_nick) = $event->nick; my ($notice_txt) = join(' ', $event->args); $_ = $their_nick; irc_debug("Got notice from %s: %s", $_, $notice_txt); if (/^NickServ$/i) { do_nickserv_notice($self, $notice_txt); } } sub do_nickserv_notice { my ($self, $notice) = @_; $_ = $notice; if (/This nick is owned by someone else/ || /This nickname is registered and protected/i) { irc_debug("ID to NickServ at request of NickServ"); nickserv_id_now($self); } elsif (/Your nick has been recovered/i) { irc_debug("NickServ told me I recovered my nick, RELEASE'ing now"); nickserv_release($self); } elsif (/Your nick has been released from custody/i) { irc_debug("NickServ told me my nick is released, /nick'ing now"); $self->nick($config{nick}); } else { irc_debug("Ignoring NickServ notice: %s", $notice); } } sub on_nick_taken { my ($self) = shift; $self->nick($config{nick} . $$); nickserv_recover($self); } sub on_cversion { my ($self, $event) = @_; my $vstring = sprintf("VERSION twitfolk v%s " . "(\002grifferz\002 is responsible for this atrocity)", $version); $self->ctcp_reply($event->nick, $vstring); } sub justme { if (open(PIDFILE, "< $config{pidfile}")) { my $pid; chop($pid = <PIDFILE>); close(PIDFILE) or die "couldn't close $config{pidfile}: $1"; if (kill(0, $pid)) { print "$0 already running (pid $pid), bailing out\n"; cleanup_and_die(); } } } sub handle_sig_int_term { $time_to_die = 1; } =pod Splurge the perl error to IRC for the amusement of others. =cut sub handle_perl_death { die @_ if $^S; my $msg = shift; if ($conn) { $conn->quit($msg . ", died"); } } sub daemonize { $SIG{__DIE__} = \&handle_perl_death; $SIG{INT} = $SIG{TERM} = \&handle_sig_int_term; # Only daemonize if not running debug mode return if ($DEBUG); my $pid = fork(); exit if $pid; die "Couldn't fork: $!" unless defined($pid); close(STDOUT); close(STDERR); POSIX::setsid() or die "Can't start a new session: $!"; } =pod Read a list of friends from the friends_file. These will be friended in Twitter if they aren't already. Format is: screen_name IRC_nick Start a line with # for a comment. Any kind of white space is okay. =cut sub update_friends { my $self = shift; open(FF, "< $config{friends_file}") or die "Couldn't open friends_file: $!"; while (<FF>) { next if (/^#/); if (/^(\S+)\s+(\S+)/) { my $f = lc($1); my $nick = $2; if (! $friends{$f}) { my $u = $twit->show_user($f); if ($twit->http_code != 200) { irc_debug("twitter->show_user(%s) failed: %s", $f, $twit->http_message); next; } my $id = $u->{id}; $friends{$f}->{id} = $id; irc_debug("Twitter: Adding new friend '%s' (%lu)", $f, $id); $twit->create_friend($id); if ($twit->http_code != 200) { irc_debug("twitter-> create_friend($id) failed: %s", $twit->http_message); } } $friends{$f}->{nick} = $nick; } } close(FF) or warn "Something weird when closing friends_file: $!"; } =pod Learn friends from those already added in Twitter, just in case they got added from outside as well. Might make this update the friends file at some point. =cut sub sync_friends { my $self = shift; my $twitter_friends = $twit->friends({ id => $config{twitter_id} }); if ($twit->http_code != 200) { irc_debug("twitter->friends() failed: %s", $twit->http_message); return; } foreach my $f (@{ $twitter_friends }) { my $screen_name = lc($f->{screen_name}); my $id = $f->{id}; $friends{$screen_name}->{id} = $id; if (! defined $friends{$screen_name}->{nick}) { $friends{$screen_name}->{nick} = $screen_name; } irc_debug("Twitter: Already following '%s' (%lu)", $screen_name, $friends{$screen_name}->{id}); } } =pod Get a friends timeline and announce it to IRC. Only does $max at once and only requests 10 * $max from Twitter. =cut sub check_tweets { my $self = shift; my $tweets = undef; # Ask for 10 times as many tweets as we will ever say, but no more than # 200 my $max = $config{max_tweets} >= 20 ? 200 : $config{max_tweets} * 10; my $count = 0; # Ask for the timeline of friend's statuses, only since the last tweet # if we know its id if ($last_tweet != 0) { $tweets = $twit->friends_timeline({ since_id => $last_tweet, count => $max, }); } else { $tweets = $twit->friends_timeline({ count => $max, }); } if ($twit->http_code != 200) { irc_debug("twitter->friend_timelines() failed: %s", $twit->http_message); return; } =pod $tweets should now be a reference to an array of: { 'source' => 'web', 'favorited' => $VAR1->[0]{'favorited'}, 'truncated' => $VAR1->[0]{'favorited'}, 'created_at' => 'Tue Oct 28 22:22:14 +0000 2008', 'text' => '@deltafan121 Near Luton, which is just outside London.', 'user' => { 'location' => 'Bedfordshire, United Kingdom', 'followers_count' => 10, 'profile_image_url' => 'http://s3.amazonaws.com/twitter_production/profile_images/62344418/SP_A0089_2_normal.jpg', 'protected' => $VAR1->[0]{'favorited'}, 'name' => 'Robert Leverington', 'url' => 'http://robertleverington.com/', 'id' => 14450923, 'description' => '', 'screen_name' => 'roberthl' }, 'in_reply_to_user_id' => 14662919, 'id' => 979630447, 'in_reply_to_status_id' => 979535561 } =cut =pod But I guess we better check, since this happened one time at band camp: Tue Nov 18 07:58:41 2008| *** twitter->friend_timelines() failed: Can't connect to twitter.com:80 (connect: timeout) Tue Nov 18 08:03:41 2008| *** twitter->friend_timelines() failed: Can't connect to twitter.com:80 (connect: timeout) Tue Nov 18 08:08:50 2008| *** twitter->friend_timelines() failed: read timeout Tue Nov 18 08:13:41 2008| *** twitter->friend_timelines() failed: Can't connect to twitter.com:80 (connect: timeout) Tue Nov 18 08:18:41 2008| *** twitter->friend_timelines() failed: Can't connect to twitter.com:80 (connect: timeout) Tue Nov 18 08:23:43 2008| *** twitter->friend_timelines() failed: Can't connect to twitter.com:80 (connect: timeout) Not an ARRAY reference at ./twitfolk.pl line 494. =cut if (ref($tweets) ne "ARRAY") { irc_debug("twitter->friend_timelines() didn't return an arrayref!"); return; } irc_debug("Got %u new tweets", scalar @{ $tweets }); # Iterate through them all, sorted by id low to high foreach my $tweet (sort { $a->{id} <=> $b->{id} } @{ $tweets }) { if ($count >= $config{max_tweets}) { irc_debug("Already did %u tweets, stopping there", $count); last; } if (lc($tweet->{user}->{screen_name}) eq 'bitfolk') { irc_debug("Skipping tweet from myself"); next; } if ($tweet->{id} <= $last_tweet) { # Why does Twitter still return tweets that are <= since_id? irc_debug("Tweet %lu: ignored as somehow <= %lu !?", $tweet->{id}, $last_tweet); next; } my $screen_name = lc($tweet->{user}->{screen_name}); my $text = decode_entities($tweet->{text}); my $nick; if (! exists($friends{$screen_name})) { irc_debug("I don't have a nickname for Twitter user %s!", $screen_name); $nick = $screen_name; } else { $nick = $friends{$screen_name}->{nick}; } irc_debug("Tweet %lu: [%s] %s", $tweet->{id}, $screen_name, $text); if ($text =~ /[\n\r]/) { irc_debug("Tweet %lu contains dangerous characters; removing!", $tweet->{id}); $text =~ s/[\n\r]/ /g; } $self->notice('#' . $config{channel}, sprintf("[%s] %s", $nick, encode("utf8", $text))); # Save the highest (most recent) id for next time $last_tweet = $tweet->{id} if ($tweet->{id} > $last_tweet); $count++; } # Save the new id to the last_tweet file if there were any tweets update_last_tweet($last_tweet) if ($count); } =pod Read the last tweet id from a file so that no tweets should be repeated =cut sub init_last_tweet { return 0 if (! -f $config{tweet_id_file}); open(LT, "< $config{tweet_id_file}") or die "Couldn't open tweet_id_file: $!"; my $id = 0; while (<LT>) { if (/^(\d+)/) { $id = $1; last; } else { die "Weird format $_ in tweet_id_file"; } } close(LT) or warn "Something weird when closing tweet_id_file: $!"; irc_debug("Last tweet id = %lu", $id); return $id; } =pod Save the id of the most recent tweet so that it won't be repeated should the bot crash or whatever =cut sub update_last_tweet { my $id = shift; open(LT, "> $config{tweet_id_file}") or die "Couldn't open tweet_id_file: $!"; print LT "$id\n"; close(LT) or warn "Something weird when closing tweet_id_file: $!"; } END { cleanup_and_die(); }