#!/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();
}