# HG changeset patch
# User Dominic Cleal <dominic@computerkb.co.uk>
# Date 1228571388 0
# Node ID d6521d5ea8843571f43963678ed0e51499031586

Import of Andy Smith's twitfolk bot

diff -r 000000000000 -r d6521d5ea884 timers.pl
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/timers.pl	Sat Dec 06 13:49:48 2008 +0000
@@ -0,0 +1,106 @@
+#!/usr/bin/perl
+
+=pod
+
+Braindead timers thing.
+
+Copyright ©2000 Andy Smith <andy+timers.pl@strugglers.net>
+
+Artistic license as perl.
+
+$Id: timers.pl 776 2008-11-03 18:20:04Z andy $
+
+=cut
+
+use warnings;
+use strict;
+
+my @timers_once;
+my @timers_repeat;
+
+sub add_one_shot_timer {
+	my ($offset, $coderef) = @_;
+
+	my $one_shot = {};
+
+	$one_shot->{stamp} = time();
+	$one_shot->{offset} = $offset;
+	$one_shot->{coderef} = $coderef;
+
+	return push(@timers_once, $one_shot) - 1;
+}
+
+sub del_one_shot_timer {
+	my ($timer_id) = shift;
+
+	splice(@timers_once, $timer_id, 1);
+}
+
+
+sub add_repeat_timer {
+	my ($every, $coderef) = @_;
+
+	my $repeat = {};
+
+	$repeat->{last} = time();
+	$repeat->{every} = $every;
+	$repeat->{coderef} = $coderef;
+
+	return push(@timers_repeat, $repeat) - 1;
+}
+
+sub del_repeat_timer {
+	my ($timer_id) = shift;
+
+	splice(@timers_repeat, $timer_id, 1);
+}
+
+sub get_one_shot_timer {
+	my ($id) = shift;
+	return $timers_once[$id];
+}
+
+sub get_repeat_timer {
+	my ($id) = shift;
+
+	return $timers_repeat[$id];
+}
+
+sub do_timers_once {
+	my ($self) = shift;
+	my ($timer_id, $timer);
+
+	return unless @timers_once;
+
+	my $now = time();
+
+	for ($timer_id = 0; $timer_id <= $#timers_once; $timer_id++) {
+		$timer = $timers_once[$timer_id];
+
+		if ($now >= $timer->{stamp} + $timer->{offset}) {
+			&{ $timer->{coderef} }($timer_id, $self);
+			del_one_shot_timer($timer_id);
+		}
+	}
+}
+
+sub do_timers_repeat {
+	my ($self) = shift;
+
+	my ($timer_id, $timer);
+
+	return unless @timers_repeat;
+
+	my $now = time();
+
+	for ($timer_id = 0; $timer_id <= $#timers_repeat; $timer_id++) {
+		$timer = $timers_repeat[$timer_id];
+
+		if ($now >= $timer->{last} + $timer->{every}) {
+			&{ $timer->{coderef} }($timer_id, $self);
+			$timer->{last} = $now;
+		}
+	}
+}
+
+1;
diff -r 000000000000 -r d6521d5ea884 twitfolk.conf.sample
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/twitfolk.conf.sample	Sat Dec 06 13:49:48 2008 +0000
@@ -0,0 +1,47 @@
+# Example config file for twitfolk.pl
+# $Id: twitfolk.conf.sample 776 2008-11-03 18:20:04Z andy $
+
+# Server hostname or IP.
+target_server = uk.blitzed.org
+
+# Port to connect to.
+target_port = 6667
+
+# password to use to connect to server (comment out to use no password)
+target_pass = yournickpass
+
+# IRC nick to use.
+nick = Twitfolk
+
+# If the nick is registered, identify to NickServ with this password.
+nick_pass = yournickpass
+
+# If there is no identd installed then use this ident.
+username = twitfolk
+
+# File to write PID to whilst running.
+pidfile = twitfolk.pid
+
+# Away message to immediately set.
+away = If you have a Twitter account, ask grifferz to add you to me!
+
+# Channel, without leading #
+channel = bitfolk
+
+# Your screen name on twitter.com
+twitter_user = twituser
+
+# Your password on twitter.com
+twitter_pass = twitpass
+
+# Your user's ID
+twitter_id = 17103815
+
+# File containing list of people to follow and their IRC nicknames
+friends_file = twitfolk.friends
+
+# Where to store the most recent tweet id
+tweet_id_file = last_tweet
+
+# How many tweets to relay at a time
+max_tweets = 4
diff -r 000000000000 -r d6521d5ea884 twitfolk.friends.sample
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/twitfolk.friends.sample	Sat Dec 06 13:49:48 2008 +0000
@@ -0,0 +1,6 @@
+# Install this as your friends file
+
+# twitter	IRC
+
+grifferz	grifferz
+someguy		someircguy
diff -r 000000000000 -r d6521d5ea884 twitfolk.pl
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/twitfolk.pl	Sat Dec 06 13:49:48 2008 +0000
@@ -0,0 +1,612 @@
+#!/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();
+}