package POE::Component::Server::Twirc;
use MooseX::POE;
use LWP::UserAgent::POE;
use POE qw(Component::Server::IRC);
use Net::Twitter;
use String::Truncate elide => { marker => '…' };
use POE::Component::Server::Twirc::LogAppender;
use POE::Component::Server::Twirc::State;
use Encode qw/decode/;
use Try::Tiny;
use Scalar::Util qw/reftype/;
use AnyEvent;
use AnyEvent::Twitter::Stream;
use HTML::Entities;
use Regexp::Common qw/URI/;
with 'MooseX::Log::Log4perl';
our $VERSION = '0.17';
=head1 NAME
POE::Component::Server::Twirc - Twitter/IRC gateway
=head1 SYNOPSIS
use POE::Component::Server::Twirc;
POE::Component::Server::Twirc->new;
POE::Kernel->run;
=head1 DESCRIPTION
C<POE::Component::Server::Twirc> provides an IRC/Twitter gateway. Twitter friends are
added to a channel and messages they post on twitter appear as channel
messages in IRC. The IRC interface supports several Twitter features,
including posting status updates, following and un-following Twitter feeds,
enabling and disabling device notifications, sending direct messages, and
querying information about specific Twitter users.
Friends who are also followers are given "voice" as a visual clue in IRC.
=head1 METHODS
=head2 new
Spawns a POE component encapsulating the Twitter/IRC gateway.
Arguments:
=over 4
=item irc_server_name
(Optional) The name of the IRC server. Defaults to C<twitter.irc>.
=cut
has irc_server_name => isa => 'Str', is => 'ro', default => 'twitter.irc';
=item irc_server_port
(Optional) The port number the IRC server binds to. Defaults to 6667.
=cut
has irc_server_port => isa => 'Int', is => 'ro', default => 6667;
=item irc_server_bindaddr
(Optional) The local address to bind to. Defaults to '127.0.0.1'.
=cut
# will be defaulted to INADDR_ANY by POE::Wheel::SocketFactory
has irc_server_bindaddr => isa => 'Str', is => 'ro', default => '127.0.0.1';
=item irc_mask
(Optional) The IRC user/host mask used to restrict connecting users. Defaults to C<*@127.0.0.1>.
=cut
has irc_mask => isa => 'Str', is => 'ro', default => '*@127.0.0.1';
=item irc_password
(Optional) Password used to authenticate to the IRC server.
=cut
has irc_password => isa => 'Str', is => 'ro';
=item irc_botname
(Optional) The name of the channel operator bot. Defaults to C<tweeter>. Select a name
that does not conflict with friends, followers, or your own IRC nick.
=cut
has irc_botname => isa => 'Str', is => 'ro', default => 'tweeter';
=item irc_botircname
(Optional) Text to be used as the channel operator bot's IRC full name.
=cut
has irc_botircname => isa => 'Str', is => 'ro', default => 'Your friendly Twitter agent';
=item irc_channel
(Optional) The name of the channel to use. Defaults to C<&twitter>.
=cut
has irc_channel => isa => 'Str', is => 'ro', default => '&twitter';
=item twitter_args
(Optional) A hashref of extra arguments to pass to C<< Net::Twitter->new >>.
=cut
has twitter_args => isa => 'HashRef', is => 'ro', default => sub { {} };
=item extra_net_twitter_traits
(Optional) Additional traits used to construct the Net::Twitter instance.
=cut
has extra_net_twitter_traits => is => 'ro', default => sub { [] };
=item selection_count
(Optional) How many favorites candidates to display for selection. Defaults to 3.
=cut
has selection_count => isa => 'Int', is => 'ro', default => 3;
=item truncate_to
(Optional) When displaying tweets for selection, they will be truncated to this length.
Defaults to 60.
=cut
has truncate_to => isa => 'Int', is => 'ro', default => 60;
=item log_channel
(Optional) If specified, twirc will post log messages to this channel.
=cut
has log_channel => isa => 'Str', is => 'ro';
=item state_file
(Optional) File used to store state information between sessions, including last message read for
replies, direct messages, and timelines.
=cut
has state_file => isa => 'Str', is => 'ro';
=item plugins
(Optional) An array of plugin objects.
=cut
has plugins => isa => 'ArrayRef[Object]', is => 'ro', default => sub { [] };
=back
=cut
has irc_nickname => isa => 'Str', is => 'rw', init_arg => undef;
has _twitter => is => 'rw', isa => 'Object', lazy => 1, default => sub {
my $self = shift;
Net::Twitter->new(
$self->_net_twitter_opts,
access_token => $self->state->access_token,
access_token_secret => $self->state->access_token_secret,
);
};
has ircd => isa => 'POE::Component::Server::IRC', is => 'rw', weak_ref => 1;
has _users_by_nick =>
traits => [qw/Hash/],
isa => 'HashRef[HashRef|Object]',
is => 'rw',
init_arg => undef,
lazy => 1,
default => sub { +{ map { lc($$_{screen_name}) => $_ } shift->get_users } },
handles => {
set_user_by_nick => 'set',
get_user_by_nick => 'get',
delete_user_by_nick => 'delete',
user_nicks => 'keys',
};
has joined => init_arg => undef, isa => 'Bool', is => 'rw', default => 0;
has stash => init_arg => undef, isa => 'HashRef', is => 'rw', predicate => 'has_stash', clearer => 'clear_stash';
has state =>
isa => 'POE::Component::Server::Twirc::State',
is => 'rw',
lazy => 1,
handles => [qw/set_user_by_id get_user_by_id delete_user_by_id get_users/],
default => sub { POE::Component::Server::Twirc::State->new };
has client_encoding => isa => 'Str', is => 'rw', default => sub { 'utf-8' };
has reconnect_delay => is => 'rw', isa => 'Num', default => 0;
has twitter_stream_watcher => is => 'rw', clearer => 'disconnect_twitter_stream',
predicate => 'has_twitter_stream_watcher';
has authenticated_user => is => 'rw', isa => 'HashRef', init_arg => undef;
# force build of users by nick hash early
sub BUILD { shift->_users_by_nick }
sub get_authenticated_user {
my $self = shift;
if ( my $r = $self->twitter(verify_credentials => { include_entities => 1 }) ) {
$self->authenticated_user($r);
if ( my $status = delete $$r{status} ) {
$$status{user} = $r;
$self->set_topic($self->formatted_status_text($status));
}
}
else {
$self->log->fatal("Failed to get authenticated user data from twitter (verify_credentials)");
$self->call('poco_shutdown');
}
};
sub twitter {
my ($self, $method, @args) = @_;
my $r = try { $self->_twitter->$method(@args) }
catch {
$self->log->error("twitter errer: $_");
if ( blessed $_ && $_->can('code') && $_->code == 502 ) {
$_ = 'Fail Whale';
}
s/ at .* line \d+//;
$self->twitter_error("$method -> $_");
undef;
};
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, $text) = @_;
$self->post_ircd(daemon_cmd_topic => $self->irc_botname, $self->irc_channel, $text);
};
# match any nick
sub nicks_alternation {
my $self = shift;
return join '|', map quotemeta, $self->user_nicks;
}
sub add_user {
my ($self, $user) = @_;
my $nick = $$user{screen_name};
$self->log->trace("add_user: $nick");
# handle nick changes
if ( my $current_user = $self->get_user_by_id($$user{id}) ) {
$self->post_ircd(daemon_cmd_nick => $$current_user{screen_name}, $nick)
if $nick ne $$current_user{screen_name};
}
$$user{FRESH} = time;
$self->set_user_by_id($user->{id}, $user);
$self->set_user_by_nick(lc($user->{screen_name}), $user);
unless ( $self->ircd->state_nick_exists($nick) ) {
$self->post_ircd(add_spoofed_nick => { nick => $nick, ircname => $$user{name} });
}
}
sub delete_user {
my ($self, $user) = @_;
$self->delete_user_by_id($user->{id});
$self->delete_user_by_nick(lc($user->{screen_name}));
}
sub _twitter_auth {
# 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',
),
}
sub _net_twitter_opts {
my $self = shift;
my %config = (
$self->_twitter_auth,
traits => [qw/API::RESTv1_1 OAuth RetryOnError/],
useragent_class => 'LWP::UserAgent::POE',
useragent => "twirc/$VERSION",
decode_html_entities => 1,
ssl => 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 max_reconnect_delay () { 600 } # ten minutes
sub twitter_stream_timeout () { 65 } # should get activity every 30 seconds
sub friends_stale_after () { 7*24*3600 } # 1 week
sub is_user_stale {
my ( $self, $user ) = @_;
return time - $user->{FRESH} > $self->friends_stale_after;
}
sub followers_stale_after () { 24*3600 } # 1 day
sub are_followers_stale {
my $self = shift;
return time - $self->state->followers_updated_at > $self->followers_stale_after;
}
sub add_follower_id {
my ( $self, $id ) = @_;
$self->state->followers->{$id} = undef;
}
sub remove_follower_id {
my ( $self, $id ) = @_;
delete $self->state->followers->{$id};
}
sub is_follower_id {
my ( $self, $id ) = @_;
return exists $self->state->followers->{$id};
}
sub twitter_screen_name { shift->authenticated_user->{screen_name} }
sub twitter_id { shift->authenticated_user->{id} }
sub formatted_status_text {
my ( $self, $status ) = @_;
my $is_retweet = !!$$status{retweeted_status};
my $s = $$status{retweeted_status} || $status;
my $text = $$s{text};
for my $e ( reverse @{$$s{entities}{urls} || []} ) {
my ($start, $end) = @{$$e{indices}};
substr $text, $start, $end - $start, "[$$e{display_url}]($$e{url})";
}
decode_entities($text);
# When the status is a retweet from verify_credentials, it doesn't have a user element
my $orig_author = $$s{user}{screen_name} || $$status{entities}{user_mentions}[0]{screen_name};
$text = "RT \@$orig_author: $text" if $is_retweet;
return $text;
}
sub connect_twitter_stream {
my $self = shift;
$self->log->trace('connect_twitter_stream');
my $w; $w = AnyEvent::Twitter::Stream->new(
$self->_twitter_auth,
token => $self->state->access_token,
token_secret => $self->state->access_token_secret,
method => 'userstream',
timeout => $self->twitter_stream_timeout,
on_connect => sub {
$self->twitter_stream_watcher($w);
$self->log->info('Connected to Twitter');
$self->bot_notice($self->irc_channel, "Twitter stream connected");
$self->reconnect_delay(0);
},
on_eof => sub {
$self->log->trace("on_eof");
$self->bot_notice($self->irc_channel, "Twitter stream disconnected");
$self->connect_twitter_stream if $self->has_twitter_stream_watcher;
},
on_error => sub {
my $e = shift;
$self->log->error("on_error: $e");
$self->bot_notice($self->irc_channel, "Twitter stream error: $e");
if ( $e =~ /^420:/ ) {
$self->log->fatal("excessive login rate; shutting down");
$self->call('poco_shutdown');
}
# progressively backoff on reconnection attepts to max_reconnect_delay
if ( my $delay = $self->reconnect_delay ) {
$self->log->debug("delaying $delay seconds before reconnecting");
}
my $t; $t = AE::timer $self->reconnect_delay, 0, sub {
undef $t;
my $next_delay = $self->reconnect_delay * 2 || 1;
$next_delay = $self->max_reconnect_delay if $next_delay > $self->max_reconnect_delay;
$self->reconnect_delay($next_delay);
$self->connect_twitter_stream;
};
},
on_keepalive => sub {
$self->log->trace("on_keepalive");
},
on_friends => sub {
$self->log->trace("on_friends: ", JSON->new->encode(@_));
$self->yield(friends_ids => shift);
},
on_event => sub {
my $msg = shift;
$self->log->trace("on_event: $$msg{event}");
$self->yield(on_event => $msg);
},
on_tweet => sub {
my $msg = shift;
$self->log->trace("on_tweet");
if ( exists $$msg{sender} ) {
$self->log->debug('received old style direct_message');
$self->yield(on_direct_message => $msg);
}
elsif ( exists $$msg{text} ) {
$self->yield(on_tweet => $msg);
}
elsif ( exists $$msg{direct_message} ) {
$self->yield(on_direct_message => $$msg{direct_message});
}
elsif ( exists $$msg{limit} ) {
$self->log->warn("track limit: $$msg{limit}{track}");
$self->bot_notice($self->irc_channel,
"Track limit received - $$msg{limit}{track} statuses missed.");
}
elsif ( exists $$msg{scrub_geo} ) {
# $$msg{scrub_geo} = {"user_id":14090452,"user_id_str":"14090452","up_to_status_id":23260136625,"up_to_status_id_str":"23260136625"}
my $e = $$msg{scrub_geo};
$self->log->info("scrub_geo: user_id=$$e{user_id}, up_to_status_id=$$e{up_to_status_id}");
}
else {
$self->log->error("unexpected message: ", JSON->new->pretty($msg));
$self->bot_notice($self->irc_channel, "Unexpected twitter packet, see the log for details");
}
},
on_delete => sub {
$self->log->trace("on_delete");
},
);
}
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->trace('[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);
}
POE::Kernel->sig(TERM => 'poco_shutdown');
POE::Kernel->sig(INT => 'poco_shutdown');
$self->get_authenticated_user;
$self->connect_twitter_stream;
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->trace("[_child] $event $child");
$kernel->detach_child($child) if $event eq 'create';
};
event poco_shutdown => sub {
my ($self) = @_;
$self->log->trace("[poco_shutdown]");
$self->disconnect_twitter_stream;
$_[KERNEL]->alarm_remove_all();
$self->post_ircd('unregister');
$self->post_ircd('shutdown');
$_[KERNEL]->call($self->_twitter->ua->{poco_alias}, 'shutdown');
if ( $self->state_file ) {
try { $self->state->store($self->state_file) }
catch {
s/ at .*//s;
$self->log->error($_);
$self->bot_notice($self->irc_channel, "Error storing state file: $_");
};
}
# TODO: Why does twirc often fail to shut down?
# This is surely the WRONG thing to do, but hit the big red kill switch.
exit 0;
};
########################################################################
# IRC events
########################################################################
event ircd_daemon_nick => sub {
my ($self, $sender, $nick) = @_[OBJECT, SENDER, ARG0];
$self->log->trace("[ircd_daemon_nick] $nick");
# if it's a nick change, we only get ARG0 and ARG1
return unless defined $_[ARG2];
return if $self->ircd->_state_user_route($nick) eq 'spoofed';
$self->irc_nickname($nick);
# 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);
# Give the user half ops (just a visual cue)
$self->post_ircd(daemon_cmd_mode => $self->irc_botname, $self->irc_channel, '+h', $nick);
};
event ircd_daemon_join => sub {
my($self, $sender, $user, $ch) = @_[OBJECT, SENDER, ARG0, ARG1];
$self->log->trace("[ircd_daemon_join] $user, $ch");
return unless my($nick) = $user =~ /^([^!]+)!/;
return if $self->ircd->_state_user_route($nick) eq 'spoofed';
if ( $ch eq $self->irc_channel ) {
$self->joined(1);
$self->log->trace(" joined!");
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->trace(" ** 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(lc $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->trace("[ircd_daemon_quit]");
return unless my($nick) = $user =~ /^([^!]+)!/;
return unless $nick eq $self->irc_nickname;
$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->trace("[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(lc $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;
}
$self->twitter(new_direct_message => { user => $target_nick, text => $text });
};
event friend_join => sub {
my ( $self, $friend ) = @_[OBJECT, ARG0];
my $nick = $$friend{screen_name};
$self->log->trace("friend_join: $nick");
$self->post_ircd(add_spoofed_nick => { nick => $nick, ircname => $$friend{name} })
unless $self->ircd->state_nick_exists($nick);
$self->post_ircd(daemon_cmd_join => $nick, $self->irc_channel);
if ( $self->is_follower_id($$friend{id}) ) {
$self->post_ircd(daemon_cmd_mode => $self->irc_botname, $self->irc_channel, '+v', $nick);
}
};
event lookup_friends => sub {
my ( $self, $ids ) = @_[OBJECT, ARG0];
return unless @$ids;
my $fresh = time;
my $r = $self->twitter(lookup_users => { user_id => $ids });
for my $friend ( @{$r || []} ) {
delete $friend->{status};
$self->add_user($friend);
$self->yield(friend_join => $friend);
}
$self->state->store($self->state_file) if $self->state_file;
};
event get_followers_ids => sub {
my ( $self ) = $_[OBJECT];
my %followers;
for ( my $cursor = -1; $cursor; ) {
if ( my $r = $self->twitter(followers_ids => { cursor => $cursor }) ) {
for my $id ( @{$$r{ids}} ) {
$followers{$id} = undef;
}
$cursor = $$r{next_cursor};
}
else {
$cursor = 0;
}
}
$self->state->followers(\%followers);
$self->state->followers_updated_at(time);
$self->yield('set_voice');
};
event set_voice => sub {
my $self = $_[OBJECT];
for my $user ( $self->get_users ) {
my $mode = $self->is_follower_id($$user{id}) ? '+v' : '-v';
$self->post_ircd(daemon_cmd_mode => $self->irc_botname, $self->irc_channel, $mode,
$$user{screen_name});
}
};
########################################################################
# Twitter events
########################################################################
event friends_ids => sub {
my ( $self, $kernel, $friends_ids ) = @_[OBJECT, KERNEL, ARG0];
my $buffer = [];
for my $id ( @$friends_ids ) {
my $friend = $self->state->twitter_users->{$id};
if ( !$friend || $self->is_user_stale($friend) ) {
push @$buffer, $id;
if ( @$buffer == 100 ) {
$self->yield(lookup_friends => [ @$buffer ]);
$buffer = [];
$kernel->run_one_timeslice;
}
}
else {
$self->yield(friend_join => $friend);
}
}
$self->yield(lookup_friends => $buffer);
$self->yield('get_followers_ids');
};
event on_tweet => sub {
my ( $self, $status ) = @_[OBJECT, ARG0];
# add or freshen user
$self->add_user($$status{user});
my $nick = $$status{user}{screen_name};
my $text = $self->formatted_status_text($status);
if ( $nick eq $self->irc_nickname ) {
$self->set_topic($text);
}
unless ( $self->ircd->state_is_chan_member($nick, $self->irc_channel) ) {
$self->post_ircd(daemon_cmd_join => $nick, $self->irc_channel);
}
$self->log->trace("on_tweet: <$nick> $text");
$self->post_ircd(daemon_cmd_privmsg => $nick, $self->irc_channel, $_) for split /[\r\n]+/, $text;
};
event on_event => sub {
my ( $self, $msg ) = @_[OBJECT, ARG0];
### Potential events:
#
## implemented:
# retweet
# follow unfollow
# block unblock
# favorite unfavorite
#
## unimplemented:
# user_update
# list_created list_updated list_destroyed
# list_member_added list_member_removed
# list_user_subscribed list_user_unsubscribed
my $method = "on_event_$$msg{event}";
return $self->$method($msg) if $self->can($method);
$self->bot_notice($self->irc_channel, "Unhandled Twitter stream event: $$msg{event}");
$self->log->debug("unhandled event", JSON->new->pretty->encode($msg));
};
sub on_event_follow {
my ( $self, $event ) = @_;
if ( my $source = $$event{source} ) {
my $target = $$event{target} || return;
# new friend
if ( $$source{id} eq $self->twitter_id ) {
$self->yield(friend_join => $target);
$self->bot_notice($self->irc_channel, qq/Now following $$target{screen_name}./);
}
# new follower
elsif ( $$target{id} eq $self->twitter_id ) {
$self->bot_notice($self->irc_channel, qq`\@$$source{screen_name} "$$source{name}" `
. qq`is following you https://twitter.com/$$source{screen_name}`);
$self->add_follower_id($$source{id});
}
}
}
sub on_event_favorite { shift->_favorite_or_retweet(favorited => @_) }
sub on_event_unfavorite { shift->_favorite_or_retweet(unfavorited => @_) }
sub on_event_retweet { shift->_favorite_or_retweet(retweeted => @_) }
sub _favorite_or_retweet {
my ( $self, $verb, $event ) = @_;
my $status = $$event{target_object};
my $who = $$event{source}{id} eq $self->twitter_id ? 'You' : $$event{source}{screen_name};
my $whom = $$event{target}{id} eq $self->twitter_id ? 'your' : "$$event{target}{screen_name}'s";
my $link = "https://twitter.com/$$status{user}{screen_name}/status/$$status{id}";
my $text = $self->formatted_status_text($status);
$self->bot_notice($self->irc_channel,
elide(qq/$who $verb $whom "$text"/, 80, { marker => '…"' }) . " [$link]");
}
sub on_event_block {
my ( $self, $event ) = @_;
my $target = $$event{target};
if ( $self->get_user_by_id($$target{id}) ) {
$self->post_ircd(daemon_cmd_mode =>
$self->irc_botname, $self->irc_channel, '-v', $$target{screen_name});
$self->remove_follower_id($$target{id});
}
$self->bot_notice($self->irc_channel, qq/You blocked $$target{screen_name}./);
}
sub on_event_unblock {
my ( $self, $event ) = @_;
my $target = $$event{target};
if ( $self->get_user_by_id($$target{id}) ) {
$self->post_ircd(daemon_cmd_mode =>
$self->irc_botname, $self->irc_channel, '+v', $$target{screen_name});
}
$self->bot_notice($self->irc_channel, qq/You unblocked $$target{screen_name}./);
}
sub on_event_list_member_added { shift->_list_add_or_remove(qw/added to/, @_) }
sub on_event_list_member_removed { shift->_list_add_or_remove(qw/removed from/, @_) }
sub _list_add_or_remove {
my ( $self, $verb, $preposition, $event ) = @_;
my $list = $$event{target_object};
my $who = $$event{source}{id} eq $self->twitter_id ? 'You' : $$event{source}{screen_name};
my $whom = $$event{target}{id} eq $self->twitter_id ? 'you' : $$event{target}{screen_name};
my $link = "https://twitter.com$$list{uri}";
$self->bot_notice($self->irc_channel, "$who $verb $whom $preposition list [$$list{name}]($link)");
}
event on_direct_message => sub {
my ( $self, $msg ) = @_[OBJECT, ARG0];
if ( $$msg{recipient_screen_name} ne $self->twitter_screen_name ) {
$self->log->info('direct message sent to @', $$msg{recipient_screen_name});
return;
}
my $nick = $$msg{sender_screen_name};
my $sender = $$msg{sender};
unless ( $self->ircd->state_nick_exists($nick) ) {
# This shouldn't happen - twitter only allows direct messages to followers, so
# we *should* already have $nick on board.
$self->post_ircd(add_spoofed_nick => { nick => $nick, ircname => $$sender{name} });
$self->add_user($sender);
}
my $text = $self->formatted_status_text($msg);
$self->post_ircd(daemon_cmd_privmsg => $nick, $self->irc_nickname, $_)
for split /\r?\n/, $text;
};
########################################################################
# Commands
########################################################################
=head2 COMMANDS
Commands are entered as public messages in the IRC channel in the form:
command arg1 arg2 ... argn
Where the arguments, if any, depend upon the command.
=over 4
=item post I<status>
Post a status update. E.g.,
post Now cooking tweets with twirc!
=cut
event cmd_post => sub {
my ($self, $channel, $text) = @_[OBJECT, ARG0, ARG1];
$self->log->trace("[cmd_post_status]");
return if $self->status_text_too_long($channel, $text);
my $status = $self->twitter(update => $text) || return;
$self->log->trace(" update returned $status");
};
sub status_text_too_long {
my ( $self, $channel, $text ) = @_;
if ( (my $n = $self->_calc_text_length($text) - 140) > 0 ) {
$self->bot_says($channel, "$n characters too long.");
return $n;
}
return;
}
sub _calc_text_length {
my ( $self, $text ) = @_;
my $http_urls = $text =~ s/$RE{URI}{HTTP}//g;
my $https_urls = $text =~ s/$RE{URI}{HTTP}{-scheme => 'https'}//g;
return length($text) + $http_urls * 20 + $https_urls * 21;
}
=item follow I<id>
Follow a new Twitter user, I<id>. In Twitter parlance, this creates a friendship.
=cut
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;
}
$self->twitter(create_friend => $id);
};
=item unfollow I<id>
Stop following Twitter user I<id>. In Twitter, parlance, this destroys a
friendship.
=cut
event cmd_unfollow => sub {
my ($self, $channel, $id) = @_[OBJECT, ARG0, ARG1];
my $user = $self->get_user_by_nick(lc $id);
unless ( $user ) {
$self->bot_says($channel, qq/You don't appear to be following $id./);
return;
}
$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./);
$self->delete_user($user);
};
=item block I<id>
Block Twitter user I<id>.
=cut
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 => { screen_name => $id });
};
=item unblock I<id>
Stop blocking Twitter user I<id>.
=cut
event cmd_unblock => sub {
my ( $self, $channel, $id ) = @_[OBJECT, ARG0, ARG1];
if ( $id !~ /^\w+$/ ) {
$self->bot_says($self->irc_channel, qq/"$id" doesn't look like a Twitter screen name to me./);
return;
}
$self->twitter(destroy_block => { screen_name => $id});
};
=item whois I<id>
Displays information about Twitter user I<id>, including name, location, and
description.
=cut
event cmd_whois => sub {
my ($self, $channel, $nick) = @_[OBJECT, ARG0, ARG1];
$self->log->trace("[cmd_whois] $nick");
my $user = $self->get_user_by_nick(lc $nick);
unless ( $user ) {
$self->log->trace(" $nick not in users; fetching");
$user = $self->twitter(show_user => { screen_name => $nick });
}
if ( $user ) {
$self->bot_says(
$channel,
sprintf('%s [%s]: %s, %s', @{$user}{qw/screen_name id name location description url/})
);
}
else {
$self->bot_says($channel, "I don't know $nick.");
}
};
=item notify I<on|off> I<id ...>
Turns device notifications on or off for the list of Twitter IDs.
=cut
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 ) {
$self->twitter($method => { id => $nick });
}
};
=item favorite I<screen_name> [I<count>]
Mark a tweet as a favorite. Specify the user by I<screen_name> and select from a
list of recent tweets. Optionally, specify the number of tweets to display for
selection with I<count> (Defaults to 3.)
=cut
event cmd_favorite => sub {
my ($self, $channel, $args) = @_[OBJECT, ARG0, ARG1];
my ($nick, $count) = split /\s+/, $args;
$count ||= $self->selection_count;
$self->log->trace("[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_str}, @$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->trace("[handle_favorite] $index");
my @candidates = @{$self->stash->{candidates} || []};
if ( $index =~ /^\d+$/ && 0 < $index && $index <= @candidates ) {
$self->twitter(create_favorite => { id => $candidates[$index - 1] });
$self->clear_stash;
return 1; # handled
}
return 0; # unhandled
};
=item rate_limit_status
Displays the remaining number of API requests available in the current hour.
=cut
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},
);
}
};
=item retweet I<screen_name> [I<count>]
Re-tweet another user's status. Specify the user by I<screen_name> and select from a
list of recent tweets. Optionally, specify the number of tweets to display for
selection with I<count> (Defaults to 3.)
=cut
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->selection_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_str}, @$recent ],
});
$self->bot_says($channel, 'Which tweet?');
for ( 1..@$recent ) {
$self->bot_says($channel, "[$_] " . elide($recent->[$_ - 1]{text}, $self->truncate_to));
}
};
=item rt I<screen_name> [I<count>]
An alias for the C<retweet> command.
=cut
event cmd_rt => sub { shift->cmd_retweet(@_) };
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
};
=item reply I<screen_name> [I<-count>] I<message>
Reply to another user's status. Specify the user by I<screen_name> and select
from a list of recent tweets. Optionally, specify the number of tweets to
display for selection with I<-count> (Defaults to 3.) Note that the count
parameter is prefixed with a dash.
=cut
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;
}
$message = "\@$nick $message";
return if $self->status_text_too_long($channel, $message);
$count ||= $self->selection_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_str}, @$recent ],
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 ) {
$self->twitter(update => {
status => $self->stash->{message},
in_reply_to_status_id => $candidates[$index - 1],
});
$self->clear_stash;
return 1; # handled
}
return 0; # unhandled
};
=item report_spam
Report 1 or more screen names as spammers.
=cut
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 });
};
=item add I<screen_name> to I<list-slug>
Add a user to one of your lists.
=cut
event cmd_add => sub { $_[OBJECT]->_add_remove_list_member(qw/add to/, @_[ARG0, ARG1]) };
sub _add_remove_list_member {
my ( $self, $verb, $preposition, $channel, $args ) = @_;
my ( $nick, $slug ) = ($args || '') =~ /
^@?(\w+) # nick; strip leading @ if there is one
\s+$preposition\s+
([-\w]+) # the list-slug
\s*$
/x;
unless ( defined $nick ) {
$self->bot_says($channel, "usage: $verb <nick> $preposition <list-slug>");
return;
}
$self->twitter($verb . '_list_member' => {
owner_id => $self->twitter_id,
slug => $slug,
screen_name => $nick,
});
};
=item remove I<screen_name> from I<list-slug>
Add a user to one of your lists.
=cut
event cmd_remove => sub { $_[OBJECT]->_add_remove_list_member(qw/remove from/, @_[ARG0, ARG1]) };
=item help
Display a simple help message
=cut
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 favorite
rate_limit_status retweet report_spam
/);
$self->bot_says($channel, '/msg nick for a direct message.')
};
1;
__END__
=item /msg I<id> I<text>
Sends a direct message to Twitter user I<id> using an IRC private message.
=back
=head1 SEE ALSO
L<App::Twirc>
=head1 AUTHOR
Marc Mims <marc@questright.com>
=head1 CONTRIBUTORS
Adam Prime <adam.prime@utoronto.ca> (@adamprime)
=head1 LICENSE
Copyright (c) 2008 Marc Mims
You may distribute this code and/or modify it under the same terms as Perl itself.