POE::Component::Server::Twirc - Twitter/IRC gateway

    use POE::Component::Server::Twirc;

    POE::Component::Server::Twirc->new(
        irc_nickname        => $my_irc_nickname,
        twitter_username    => $my_twitter_username,
        twitter_password    => $my_twitter_password,
        twitter_screen_name => $my_twitter_screen_name,
    );

    POE::Kernel->run;

    command arg1 arg2 ... argn

package POE::Component::Server::Twirc;
use MooseX::POE;

use MooseX::AttributeHelpers;
use LWP::UserAgent::POE;
use POE qw(Component::Server::IRC);
use Net::Twitter;
use Email::Valid;
use String::Truncate qw/elide/;
use POE::Component::Server::Twirc::LogAppender;
use POE::Component::Server::Twirc::State;
use Encode qw/decode/;
use Try::Tiny;

with 'MooseX::Log::Log4perl';

our $VERSION = '0.12';

has irc_nickname        => ( isa => 'Str', is => 'ro', required => 1 );

has twitter_username    => ( isa => 'Str', is => 'ro', required => 1 );

has twitter_password    => ( isa => 'Str', is => 'ro', required => 1 );

has twitter_screen_name => ( isa => 'Str', is => 'rw' );

has irc_server_name     => ( isa => 'Str', is => 'ro', default => 'twitter.irc' );

has irc_server_port     => ( isa => 'Int', is => 'ro', default => 6667 );

# will be defaulted to INADDR_ANY by POE::Wheel::SocketFactory
has irc_server_bindaddr => ( isa => 'Str', is => 'ro', default => undef );

has irc_mask            => ( isa => 'Str', is => 'ro', default => '*@127.0.0.1' );

has irc_password        => ( isa => 'Str', is => 'ro' );

has irc_botname         => ( isa => 'Str', is => 'ro', default => 'tweeter' );

has irc_botircname      => ( isa => 'Str', is => 'ro', default => 'Your friendly Twitter Agent' );

has irc_channel         => ( isa => 'Str', is => 'ro', default => '&twitter' );

has twitter_retry       => ( isa => 'Int', is => 'ro', default => 300 );

has twitter_retry_on_error => ( isa => 'Int', is => 'ro', default => 60 );

has twitter_alias       => ( isa => 'Str', is => 'ro', default => 'me' );

has twitter_args => ( isa => 'HashRef', is => 'ro', default => sub { {} } );

has extra_net_twitter_traits => (
    is      => 'ro',
    default => sub { [] },
);

has echo_posts => ( isa => 'Bool', is => 'rw', default => 0 );

has favorites_count => ( isa => 'Int', is => 'ro', default => 3 );

has truncate_to         => ( isa => 'Int', is => 'ro', default => 60 );

has check_friends_timeline => ( isa => 'Bool', is => 'rw', default => 1 );

has check_replies => ( isa => 'Bool', is => 'rw', default => 0 );

has check_direct_messages => ( isa => 'Bool', is => 'rw', default => 0 );

has log_channel => ( isa => 'Str', is => 'ro' );

has state_file => ( isa => 'Str', is => 'ro' );

has verbose_refresh => ( isa => 'Bool', is => 'rw', default => 0 );

has plugins => ( isa => 'ArrayRef[Object]', is => 'ro', default => sub { [] } );

has _ircd => (
       accessor => 'ircd', isa => 'POE::Component::Server::IRC', is => 'rw', weak_ref => 1 );
has _twitter => ( isa => 'Net::Twitter', is => 'rw' );
has _users_by_nick => (
    metaclass => 'Collection::Hash',
    isa => 'HashRef[HashRef|Object]',
    is => 'rw',
    default => sub { {} },
    provides => {
        set      => 'set_user_by_nick',
        get      => 'get_user_by_nick',
        empty    => 'has_users_by_nick',
        count    => 'num_users_by_nick',
        'delete' => 'delete_user_by_nick',
        'keys'   => 'user_nicks',
    },
);

has _users_by_id => (
    metaclass => 'Collection::Hash',
    isa => 'HashRef[HashRef|Object]',
    is  => 'rw',
    default => sub { {} },
    provides => {
        set      => 'set_user_by_id',
        get      => 'get_user_by_id',
        'delete' => 'delete_user_by_id',
    },
);

has _joined => ( accessor => 'joined', isa => 'Bool', is => 'rw', default => 0 );

has _tweet_stack => (
       accessor => 'tweet_stack',
       isa      => 'ArrayRef[Object]',
       is       => 'rw',
       default  => sub { [] },
);
has _dm_stack => (
       accessor => 'dm_stack',
       isa      => 'ArrayRef[Object]',
       is       => 'rw',
       default  => sub { [] },
);

has _stash => (
        accessor  => 'stash',
        isa       => 'HashRef',
        is        => 'rw',
        predicate => 'has_stash',
        clearer   => 'clear_stash',
);

has _state => (
        accessor => 'state',
        isa      => 'POE::Component::Server::Twirc::State',
        is       => 'rw',
        builder  => '_build_state',
        lazy     => 1,
);

sub _build_state { POE::Component::Server::Twirc::State->new }

has _unread_posts => ( isa => 'HashRef', is => 'rw', default => sub { {} } );
has _topic_id     => ( isa => 'Int', is => 'rw', default => 0 );

has client_encoding => ( isa => 'Str', is  => 'rw', default => sub { 'utf-8' } );

sub twitter {
    my ($self, $method, @args) = @_;

    my $r = eval { $self->_twitter->$method(@args) };
    if ( $@ ) {
        if ( blessed $@ && $@->can('code') && $@->code == 502 ) {
            $@ = 'Fail Whale';
        }
        $self->twitter_error("$method -> $@");
    }

    return $r;
}

sub post_ircd {
    my $self = shift;
    $self->ircd->yield(@_);
}

sub bot_says  {
    my ($self, $channel, $text) = @_;

    $self->post_ircd('daemon_cmd_privmsg', $self->irc_botname, $channel, $text);
};

sub bot_notice {
    my ($self, $channel, $text) = @_;

    $self->post_ircd(daemon_cmd_notice => $self->irc_botname, $channel, $text);
}


sub twitter_error {
    my ($self, $text) = @_;

    $self->bot_notice($self->irc_channel, "Twitter error: $text");
};

# set topic from status, iff newest status
sub set_topic {
    my ($self, $status) = @_;

    # only set the topic if it's newer than the last topic
    return unless $status->id > $self->_topic_id;

    $self->_topic_id($status->id);
    $self->post_ircd(daemon_cmd_topic => $self->irc_botname, $self->irc_channel, $status->text);
};

# match any nick
sub nicks_alternation {
    my $self = shift;

    return join '|', map quotemeta, $self->user_nicks;
}

sub add_user {
    my ($self, $user) = @_;

    $self->set_user_by_nick($user->screen_name, $user);
    $self->set_user_by_id($user->id, $user);
}

sub delete_user {
    my ($self, $user) = @_;

    $self->delete_user_by_id($user->id);
    $self->delete_user_by_nick($user->screen_name);
}

sub get_replies          { shift->get_statuses(replies       => 'reply_id'            ) }
sub get_friends_timeline { shift->get_statuses(home_timeline => 'friends_timeline_id' ) }

sub get_statuses {
    my ($self, $twitter_method, $state_id_name) = @_;

    my $since_id = $self->state->$state_id_name || 1;
    my $statuses = $self->twitter($twitter_method, { since_id => $since_id }) || [];
    $self->state->$state_id_name($statuses->[0]->id) if @$statuses;

    # work around a twitter bug where since_id is sometimes ignored
    return [ grep { $_->id > $since_id } @$statuses ];
}

sub sort_unique_statuses {
    my $self = shift;

    my %seen;
    my $statuses = [
        grep { !$seen{$_->id}++ }
        sort { $a->id <=> $b->id }
        map { @$_ } @_
    ];
}

sub _net_twitter_opts {
    my $self = shift;

    my %config = (
        # ROT13: Gjvggre qbrf abg jnag pbafhzre xrl/frperg vapyhqrq va bcra
        # fbhepr nccf. Gurl frrz gb guvax cebcevrgnel pbqr vf fnsre orpnhfr
        # gur pbafhzre perqragvnyf ner boshfpngrq.  Fb, jr'yy boshfpngr gurz
        # urer jvgu ebg13 naq jr'yy or "frpher" whfg yvxr n cebcevrgnel ncc.
        ( grep tr/a-zA-Z/n-za-mN-ZA-M/, map $_,
            pbafhzre_xrl     => 'ntqifMSFhMC0NdSWmBWgtN',
            pbafhzre_frperg  => 'CDDA2pAiDcjb6saxt0LLwezCBV97VPYGAF0LMa0oH',
        ),
        traits               => [qw/API::REST OAuth InflateObjects/],
        useragent_class      => 'LWP::UserAgent::POE',
        useragent            => "twirc/$VERSION",
        decode_html_entities => 1,
        %{ $self->twitter_args },
    );

    foreach my $plugin (@{$self->plugins}){
        if ($plugin->can('plugin_traits')) {
            push @{ $config{traits} }, $plugin->plugin_traits();
        }
    }

    my %unique_traits = map { $_ => undef }
        @{ $config{traits} },
        @{ $self->extra_net_twitter_traits };
    $config{traits} = [ keys %unique_traits ];

    return %config;
}

sub START {
    my ($self) = @_;

    $self->ircd(
        POE::Component::Server::IRC->spawn(
            config => {
                servername => $self->irc_server_name,
                nicklen    => 15,
                network    => 'SimpleNET'
            },
            inline_states => {
                _stop  => sub { $self->log->debug('[ircd:stop]') },
            },
        )
    );

    # register ircd to receive events
    $self->post_ircd('register' );
    $self->ircd->add_auth(
        mask     => $self->irc_mask,
        password => $self->irc_password,
    );
    $self->post_ircd('add_listener', port     => $self->irc_server_port,
                                     bindaddr => $self->irc_server_bindaddr);

    # add super user
    $self->post_ircd(
        add_spoofed_nick =>
        { nick => $self->irc_botname, ircname => $self->irc_botircname }
    );
    $self->post_ircd(daemon_cmd_join => $self->irc_botname, $self->irc_channel);

    # logging
    if ( $self->log_channel ) {
        $self->post_ircd(daemon_cmd_join => $self->irc_botname, $self->log_channel);
        my $logger = Log::Log4perl->get_logger('');
        my $appender = Log::Log4perl::Appender->new(
            'POE::Component::Server::Twirc::LogAppender',
            name        => 'twirc-logger',
            ircd        => $self->ircd,
            irc_botname => $self->irc_botname,
            irc_channel => $self->log_channel,
        );
        $logger->add_appender($appender);
    }

    if ( $self->state_file && -r $self->state_file ) {
        eval {
            $self->state(POE::Component::Server::Twirc::State->load($self->state_file))
        };
        if ( $@ ) {
            $@ =~ s/ at .*//s;
            $self->log->error($@);
        }
    }

    $self->_twitter(Net::Twitter->new(
        $self->_net_twitter_opts()
    ));

    if ( $self->state->access_token && $self->state->access_token_secret ) {
        $self->_twitter->access_token($self->state->access_token);
        $self->_twitter->access_token_secret($self->state->access_token_secret);
    }
    else {
        $self->yield('xauth');
    }

    $self->yield('friends');
    $self->yield('user_timeline'); # for topic setting
    $self->yield('poll_twitter');

    return $self;
}

# Without detaching the ircd child session, the application will not
# shut down.  Bug in PoCo::Server::IRC?
event _child => sub {
    my ($self, $kernel, $event, $child) = @_[OBJECT, KERNEL, ARG0, ARG1];

    $self->log->debug("[_child] $event $child");
    $kernel->detach_child($child) if $event eq 'create';
};

event xauth => sub {
    my $self = shift;

    # LWP::UserAgent::POE doesn't handle SSL, so we need a blocking UA
    my $nt = Net::Twitter->new(
        $self->_net_twitter_opts,
        useragent_class => 'LWP::UserAgent',
    );

    my ($token, $secret, $user_id, $screen_name)
        = $nt->xauth($self->twitter_username, $self->twitter_password);

    $self->_twitter->access_token($token);
    $self->_twitter->access_token_secret($secret);
    $self->twitter_screen_name($screen_name);

    $self->state->access_token($token);
    $self->state->access_token_secret($secret);
    eval { $self->state->store($self->state_file) };
};

event poco_shutdown => sub {
    my ($self) = @_;

    $self->log->debug("[poco_shutdown]");
    $_[KERNEL]->alarm_remove_all();
    $self->post_ircd('unregister');
    $self->post_ircd('shutdown');
    if ( $self->state_file ) {
        eval { $self->state->store($self->state_file) };
        if ( $@ ) {
            $@ =~ s/ at .*//s;
            $self->log->error($@);
        }
    }
};

########################################################################
# IRC events
########################################################################

event ircd_daemon_nick => sub {
    my ($self, $sender, $nick) = @_[OBJECT, SENDER, ARG0];

    $self->log->debug("[ircd_daemon_nick] $nick");

    # if it's a nick change, we only get ARG0 and ARG1
    return unless defined $_[ARG2];

    return if $nick eq $self->irc_botname;

    # Abuse!  Calling the private implementation of ircd to force-join the connecting
    # user to the twitter channel. ircd set's it's heap to $self: see ircd's perldoc.
    $sender->get_heap()->_daemon_cmd_join($nick, $self->irc_channel);
};

event ircd_daemon_join => sub {
    my($self, $sender, $user, $ch) = @_[OBJECT, SENDER, ARG0, ARG1];

    $self->log->debug("[ircd_daemon_join] $user, $ch");
    return unless my($nick) = $user =~ /^([^!]+)!/;
    return if $self->get_user_by_nick($nick);
    return if $nick eq $self->irc_botname;
    return if $nick eq $self->twitter_alias;

    if ( $ch eq $self->irc_channel ) {
        $self->joined(1);
        $self->log->debug("    joined!");
        $self->yield('display_direct_messages');
        $self->yield('display_statuses');
        return;
    }
    elsif ( $self->log_channel && $ch eq $self->log_channel ) {
        my $appender = Log::Log4perl->appender_by_name('twirc-logger');
        $appender->dump_history;
    }
    else {
        $self->log->debug("    ** part **");
        # only one channel allowed
        $sender->get_heap()->_daemon_cmd_part($nick, $ch);
    }
};

event ircd_daemon_part => sub {
    my($self, $user_name, $ch) = @_[OBJECT, ARG0, ARG1];

    return unless my($nick) = $user_name =~ /^([^!]+)!/;
    return if $nick eq $self->irc_botname;

    if ( my $user = $self->get_user_by_nick($nick) ) {
        $self->delete_user($user);
    }

    $self->joined(0) if $ch eq $self->irc_channel && $nick eq $self->irc_nickname;
};

event ircd_daemon_quit => sub {
    my($self, $user) = @_[OBJECT, ARG0];

    $self->log->debug("[ircd_daemon_quit]");
    return unless my($nick) = $user =~ /^([^!]+)!/;
    return if $self->get_user_by_nick($nick);
    return if $nick eq $self->irc_botname;

    $self->joined(0);
    $self->yield('poco_shutdown');
};

event ircd_daemon_public => sub {
    my ($self, $user, $channel, $text) = @_[OBJECT, ARG0, ARG1, ARG2];

    return unless $channel eq $self->irc_channel;

    $text = decode($self->client_encoding, $text);

    $text =~ s/\s+$//;

    my $nick = ( $user =~ m/^(.*)!/)[0];

    $self->log->debug("[ircd_daemon_public] $nick: $text");
    return unless $nick eq $self->irc_nickname;

    # give any command handler a shot
    if ( $self->has_stash ) {
        $self->log->debug("stash exists...");
        my $handler = delete $self->stash->{handler};
        if ( $handler ) {
            return if $self->$handler($channel, $text); # handled
        }
        else {
            $self->log->error("stash exsits with no handler");
        }
        # the user ignored a command completion request, kill it
        $self->clear_stash;
    }

    for my $plugin ( @{$self->plugins} ) {
        $plugin->preprocess($self, $channel, $nick, \$text) && last
            if $plugin->can('preprocess');
    }

    # treat "nick: ..." as "post @nick ..."
    my $nick_alternation = $self->nicks_alternation;
    $text =~ s/^(?:post\s+)?($nick_alternation):\s+/post \@$1 /i;

    my ($command, $argstr) = split /\s+/, $text, 2;
    if ( $command =~ /^\w+$/ ) {
        my $event = "cmd_$command";

        # Give each plugin a opportunity:
        # - Plugins return true if they swallow the event; false to continue
        #   the processing chain.
        # - Plugins can modify the text, so pass a ref.
        for my $plugin ( @{$self->plugins} ) {
            $plugin->$event($self, $channel, $nick, \$argstr) && return
                if $plugin->can($event);
        }
       if ( $self->can($event) ) {
            $self->yield($event, $channel, $argstr);
        }
        else {
            $self->bot_says($channel, qq/I don't understand "$command". Try "help"./)
        }
    }
    else {
        $self->bot_says($channel, qq/That doesn't look like a command. Try "help"./);
    }
};

event ircd_daemon_privmsg => sub {
    my ($self, $user, $target_nick, $text) = @_[OBJECT, ARG0..ARG2];

    # owning user is the only one allowed to send direct messages
    my $me = $self->irc_nickname;
    return unless $user =~ /^\Q$me\E!/;

    $text = decode($self->client_encoding, $text);

    unless ( $self->get_user_by_nick($target_nick) ) {
        # TODO: handle the error the way IRC would?? (What channel?)
        $self->bot_says($self->irc_channel, qq/You don't appear to be following $target_nick; message not sent./);
        return;
    }

    unless ( $self->twitter(new_direct_message => { user => $target_nick, text => $text }) ) {
        # TODO what channel?
        $self->bot_says($self->irc_channel, "new_direct_message failed.");
    }
};

########################################################################
# Twitter events
########################################################################

# This is the main loop; check for updates every twitter_retry seconds.
event poll_twitter => sub {
    my ($self) = @_;

    $self->yield('direct_messages')  if $self->check_direct_messages;
    $self->yield('timeline');
    $_[KERNEL]->delay(poll_twitter => $self->twitter_retry);
};

event display_statuses => sub {
    my ($self) = @_;

    $self->log->debug("[display_statuses] ", scalar @{$self->tweet_stack}, " messages");

    while ( my $entry = shift @{$self->tweet_stack} ) {
        my $name = $entry->user->screen_name;
        $name = $self->twitter_alias if $name eq $self->irc_nickname;
        my $text = try { "RT \@${ \$entry->retweeted_status->user->screen_name }: ${ \$entry->retweeted_status->text }" }
                || $entry->text;
        $self->post_ircd(daemon_cmd_privmsg => $name, $self->irc_channel, $_)
            for split /[\r\n]+/, $text;
    }
};

# Add friends to the channel
event friends => sub {
    my ($self, $cursor ) = @_[OBJECT, ARG0];

    my $retry = $self->twitter_retry_on_error;

    $self->log->debug("[twitter:friends] calling...");
    for ( $cursor ||= -1; $cursor;) {
        my $r = $self->twitter(friends => { cursor => $cursor });
        unless ( $r ) {
            $_[KERNEL]->delay(friends => $retry, $cursor);
            return;
        }
        $self->log->debug("    friends returned ", scalar @{$r->{users}}, " friends");

        $cursor = $r->{next_cursor};

        for my $friend ( @{$r->{users}} ) {
            next if $self->get_user_by_id($friend->id);

            $self->post_ircd(add_spoofed_nick => { nick => $friend->screen_name, ircname => $friend->name });
            $self->post_ircd(daemon_cmd_join => $friend->screen_name, $self->irc_channel);
            $self->add_user($friend);
        }
    }
    $self->yield('followers');
};

# Give friends who are also followers voice; it's just a visual hint to the user.
event followers => sub {
    my ($self, $cursor ) = @_[OBJECT, ARG0];

    my $retry = $self->twitter_retry_on_error;

    $self->log->debug("[twitter:followers] calling...");
    for ( $cursor ||= -1; $cursor; ) {
        my $r = $self->twitter(followers => { cursor => $cursor });
        unless ( $r ) {
            $self->twitter_error("request for followers failed; retrying in $retry seconds");
            $_[KERNEL]->delay(followers => $retry, $cursor);
            return;
        }

        $cursor = $r->{next_cursor};

        $self->log->debug("    followers returned ", scalar @{$r->{users}}, " followers");

        for my $follower ( @{$r->{users}} ) {
            if ( $self->get_user_by_nick($follower->screen_name) ) {
                $self->post_ircd(daemon_cmd_mode =>
                    $self->irc_botname, $self->irc_channel, '+v', $follower->screen_name);
            }
        }
    }
};

event direct_messages => sub {
    my ($self) = @_;

    # We don't want to flood the user with DMs, so if this is the first time,
    # i.e., no DM id in saved state, just set the high water mark and return.
    unless ( $self->state->direct_message_id ) {
        if ( my $high_water = $self->twitter('direct_messages') ) {
            $self->state->direct_message_id(@$high_water ? $high_water->[0]->id : 1);
        }
        return;
    }

    my $since_id = $self->state->direct_message_id;
    my $messages = $self->twitter(direct_messages => { since_id => $since_id }) || return;

    if ( @$messages ) {
        $self->state->direct_message_id($messages->[0]->id)
            if $messages->[0]->id > $since_id; # lack of faith in twitterapi

        while ( my $msg = pop @$messages ) {
            # workarond twitter bug where since_id parameter is ignored:
            next unless $msg->id > $since_id;

            my $nick = $msg->sender->screen_name;
            unless ( $self->get_user_by_nick($nick) ) {
                $self->log->warn("Joining $nick from a direct message; expected $nick already joined.");
                $self->post_ircd(add_spoofed_nick => { nick => $nick, ircname => $msg->sender->name });
                $self->post_ircd(daemon_cmd_join => $nick, $self->irc_channel);
                $self->add_user($msg->sender);
            }

            push @{$self->dm_stack}, $msg;
        }
        $self->yield('display_direct_messages') if $self->joined;
    }
};

event display_direct_messages => sub {
    my ($self) = @_;

    while ( my $msg = shift @{$self->dm_stack} ) {
        my $name = $msg->sender_screen_name;
        $name = $self->twitter_alias if $name eq $self->irc_nickname;
        $self->post_ircd(daemon_cmd_privmsg => $name, $self->irc_nickname, $_)
            for split /\r?\n/, $msg->text;
    }
};

event timeline => sub {
    my ($self) = @_;

    my $new_topic;
    my $channel = $self->irc_channel;
    my $statuses = $self->sort_unique_statuses(
        $self->check_friends_timeline && $self->get_friends_timeline || [],
        $self->check_replies          && $self->get_replies          || [],
    );

    while ( my $status = shift @$statuses ) {
        my $id      = $status->user->id;
        my $name    = $status->user->screen_name;
        my $ircname = $status->user->name;

        # alias our twitter_name if configured
        # (to avoid a collision in case our twitter screen name and irc nick are the same)
        $self->log->debug( sprintf '    $name = %s, $twitter_name = %s', $ircname, $name);

        # message from self
        if ( $name eq $self->twitter_screen_name ) {
            $self->state->user_timeline_id($status->id)
                if $status->id > $self->state->user_timeline_id; # lack of faith in twitterapi
            $new_topic = $status unless $status->text =~ /^\s*\@/;

            # if we posted this status from twirc, we've already seen it
            my $seen = delete $self->_unread_posts->{$status->id};
            next if $seen && !$self->echo_posts;
        }

        my $user = $self->get_user_by_id($id);
        if ( !$user ) {
            # new user
            $self->post_ircd(add_spoofed_nick => { nick => $name, ircname => $ircname });
            $self->post_ircd(daemon_cmd_join => $name, $channel);
        }
        elsif ( $user->screen_name ne $name ) {
            # nick change
            $self->delete_user_by_nick($user->id);
            $self->post_ircd(daemon_cmd_nick => $user->screen_name, $name);
        }

        $self->add_user($status->user);

        $self->log->debug("    { $name, $status->{text} }");
        push @{ $self->tweet_stack }, $status;
    }

    if ( @$statuses == 0 && $self->verbose_refresh ) {
      $self->bot_notice($channel, "That refresh didn't get any new tweets.");
    }

    $self->set_topic($new_topic) if $new_topic;
    $self->yield('display_statuses') if $self->joined;
    $self->yield('poll_cleanup');
};

# handle cleanup after the important work has had a chance to complete
event poll_cleanup => sub {
    my ($self) = @_;

    # store state
    if ( $self->state_file ) {
        eval { $self->state->store($self->state_file) };
        if ( $@ ) {
            $@ =~ s/ at .*//s;
            $self->log->error($@);
        }
    }

    # It is possible to get here with _unread_posts populated, for instance, if a post
    # has been sent *during* processing of the most recent poll results.  However, we
    # should never have an _uread post older than friends_timeline_id.
    for my $id ( keys %{$self->_unread_posts} ) {
        if ( $id <= $self->state->friends_timeline_id ) {
            $self->log->error("recent post missing from the feed: $id");
            delete $self->_unread_posts->{$id};
        }
    }
};

event user_timeline => sub {
    my ($self) = @_;

    $self->log->debug("[user_timetline] calling...");
    # Work around a twitter api bug by passing id; without it, sometimes the wrong users statuses
    # are returned.
    my $statuses = $self->twitter(user_timeline => { screen_name =>  $self->twitter_screen_name });
    unless ( $statuses ) {
        $_[KERNEL]->delay(user_timeline => 60);
    }
    $self->log->debug("    urser_timeline returned");

    return unless @$statuses;

    for my $status ( @$statuses ) {
        # skip @replies
        unless ( $status->text =~ /^\s*\@/ ) {
            $self->set_topic($status);
            return;
        }
    }

    #couldn't find an non-@reply status, punt
    $self->set_topic($statuses->[0]);
};

########################################################################
# Commands
########################################################################

event cmd_post => sub {
    my ($self, $channel, $text) = @_[OBJECT, ARG0, ARG1];

    $self->log->debug("[cmd_post_status]");

    if ( (my $n = length($text) - 140) > 0 ) {
        $self->bot_says($channel, "Message not sent; $n characters too long. Limit is 140 characters.");
        return;
    }

    my $status = $self->twitter(update => $text) || return;

    $self->log->debug("    update returned $status");

    $self->set_topic($status) unless $status->text =~ /^\s*\@/;
    $self->_unread_posts->{$status->id} = 1;
};

event cmd_follow => sub {
    my ($self, $channel, $id) = @_[OBJECT, ARG0, ARG1];

    if ( $id !~ /^\w+$/ ) {
        $self->bot_says($channel, qq/"$id" doesn't look like a user ID to me./);
        return;
    }

    my $friend = $self->twitter(create_friend => $id) || return;

    my $nick = $friend->screen_name;
    my $name = $friend->name;
    $self->post_ircd('add_spoofed_nick', { nick => $nick, ircname => $name });
    $self->post_ircd(daemon_cmd_join => $name, $self->irc_channel);
    $self->add_user($friend);

    my @args = ($nick, $self->twitter_screen_name);

    if ( $self->twitter(relationship_exists => @args) ) {
        $self->post_ircd(daemon_cmd_mode =>
            $self->irc_botname, $self->irc_channel, '+v', $nick);
        $self->bot_notice($channel, qq/Now following $id./);
    }
};

event cmd_unfollow => sub {
    my ($self, $channel, $id) = @_[OBJECT, ARG0, ARG1];

    if ( !$self->get_user_by_nick($id) ) {
        $self->bot_says($channel, qq/You don't appear to be following $id./);
        return;
    }

    my $friend = $self->twitter(destroy_friend => $id) || return;

    $self->post_ircd(daemon_cmd_part => $id, $self->irc_channel);
    $self->post_ircd(del_spooked_nick => $id);
    $self->bot_notice($channel, qq/No longer following $id./);
};

event cmd_block => sub {
    my ($self, $channel, $id) = @_[OBJECT, ARG0, ARG1];

    if ( $id !~ /^\w+$/ ) {
        $self->bot_says($channel, qq/"$id" doesn't look like a user ID to me./);
        return;
    }

    $self->twitter(create_block => $id) || return;

    if ( $self->get_user_by_nick($id) ) {
        $self->post_ircd(daemon_cmd_mode =>
            $self->irc_botname, $self->irc_channel, '-v', $id);
        $self->bot_notice($channel, qq/Blocked $id./);
    }
};

event cmd_unblock => sub {
    my ($self, $channel, $id) = @_[OBJECT, ARG0, ARG1];

    if ( $id !~ /^\w+$/ ) {
        $self->bot_says($channel, qq/"$id" doesn't look like a user ID to me./);
        return;
    }

    $self->twitter(destroy_block => $id) || return;

    if ( $self->get_user_by_nick($id) ) {
        $self->post_ircd(daemon_cmd_mode =>
            $self->irc_botname, $self->irc_channel, '+v', $id);
        $self->bot_notice($channel, qq/Unblocked $id./);
    }
};

event cmd_whois => sub {
    my ($self, $channel, $id) = @_[OBJECT, ARG0, ARG1];

    $self->log->debug("[cmd_whois] $id");

    my $user = $self->get_user_by_nick($id);
    unless ( $user ) {
        $self->log->debug("     $id not in users; fetching");
        my $arg = Email::Valid->address($id) ? { email => $id } : { id => $id };
        $user = $self->twitter(show_user => $arg) || return;
    }
    if ( $user ) {
        for (
            sprintf('%s [%s]: %s, %s', @{$user}{qw/screen_name id name location/}),
            $user->description,
            $user->url,
        )
        {
            $self->bot_says($channel, $_) if $_;
        }
    }
    else {
        $self->bot_says($channel, "I don't know $id.");
    }
};

event cmd_notify => sub {
    my ($self, $channel, $argstr) = @_[OBJECT, ARG0, ARG1];

    my @nicks = split /\s+/, $argstr;
    my $onoff = shift @nicks;

    unless ( $onoff && $onoff =~ /^on|off$/ ) {
        $self->bot_says($channel, "Usage: notify on|off nick[ nick [...]]");
        return;
    }

    my $method = $onoff eq 'on' ? 'enable_notifications' : 'disable_notifications';
    for my $nick ( @nicks ) {
        unless ( $self->twitter($method => { id => $nick }) ) {
            $self->bot_says($channel, "notify $onoff failed for $nick");
        }
    }
};

event cmd_favorite => sub {
    my ($self, $channel, $args) = @_[OBJECT, ARG0, ARG1];

    my ($nick, $count) = split /\s+/, $args;
    $count ||= $self->favorites_count;

    $self->log->debug("[cmd_favorite] $nick");

    my $recent = $self->twitter(user_timeline => { screen_name => $nick, count => $count }) || return;
    if ( @$recent == 0 ) {
        $self->bot_says($channel, "$nick has no recent tweets");
        return;
    }

    $self->stash({
        handler    => '_handle_favorite',
        candidates => [ map $_->id, @$recent ],
    });

    $self->bot_says($channel, 'Which tweet?');
    for ( 1..@$recent ) {
        $self->bot_says($channel, "[$_] " . elide($recent->[$_ - 1]->text, $self->truncate_to));
    }
};

sub _handle_favorite {
    my ($self, $channel, $index) = @_;

    $self->log->debug("[handle_favorite] $index");

    my @candidates = @{$self->stash->{candidates} || []};
    if ( $index =~ /^\d+$/ && 0 < $index && $index <= @candidates ) {
        if ( $self->twitter(create_favorite => { id => $candidates[$index - 1] }) ) {
            $self->bot_notice($channel, 'favorite added');
        }
        $self->clear_stash;
        return 1; # handled
    }
    return 0; # unhandled
};

event cmd_check_friends_timeline => sub {
    my ($self, $channel, $onoff) = @_[OBJECT, ARG0, ARG1];

    unless ( $onoff && $onoff =~ /^on|off$/ ) {
        $self->bot_says($channel, "Usage: check_friends_timeline on|off");
        return;
    }
    $self->check_friends_timeline($onoff eq 'on' ? 1 : 0);
};

event cmd_check_replies => sub {
    my ($self, $channel, $onoff) = @_[OBJECT, ARG0, ARG1];

    unless ( $onoff && $onoff =~ /^on|off$/ ) {
        $self->bot_says($channel, "Usage: check_replies on|off");
        return;
    }
    $self->check_replies($onoff eq 'on' ? 1 : 0);
};

event cmd_check_direct_messages => sub {
    my ($self, $channel, $onoff) = @_[OBJECT, ARG0, ARG1];

    unless ( $onoff && $onoff =~ /^on|off$/ ) {
        $self->bot_says($channel, "Usage: check_direct_messages on|off");
        return;
    }
    $self->check_direct_messages($onoff eq 'on' ? 1 : 0);
};

event cmd_rate_limit_status => sub {
    my ($self, $channel) = @_[OBJECT, ARG0];

    if ( my $r = $self->twitter('rate_limit_status') ) {
        my $reset_time = sprintf "%02d:%02d:%02d", (localtime $r->{reset_time_in_seconds})[2,1,0];
        my $seconds_remaning = $r->{reset_time_in_seconds} - time;
        my $time_remaning = sprintf "%d:%02d", int($seconds_remaning / 60), $seconds_remaning % 60;
        $self->bot_says($channel, sprintf "%s API calls remaining for the next %s (until %s), hourly limit is %s",
            $r->remaining_hits,
            $time_remaning,
            $reset_time,
            $r->hourly_limit,
        );
    }
};

event cmd_retweet => sub {
    my ( $self, $channel, $args ) = @_[OBJECT, ARG0, ARG1];

    unless ( defined $args ) {
        $self->bot_says($channel, 'usage: retweet nick [-N]');
        return;
    }

    my ( $nick, $count ) = split /\s+/, $args;

    $count ||= $self->favorites_count;

    my $recent = $self->twitter(user_timeline => { screen_name => $nick, count => $count }) || return;
    if ( @$recent == 0 ) {
        $self->bot_says($channel, "$nick has no recent tweets");
        return;
    }

    $self->stash({
        handler    => '_handle_retweet',
        candidates => [ map $_->id, @$recent ],
    });

    $self->bot_says($channel, 'Which tweet?');
    for ( 1..@$recent ) {
        $self->bot_says($channel, "[$_] " . elide($recent->[$_ - 1]->text, $self->truncate_to));
    }
};

sub _handle_retweet {
    my ($self, $channel, $index) = @_;

    my @candidates = @{$self->stash->{candidates} || []};
    if ( $index =~ /^\d+$/ && 0 < $index && $index <= @candidates ) {
        $self->twitter(retweet => { id => $candidates[$index - 1] });
        $self->clear_stash;
        return 1; # handled
    }
    return 0; # unhandled
};

event cmd_reply => sub {
    my ( $self, $channel, $args ) = @_[OBJECT, ARG0, ARG1];

    unless ( defined $args ) {
        $self->bot_says($channel, "usage: reply nick [-N] message-text");
        return;
    }

    my ( $nick, $count, $message ) = $args =~ /
                ^@?(\S+)        # nick; strip leading @ if there is one
                \s+
                (?:-(\d+)\s+)?  # optional count: -N
                (.*)            # the message
        /x;
    unless ( defined $nick && defined $message ) {
        $self->bot_says($channel, "usage: reply nick [-N] message-text");
        return;
    }


    $count ||= $self->favorites_count;

    my $recent = $self->twitter(user_timeline => { screen_name => $nick, count => $count }) || return;
    if ( @$recent == 0 ) {
        $self->bot_says($channel, "$nick has no recent tweets");
        return;
    }

    $self->stash({
        handler    => '_handle_reply',
        candidates => [ map $_->id, @$recent ],
        recipient  => $nick,
        message    => $message,
    });

    $self->bot_says($channel, 'Which tweet?');
    for ( 1..@$recent ) {
        $self->bot_says($channel, "[$_] " . elide($recent->[$_ - 1]->text, $self->truncate_to));
    }
};

sub _handle_reply {
    my ($self, $channel, $index) = @_;

    my @candidates = @{$self->stash->{candidates} || []};
    if ( $index =~ /^\d+$/ && 0 < $index && $index <= @candidates ) {
        my $message = sprintf '@%s %s', @{$self->stash}{qw/recipient message/};
        if ( (my $n = length($message) - 140) > 0 ) {
            $self->bot_says($channel, "Message not sent; $n characters too long. Limit is 140 characters.");
        }
        else {
            $self->twitter(update => {
                status => $message,
                in_reply_to_status_id => $candidates[$index - 1],
            });
        }
        $self->clear_stash;
        return 1; # handled
    }
    return 0; # unhandled
};

event cmd_report_spam => sub {
    my ( $self, $channel, $args ) = @_[OBJECT, ARG0, ARG1];

    unless ( $args ) {
        $self->bot_says($channel, "spam requires list of 1 or more spammers");
        return;
    }

    for my $spammer ( split /\s+/, $args ) {
        $self->yield(report_spam_helper => $spammer);
    }
};

event report_spam_helper => sub {
    my ( $self, $spammer ) = @_[OBJECT, ARG0];

    $self->twitter(report_spam => { screen_name => $spammer });
};

event cmd_help => sub {
    my ($self, $channel, $argstr)=@_[OBJECT, ARG0, ARG1];
    $self->bot_says($channel, "Available commands:");
    $self->bot_says($channel, join ' ' => sort qw/
        post follow unfollow block unblock whois notify refresh favorite
        check_replies rate_limit_status verbose_refresh
        retweet report_spam
    /);
    $self->bot_says($channel, '/msg nick for a direct message.')
};

event cmd_refresh => sub {
    my ($self) = @_;

    $self->yield('poll_twitter');
};

event cmd_verbose_refresh => sub {
    my ($self, $channel, $onoff) = @_[OBJECT, ARG0, ARG1];

    unless ( $onoff && $onoff =~ /^on|off$/ ) {
        $self->bot_says($channel, "Usage: verbose_refresh on|off");
        return;
    }
    $self->verbose_refresh($onoff eq 'on' ? 1 : 0);
};

1;

__END__