use strict; use v5.10; use Irssi; use Irssi::Irc; use Net::Twitter qw/3.11009/; use Twitter::API; use HTTP::Date; use HTML::Entities; # decode_entities use File::Temp; use LWP::Simple; use Data::Dumper; use FileHandle; use POSIX qw/:sys_wait_h strftime/; use Encode; use JSON::MaybeXS; use DateTime; use DateTime::Format::Strptime; $Data::Dumper::Indent = 1; use vars qw($VERSION %IRSSI); $VERSION = sprintf '%s', q$Version: v2.9.0$ =~ /^\w+:\s+v(\S+)/; %IRSSI = ( authors => '@zigdon, @gedge', contact => 'gedgey@gmail.com', name => 'twirssi', description => 'Send twitter updates using /tweet. ' . 'Can optionally set your bitlbee /away message to same', license => 'GNU GPL v2', url => 'http://twirssi.com', changed => '$Date: 2023-06-10 18:00:00 +0000$', ); my $twit; # $twit is current logged-in Net::Twitter or Twitter::API object (usually one of %twits) my %twits; # $twits{$username} = logged-in object my %oauth; my $user; # current $account my $defservice; # current $service my $poll_event; # timeout_add event object (regular update) my %last_poll; # $last_poll{$username}{tweets|friends|blocks|lists} = time of last update # {__interval|__poll} = time my %nicks; # $nicks{$screen_name} = last seen/mentioned time (for sorting completions) my %friends; # $friends{$username}{$nick} = $epoch_when_refreshed (rhs value used??) my %blocks; # $blocks {$username}{$nick} = $epoch_when_refreshed (rhs value used??) my %tweet_cache; # $tweet_cache{$tweet_id} = time of tweet (helps keep last hour of IDs, to avoid dups) my %state; # $state{__ids} {$lc_nick}[$cache_idx] = $tweet_id # $state{__u} {$lc_nick} = { id=>$user_id } # $state{__i} {$user_id} = $lc_nick # $state{__i_is_bad} {$user_id} = $epoch_time_when_failed_to_find_user_id # $state{__tweets} {$lc_nick}[$cache_idx] = $tweet_text # $state{__nls} {$lc_nick}[$cache_idx] = $nl (infix in above) # $state{__usernames} {$lc_nick}[$cache_idx] = $username_that_polled_tweet # $state{__reply_to_ids} {$lc_nick}[$cache_idx] = $polled_tweet_replies_to_this_id # $state{__reply_to_users} {$lc_nick}[$cache_idx] = $polled_tweet_replies_to_this_user # $state{__created_ats} {$lc_nick}[$cache_idx] = $time_of_tweet # $state{__indexes} {$lc_nick} = $last_cache_idx_used # $state{__last_id} {$username}{timeline|reply|dm} = $id_of_last_tweet # {__sent} = $id_of_last_tweet_from_act # {__extras}{$lc_nick} = $id_of_last_tweet (fix_replies) # {__search}{$topic} = $id_of_last_tweet # $state{__lists} {$username}{$list_name} = { id => $list_id, members=>[$nick,...] } # $state{__channels} {$type}{$tag}{$net_tag} = [ channel,... ] # $state{__windows} {$type}{$tag} = $window_name my $failstatus = 0; # last update status: 0=ok, 1=warned, 2=failwhaled my $first_call = 1; my $child_pid; my %fix_replies_index; # $fix_replies_index($username} = 0..100 idx in sort keys $state{__last_id}{$username}{__extras} my %search_once; my $update_is_running = 0; my %logfile; my %settings; my %last_ymd; # $last_ymd{$chan_or_win} = $last_shown_ymd my @datetime_parser; my %completion_types = (); my %expanded_url = (); my $ua; my %valid_types = ( 'window' => [ qw/ tweet search dm reply sender error default /], # twirssi_set_window 'channel' => [ qw/ tweet search dm reply sender error * / ], # twirssi_set_channel ); my $local_tz = DateTime::TimeZone->new( name => 'local' ); my @settings_defn = ( [ 'broadcast_users', 'twirssi_broadcast_users', 's', undef, 'list{,}' ], [ 'charset', 'twirssi_charset', 's', 'utf8', ], [ 'default_service', 'twirssi_default_service', 's', 'Twitter', ], [ 'ignored_accounts', 'twirssi_ignored_accounts', 's', '', 'list{,},norm_user' ], [ 'ignored_twits', 'twirssi_ignored_twits', 's', '', 'lc,list{,}' ], [ 'ignored_tags', 'twirssi_ignored_tags', 's', '', 'lc,list{,}' ], [ 'location', 'twirssi_location', 's', Irssi::get_irssi_dir . "/scripts/$IRSSI{name}.pl" ], [ 'nick_color', 'twirssi_nick_color', 's', '%B', ], [ 'ymd_color', 'twirssi_ymd_color', 's', '%r', ], [ 'oauth_store', 'twirssi_oauth_store', 's', Irssi::get_irssi_dir . "/scripts/$IRSSI{name}.oauth" ], [ 'replies_store', 'twirssi_replies_store', 's', Irssi::get_irssi_dir . "/scripts/$IRSSI{name}.json" ], [ 'dump_store', 'twirssi_dump_store', 's', Irssi::get_irssi_dir . "/scripts/$IRSSI{name}.dump" ], [ 'poll_store', 'twirssi_poll_store', 's', Irssi::get_irssi_dir . "/scripts/$IRSSI{name}.polls" ], [ 'id_store', 'twirssi_id_store', 's', Irssi::get_irssi_dir . "/scripts/$IRSSI{name}.ids" ], [ 'retweet_format', 'twirssi_retweet_format', 's', 'RT $n: "$t" ${-- $c$}' ], [ 'retweeted_format', 'twirssi_retweeted_format', 's', 'RT $n: $t' ], [ 'stripped_tags', 'twirssi_stripped_tags', 's', '', 'list{,}' ], [ 'topic_color', 'twirssi_topic_color', 's', '%r', ], [ 'timestamp_format', 'twirssi_timestamp_format', 's', '%H:%M:%S', ], [ 'window_priority', 'twirssi_window_priority', 's', 'account', ], [ 'upgrade_branch', 'twirssi_upgrade_branch', 's', 'master', ], [ 'upgrade_dev', 'twirssi_upgrade_dev', 's', 'gedge', ], [ 'bitlbee_server', 'bitlbee_server', 's', 'bitlbee' ], [ 'hilight_color', 'twirssi_hilight_color', 's', '%M' ], [ 'unshorten_color', 'twirssi_unshorten_color', 's', '%b' ], [ 'shorter_color', 'twirssi_shorter_color', 's', '%X7O' ], [ 'passwords', 'twitter_passwords', 's', undef, 'list{,}' ], [ 'usernames', 'twitter_usernames', 's', undef, 'list{,}' ], [ 'update_usernames', 'twitter_update_usernames', 's', undef, 'list{,}' ], [ 'url_provider', 'short_url_provider', 's', 'TinyURL' ], [ 'url_unshorten', 'short_url_domains', 's', '', 'lc,list{ }' ], [ 'url_args', 'short_url_args', 's', undef ], [ 'window', 'twitter_window', 's', 'twitter' ], [ 'debug_win_name', 'twirssi_debug_win_name', 's', '' ], [ 'limit_user_tweets', 'twitter_user_results', 's', '20' ], [ 'always_shorten', 'twirssi_always_shorten', 'b', 0 ], [ 'rt_to_expand', 'twirssi_retweet_to_expand', 'b', 1 ], [ 'avoid_ssl', 'twirssi_avoid_ssl', 'b', 0 ], [ 'debug', 'twirssi_debug', 'b', 0 ], [ 'notify_timeouts', 'twirssi_notify_timeouts', 'b', 1 ], [ 'logging', 'twirssi_logging', 'b', 0 ], [ 'mini_whale', 'twirssi_mini_whale', 'b', 0 ], [ 'own_tweets', 'show_own_tweets', 'b', 1 ], [ 'to_away', 'tweet_to_away', 'b', 0 ], [ 'upgrade_beta', 'twirssi_upgrade_beta', 'b', 1 ], [ 'use_oauth', 'twirssi_use_oauth', 'b', 1 ], [ 'use_reply_aliases', 'twirssi_use_reply_aliases', 'b', 0 ], [ 'window_input', 'tweet_window_input', 'b', 0 ], [ 'retweet_classic', 'retweet_classic', 'b', 0 ], [ 'retweet_show', 'retweet_show', 'b', 0 ], [ 'force_first', 'twirssi_force_first', 'b', 0 ], [ 'multiline_show_empty', 'twirssi_multiline_show_empty', 'b', 1 ], [ 'multiline_show_blank', 'twirssi_multiline_show_blank', 'b', 1 ], [ 'multiline_show_contentless', 'twirssi_multiline_show_contentless', 'b', 1 ], [ 'friends_poll', 'twitter_friends_poll', 'i', 600 ], [ 'blocks_poll', 'twitter_blocks_poll', 'i', 900 ], [ 'lists_poll', 'twitter_lists_poll', 'i', 900 ], [ 'poll_interval', 'twitter_poll_interval', 'i', 300 ], [ 'poll_schedule', 'twitter_poll_schedule', 's', '', 'list{,}' ], [ 'search_results', 'twitter_search_results', 'i', 5 ], [ 'autosearch_results','twitter_autosearch_results','i', 0 ], [ 'timeout', 'twitter_timeout', 'i', 30 ], [ 'track_replies', 'twirssi_track_replies', 'i', 100 ], [ 'tweet_max_chars', 'twirssi_tweet_max_chars', 'i', 280 ], [ 'dm_max_chars', 'twirssi_dm_max_chars', 'i', 10000 ], ); my %meta_to_twit = ( # map file keys to twitter keys 'id' => 'id', 'created_at' => 'created_at', 'reply_to_user' => 'in_reply_to_screen_name', 'reply_to_id' => 'in_reply_to_status_id', ); my %irssi_to_mirc_colors = ( '%k' => '01', # black '%r' => '05', # brown '%g' => '03', # green '%y' => '07', # orange '%b' => '02', # deep blue '%m' => '06', # purple / magenta '%c' => '10', # aqua / dull cyan '%w' => '15', # light grey '%K' => '14', # grey / bright black (appears black XXX) '%R' => '04', # red '%G' => '09', # bright green '%Y' => '08', # yellow '%B' => '12', # bright blue '%M' => '13', # pink / bright magenta '%C' => '11', # bright aqua / cyan '%W' => '00', # white ); sub cmd_direct { my ( $data, $server, $win ) = @_; my ( $target, $text ) = split ' ', $data, 2; unless ( $target and $text ) { ¬ice( ["dm"], "Usage: /dm " ); return; } &cmd_direct_as( "$user $data", $server, $win ); } sub user_to_id { my $obj = shift; my $user = shift; my $ctx = shift // "u2id"; my $fh = shift; if (not defined $state{__u}{lc $user} or not defined $state{__u}{lc $user}{id}) { my $r; eval { $r = $obj->lookup_users({screen_name=>$user, include_entities=>0}); if (not defined $r) { &error([$ctx, $fh], "Cannot get id for user: $user" ); return; } }; if ($@) { &error([$ctx, $fh], "Failed to get id for user: $user" ); return; } if (not defined $r->[0] or not exists $r->[0]->{id_str}) { &error([$ctx, $fh], "Bad response for id for user: $user" ); return; } if (defined $fh) { printf $fh "t:uid id:%s nick:%s\n", $r->[0]->{id_str}, lc $user; } $state{__u}{lc $user}{id} = $r->[0]->{id_str}; $state{__i}{$r->[0]->{id_str}} = lc $user; } return $state{__u}{lc $user}{id}; } sub id_to_user { my $obj = shift; my $u_id = shift; my $ctx = shift // "id2u"; my $fh = shift; if (not defined $state{__i}{$u_id}) { my $r; eval { $r = $obj->lookup_users({user_id=>$u_id, include_entities=>0}); if (not defined $r) { &error([$ctx, $fh], "Cannot get user for id $u_id" ); return; } }; if ($@) { if ($@ =~ /^No user matches /) { if (defined $state{__i_is_bad}{$u_id} and $state{__i_is_bad}{$u_id} + 86400 > time) { return; } $state{__i_is_bad}{$u_id} = time; if (defined $fh) { printf $fh "t:unuid id:%s\n", $u_id; } &error([$ctx, $fh], "FAILED TO GET User $u_id" . (defined($r) ? " " . Dumper(\$r) : '')); return; } &error([$ctx, $fh], "Failed to get user for id $u_id: $@" ); return; } if (not defined $r->[0] or not exists $r->[0]->{screen_name}) { &error([$ctx, $fh], "Bad response for id for user: $u_id" ); return; } if (defined $fh) { printf $fh "t:uid id:%s nick:%s\n", $u_id, lc $r->[0]->{screen_name}; } $state{__i}{$u_id} = lc $r->[0]->{screen_name}; $state{__u}{lc $r->[0]->{screen_name}}{id} = $u_id; } return $state{__i}{$u_id}; } sub cmd_direct_as { my ( $data, $server, $win ) = @_; my ( $username, $target, $text ) = split ' ', $data, 3; unless ( $username and $target and $text ) { ¬ice( ["dm"], "Usage: /dm_as " ); return; } return unless $username = &valid_username($username); return unless &logged_in($twits{$username}); my $target_norm = &normalize_username($target, 1); my $target_id = &user_to_id($twits{$username}, $target, "dm"); return unless defined $target_id; $text = &shorten($text); return if &too_long($text, ['dm', $target_norm]); eval { my $r = $twits{$username}->request(post => 'direct_messages/events/new', { -to_json => { event => { type => 'message_create', message_create => { target => { recipient_id => $target_id, }, message_data => { text => $text, }, }, }, }, }); if (not defined $r) { my $error; eval { $error = decode_json( $twits{$username}->get_error() ); $error = $error->{error}; }; die "$error\n" if $error; ¬ice( [ "dm", $target_norm ], "DM to $target failed" ); return; } ¬ice( [ "dm", $target_norm ], "DM sent to $target: $text" ); $nicks{$target} = time; }; if ($@) { &error( "DM caused an error: $@" ); return; } } sub cmd_retweet { my ( $data, $server, $win ) = @_; $data =~ s/^\s+|\s+$//; unless ($data) { ¬ice( [ "tweet", $user ], "Usage: /retweet [comment]" ); return; } (my $id, $data ) = split ' ', $data, 2; &cmd_retweet_as( "$user $id $data", $server, $win ); } sub cmd_retweet_as { my ( $data, $server, $win ) = @_; $data =~ s/^\s+|\s+$//; ( my $username, my $id, $data ) = split ' ', $data, 3; unless ($username) { ¬ice( ["tweet"], "Usage: /retweet_as [comment]" ); return; } return unless $username = &valid_username($username); return unless &logged_in($twits{$username}); my $nick; $id =~ s/[^\w\d\-:]+//g; ( $nick, $id ) = split /:/, $id; unless ( exists $state{__ids}{ lc $nick } ) { ¬ice( [ "tweet", $username ], "Can't find a tweet from $nick to retweet!" ); return; } $id = $state{__indexes}{lc $nick} unless defined $id; unless ( $state{__ids}{ lc $nick }[$id] ) { ¬ice( [ "tweet", $username ], "Can't find a tweet numbered $id from $nick to retweet!" ); return; } unless ( $state{__tweets}{ lc $nick }[$id] ) { ¬ice( [ "tweet", $username ], "The text of this tweet isn't saved, sorry!" ); return; } my $text = &format_expand(fmt => $settings{retweet_format}, nick => $nick, data => $data, tweet => $state{__tweets}{ lc $nick }[$id]); my $modified = $data; $data = &shorten($text); return if ($modified or $settings{retweet_classic}) and &too_long($data, ['tweet', $username]); my $success = 1; my $extra_info = ''; eval { if ($modified or $settings{retweet_classic}) { $success = $twits{$username}->update( { status => $data, # in_reply_to_status_id => $state{__ids}{ lc $nick }[$id] } ); $extra_info = ' (classic/edited)'; } else { $success = $twits{$username}->retweet( { id => $state{__ids}{ lc $nick }[$id] } ); # $retweeted_id{$username}{ $state{__ids}{ lc $nick }[$id] } = 1; $extra_info = ' (native)'; } }; unless ($success) { ¬ice( [ "tweet", $username ], "Update failed" ); return; } if ($@) { &error( [ $username ], "Update caused an error: $@. Aborted" ); return; } $extra_info .= ' id=' . $success->{id} if $settings{debug}; foreach ( $data =~ /@([-\w]+)/g ) { $nicks{$_} = time; } ¬ice( [ "tweet", $username ], "Retweet of $nick:$id sent" . $extra_info ); } sub format_expand { my %args = @_; $args{fmt} =~ s/\$n/\@$args{nick}/g; if (defined $args{data} and $args{data} ne '') { $args{fmt} =~ s/\$\{|\$}//g; $args{fmt} =~ s/\$c/$args{data}/g; } else { $args{fmt} =~ s/\$\{.*?\$}//g; } $args{fmt} =~ s/\$t/$args{tweet}/g; return $args{fmt}; } sub cmd_retweet_to_window { my ( $data, $server, $win ) = @_; $data =~ s/^\s+|\s+$//; ( my $id, $data ) = split ' ', $data, 2; $id =~ s/[^\w\d\-:]+//g; ( my $nick, $id ) = split ':', $id; unless ( exists $state{__ids}{ lc $nick } ) { ¬ice( [ "tweet" ], "Can't find a tweet from $nick to retweet!" ); return; } $id = $state{__indexes}{lc $nick} unless defined $id; unless ( $state{__ids}{ lc $nick }[$id] ) { ¬ice( [ "tweet" ], "Can't find a tweet numbered $id from $nick to retweet!" ); return; } unless ( $state{__tweets}{ lc $nick }[$id] ) { ¬ice( [ "tweet" ], "The text of this tweet isn't saved, sorry!" ); return; } my $target = ''; my $got_net = 0; my $got_target = 0; while (not $got_target and $data =~ s/^(\S+)\s*//) { my $arg = $1; if (not $got_net and lc($arg) ne '-channel' and lc($arg) ne '-nick' and $arg =~ /^-/) { $got_net = 1; } else { if (lc($arg) eq '-channel' or lc($arg) eq '-nick') { last if not $data =~ s/^(\S+)\s*//; $arg .= " $1"; } $got_target = 1; } $target .= ($target ne '' ? ' ' : '') . $arg; } if (not $got_target) { ¬ice( [ "tweet" ], "Missing target." ); return; } my $text = &format_expand(fmt => $settings{retweet_format}, nick => $nick, data => $data, tweet => &post_process_tweet($state{__tweets}{ lc $nick }[$id], not $settings{rt_to_expand})); Irssi::command("msg $target $text"); foreach ( $text =~ /@([-\w]+)/g ) { $nicks{$_} = time; } &debug("Retweet of $nick:$id sent to $target"); } sub cmd_reload { if ($settings{force_first} and $settings{poll_store}) { &save_state(); &save_polls(); } Irssi::command("script load $IRSSI{name}"); } sub cmd_tweet { my ( $data, $server, $win ) = @_; $data =~ s/^\s+|\s+$//; unless ($data) { ¬ice( ["tweet"], "Usage: /tweet " ); return; } &cmd_tweet_as( "$user\@$defservice $data", $server, $win ); } sub cmd_tweet_as { my ( $data, $server, $win ) = @_; $data =~ s/^\s+|\s+$//; $data =~ s/\s\s+/ /g; ( my $username, $data ) = split ' ', $data, 2; unless ( $username and $data ) { ¬ice( ["tweet"], "Usage: /tweet_as " ); return; } return unless $username = &valid_username($username); return unless &logged_in($twits{$username}); $data = &shorten($data); return if &too_long($data, ['tweet', $username]); my $success = 1; my $res; eval { unless ( $res = $twits{$username}->update($data) ) { ¬ice( [ "tweet", $username ], "Update failed" ); $success = 0; } }; return unless $success; if ($@) { &error( [ $username ], "Update caused an error: $@. Aborted." ); return; } foreach ( $data =~ /@([-\w]+)/g ) { $nicks{$_} = time; } # TODO: What's the official definition of a Hashtag? Let's use #[-\w]+ like above for now. if ( $settings{autosearch_results} > 0 and $data =~ /#[-\w]+/ ) { my @topics; while ( $data =~ /(#[-\w]+)/g ) { push @topics, $1; $search_once{$username}->{$1} = $settings{autosearch_results}; } &get_updates([ 0, [ [ $username, { up_searches => [ @topics ] } ], ], ]); } $state{__last_id}{$username}{__sent} = $res->{id}; my $id_info = ' id=' . $res->{id} if $settings{debug}; my $away_info = ''; if ( $username eq "$user\@$defservice" and $settings{to_away} and &update_away($data) ) { $away_info = " (and away msg set)"; } ¬ice( [ "tweet", $username ], "Update sent" . $away_info . $id_info ); } sub cmd_broadcast { my ( $data, $server, $win ) = @_; my @bcast_users = @{ $settings{broadcast_users} }; @bcast_users = keys %twits if not @bcast_users; foreach my $buser (@bcast_users) { &cmd_tweet_as( "$buser $data", $server, $win ); } } sub cmd_info { my ( $data, $server, $win ) = @_; $data =~ s/^\s+|\s+$//g; unless ( $data ) { ¬ice( ["info"], "Usage: /twitter_info " ); return; } $data =~ s/[^\w\-:]+//g; my ( $nick_orig, $id ) = split /:/, $data; my $nick = lc $nick_orig; unless ( exists $state{__ids}{ $nick } ) { ¬ice( [ "info" ], "Can't find any tweet from $nick_orig!" ); return; } $id = $state{__indexes}{$nick} unless defined $id; my $statusid = $state{__ids}{$nick}[$id]; unless ( $statusid ) { ¬ice( [ "info" ], "Can't find a tweet numbered $id from $nick_orig!" ); return; } my $username = $state{__usernames}{$nick}[$id]; my $timestamp = $state{__created_ats}{$nick}[$id]; my $tweet = $state{__tweets}{$nick}[$id]; my $nl = $state{__nls}{$nick}[$id]; my $reply_to_id = $state{__reply_to_ids}{$nick}[$id]; my $reply_to_user = $state{__reply_to_users}{$nick}[$id]; my $exp_tweet = $tweet; if ($tweet) { $tweet = &post_process_tweet($tweet, 1); $exp_tweet = &post_process_tweet($exp_tweet); } my $url = ''; if ( defined $username ) { if ( $username =~ /\@Twitter/ ) { $url = "http://twitter.com/$nick/statuses/$statusid"; } elsif ( $username =~ /\@Identica/ ) { $url = "http://identi.ca/notice/$statusid"; } } ¬ice( [ "info" ], ",--------- $nick:$id" ); ¬ice( [ "info" ], "| nick: $nick_orig " ); ¬ice( [ "info" ], "| id: $statusid" . ($url ? " <$url>" : '')); ¬ice( [ "info" ], "| time: " . ($timestamp ? DateTime->from_epoch( epoch => $timestamp, time_zone => $local_tz) : '') ); ¬ice( [ "info" ], "| account: " . ($username ? $username : '' ) ); for my $line_n (&get_multilines({ text => $tweet, nl => $nl })) { ¬ice( [ "info" ], "| text: " . ($line_n ? $line_n : '' ) ); } ¬ice( [ "info" ], "| +url: " . $exp_tweet ) if $exp_tweet ne $tweet; if ($reply_to_id and $reply_to_user) { my $reply_to_marker = id_to_marker(lc($reply_to_user), $reply_to_id); ¬ice( [ "info" ], "| ReplyTo: $reply_to_user:$reply_to_marker (id=$reply_to_id)" ); ¬ice( [ "info" ], "| thread: http://twitter.theinfo.org/$statusid"); } ¬ice( [ "info" ], "`---------" ); } sub cmd_reply { my ( $data, $server, $win ) = @_; $data =~ s/^\s+|\s+$//; unless ($data) { ¬ice( ["reply"], "Usage: /reply " ); return; } ( my $id, $data ) = split ' ', $data, 2; unless ( $id and $data ) { ¬ice( ["reply"], "Usage: /reply " ); return; } &cmd_reply_as( "$user $id $data", $server, $win ); } sub cmd_reply_as { my ( $data, $server, $win ) = @_; $data =~ s/^\s+|\s+$//; ( my $username, my $id, $data ) = split ' ', $data, 3; unless ( $username and $data ) { ¬ice( ["reply"], "Usage: /reply_as " ); return; } return unless $username = &valid_username($username); return unless &logged_in($twits{$username}); my $nick; $id =~ s/[^\w\d\-:]+//g; ( $nick, $id ) = split /:/, $id; unless ( exists $state{__ids}{ lc $nick } ) { ¬ice( [ "reply", $username ], "Can't find a tweet from $nick to reply to!" ); return; } $id = $state{__indexes}{lc $nick} unless defined $id; unless ( $state{__ids}{ lc $nick }[$id] ) { ¬ice( [ "reply", $username ], "Can't find a tweet numbered $id from $nick to reply to!" ); return; } $data = "\@$nick $data"; $data = &shorten($data); return if &too_long($data, ['reply', $username]); my $success = 1; eval { unless ( $twits{$username}->update( { status => $data, in_reply_to_status_id => $state{__ids}{ lc $nick }[$id] } ) ) { ¬ice( [ "reply", $username ], "Update failed" ); $success = 0; } }; return unless $success; if ($@) { ¬ice( [ "reply", $username ], "Update caused an error: $@. Aborted" ); return; } foreach ( $data =~ /@([-\w]+)/g ) { $nicks{$_} = time; } my $away = $settings{to_away} ? &update_away($data) : 0; ¬ice( [ "reply", $username ], "Update sent" . ( $away ? " (and away msg set)" : "" ) ); } sub gen_cmd { my ( $usage_str, $api_name, $post_ref, $data_ref ) = @_; return sub { my ( $data, $server, $win ) = @_; return unless &logged_in($twit); if ($data_ref) { $data = $data_ref->($data); } $data =~ s/^\s+|\s+$//; unless ($data) { ¬ice("Usage: $usage_str"); return; } my $success = 1; eval { unless ( $twit->$api_name($data) ) { ¬ice("$api_name failed"); $success = 0; } }; return unless $success; if ($@) { &error("$api_name caused an error. Aborted: $@"); return; } &$post_ref($data, $server, $win) if $post_ref; } } sub cmd_listinfo { my ( $data, $server, $win ) = @_; $data =~ s/^\s+|\s+$//g; if ( length $data > 0 ) { my ($list_user, $list_name) = split(' ', lc $data, 2); my $list_account = &normalize_username($list_user, 1); my $list_ac = ($list_account eq "$user\@$defservice" ? '' : "$list_account/"); if (defined $list_name) { ¬ice("Getting list: '$list_ac$list_name'"); } else { ¬ice("Getting all lists for '$list_account'"); } &get_updates([ 0, [ [ "$user\@$defservice", { up_lists => [ $list_user, $list_name ] } ], ], ]); } else { &error( 'Usage: /twitter_listinfo [ [] ]' ); } } sub cmd_search { my ( $data, $server, $win ) = @_; $data =~ s/^\s+|\s+$//g; if ( length $data > 0 ) { my $username = &normalize_username($user); if ( exists $search_once{$username}->{$data} ) { ¬ice( [ "search", $data ], "Search is already queued" ); return; } $search_once{$username}->{$data} = $settings{search_results}; ¬ice( [ "search", $data ], "Searching for '$data'" ); &get_updates([ 0, [ [ $username, { up_searches => [ $data ] } ], ], ]); } else { ¬ice( ["search"], "Usage: /twitter_search " ); } } sub cmd_dms_as { my ( $data, $server, $win ) = @_; $data =~ s/^\s+|\s+$//g; ( my $username, $data ) = split ' ', $data, 2; unless ( $username ) { ¬ice( ['dm'], 'Usage: /twitter_dms_as ' ); return; } return unless $username = &valid_username($username); return unless &logged_in($twits{$username}); if ( length $data > 0 ) { &error( 'Usage: /' . ($username eq "$user\@$defservice" ? 'twitter_dms' : 'twitter_dms_as ') ); return; } ¬ice( [ 'dm' ], 'Fetching direct messages' ); &get_updates([ 0, [ [ $username, { up_dms => 1 } ], ], ]); } sub cmd_dms { my ( $data, $server, $win ) = @_; &cmd_dms_as("$user $data", $server, $win); } sub cmd_switch { my ( $data, $server, $win ) = @_; $data =~ s/^\s+|\s+$//g; $data = &normalize_username($data); if ( exists $twits{$data} ) { ¬ice( [ "tweet", $data ], "Switching to $data" ); $twit = $twits{$data}; if ( $data =~ /(.*)\@(.*)/ ) { $user = $1; $defservice = $2; } else { ¬ice( [ "tweet", $data ], "Couldn't figure out what service '$data' is on" ); } } else { ¬ice( ["tweet"], "Unknown user $data" ); } } sub cmd_logout { my ( $data, $server, $win ) = @_; $data =~ s/^\s+|\s+$//g; $data = $user unless $data; return unless $data = &valid_username($data); ¬ice( [ "tweet", $data ], "Logging out $data..." ); eval { $twits{$data}->end_session(); }; delete $twits{$data}; delete $last_poll{$data}; undef $twit; if ( keys %twits ) { &cmd_switch( ( keys %twits )[0], $server, $win ); } else { Irssi::timeout_remove($poll_event) if $poll_event; undef $poll_event; } } sub cmd_login { my ( $data, $server, $win ) = @_; my $username; my $pass; &debug("logging in: $data"); if ($data) { ( $username, $pass ) = split ' ', $data, 2; unless ( $settings{use_oauth} or $pass ) { ¬ice( ["tweet"], "usage: /twitter_login [\@] [*]", " *required if not using OAUTH" ); return; } &debug("%G$username%n manual data login"); } elsif ( $settings{use_oauth} and @{ $settings{usernames} } ) { &debug("oauth autouser login @{ $settings{usernames} }" ); %nicks = (); my $some_success = 0; foreach my $user ( @{ $settings{usernames} } ) { $some_success = &cmd_login($user); } return $some_success; } elsif ( @{ $settings{usernames} } and @{ $settings{passwords} } ) { &debug("autouser login"); if ( @{ $settings{usernames} } != @{ $settings{passwords} } ) { &error( "Number of usernames doesn't match " . "the number of passwords - auto-login failed" ); return; } else { %nicks = (); my $some_success = 0; for (my $i = 0; $i < @{ $settings{usernames} }; $i++) { $some_success ||= &cmd_login("$settings{usernames}->[$i] $settings{passwords}->[$i]"); } return $some_success; } } else { &error( "/twitter_login requires either a username/password " . "or twitter_usernames and twitter_passwords to be set. " . "Note that if twirssi_use_oauth is true, passwords are " . "not required" ); return; } $username = &normalize_username($username, 1); ( $user, $defservice ) = split('@', $username, 2); $state{__lists}{$username} = {}; $blocks{$username} = {}; $friends{$username} = {}; if ( $settings{use_oauth} ) { &debug("%G$username%n Attempting OAuth to $defservice"); eval { if ( $defservice eq 'Identica' ) { $twit = Net::Twitter->new( ($defservice eq 'Identica' ? ( identica => 1 ) : ()), traits => [ 'API::REST', 'API::Search' ], source => "twirssi", # XXX ssl => !$settings{avoid_ssl}, ); } else { $twit = Twitter::API->new_with_traits( traits => [ qw/ Migration ApiMethods RetryOnError / ], ( grep tr/a-zA-Z/n-za-mN-ZA-M/, map $_, pbafhzre_xrl => 'OMINiOzn4TkqvEjKVioaj', pbafhzre_frperg => '0G5xnujYlo34ipvTMftxN9yfwgTPD05ikIR2NCKZ', ), source => "twirssi", # XXX ssl => !$settings{avoid_ssl}, ); } }; if ($@) { &error( "Error when creating object: $@" ); } if ($twit) { if ( open( my $oa_fh, '<', $settings{oauth_store} ) ) { while (<$oa_fh>) { chomp; next unless /^$username (\S+) (\S+)/i; &debug("%G$username%n Trying cached oauth creds"); $twit->access_token($1); $twit->access_token_secret($2); last; } close $oa_fh; } # leave undefined if authorized my $authorize_url; my %req_tokes = (); if ( ref($twit) =~ /Twitter::API/ and not ($twit->has_access_token and $twit->has_access_token_secret ) ) { my $oauth_ref; eval { $oauth_ref = $twit->oauth_request_token(); }; if ($@) { &error( "Failed to get oauth_request_token: $@" ); return; } if (not $oauth_ref->{oauth_token} or not $oauth_ref->{oauth_token_secret}) { &error( "Failed to return oauth_token*" ); return; } $req_tokes{token} = $oauth_ref->{oauth_token}; $req_tokes{token_secret} = $oauth_ref->{oauth_token_secret}; eval { $authorize_url = $twit->oauth_authorization_url({ oauth_token => $oauth_ref->{oauth_token}, screen_name => $user, }); }; if ($@) { &error( "Failed to get oauth_authorization_url: $@" ); return; } } elsif ( $twit->can('authorized') and not $twit->authorized ) { eval { $authorize_url = $twit->get_authorization_url; }; if ($@) { &error( "Failed to get OAuth authorization_url: $@" ); return; } } if ( $authorize_url ) { &error( "$user: $IRSSI{name} not authorized to access $defservice.", "Please authorize at the following url:", " " . $authorize_url, "then enter the PIN supplied with:", " /twirssi_oauth $username ", ); $oauth{pending}{$username} = { twit => $twit, %req_tokes, }; return; } } } else { $twit = Net::Twitter->new( $defservice eq 'Identica' ? ( identica => 1 ) : (), username => $user, password => $pass, source => "twirssi", # XXX ssl => !$settings{avoid_ssl}, ); } unless ($twit) { &error( "Failed to create object! Aborting." ); return; } return &verify_twitter_object( $server, $win, $user, $defservice, $twit ); } sub cmd_oauth { my ( $data, $server, $win ) = @_; my ( $key, $pin ) = split ' ', $data; my ( $user, $service ); $key = &normalize_username($key); if ( $key =~ /^(.*)@(Twitter|Identica)$/ ) { ( $user, $service ) = ( $1, $2 ); } $pin =~ s/\D//g; &debug("Applying pin to $key"); unless ( exists $oauth{pending}{$key} ) { &error( "There isn't a pending oauth request for $key. " . "Try /twitter_login first" ); return; } my $twit = $oauth{pending}{$key}->{twit}; my ( $access_token, $access_token_secret ); eval { my $hash_ref = $twit->oauth_access_token({ token => $oauth{pending}{$key}->{token}, token_secret => $oauth{pending}{$key}->{token_secret}, verifier => $pin, }); $access_token = $hash_ref->{oauth_token}; $access_token_secret = $hash_ref->{oauth_token_secret}; }; if ($@) { &error( "Invalid pin, try again: $@" ); return; } if (not $access_token or not $access_token_secret) { &error( "Invalid tokens returned, try again" ); return; } $twit->access_token($access_token); $twit->access_token_secret($access_token_secret); delete $oauth{pending}{$key}; my $store_file = $settings{oauth_store}; if ($store_file) { my @store; if ( open( my $oa_fh, '<', $store_file ) ) { while (<$oa_fh>) { chomp; next if /$key/i; push @store, $_; } close $oa_fh; } push @store, "$key $access_token $access_token_secret"; if ( open( my $oa_fh, '>', "$store_file.new" ) ) { print $oa_fh "$_\n" foreach @store; close $oa_fh; rename "$store_file.new", $store_file or &error( "Failed to rename $store_file.new: $!" ); } else { &error( "Failed to write $store_file.new: $!" ); } } else { &error( "No persistant storage set for OAuth. " . "Please /set twirssi_oauth_store to a writable filename." ); } return &verify_twitter_object( $server, $win, $user, $service, $twit ); } sub rate_limited { my $obj = shift; my $username = shift; my $fh = shift; my $rate_limit; eval { $rate_limit = $obj->rate_limit_status(); }; my $res = 0; if ( $rate_limit and $rate_limit->{resources} ) { for my $resource (keys %{ $rate_limit->{resources} }) { for my $uri (keys %{ $rate_limit->{resources}->{$resource} }) { if ( $rate_limit->{resources}->{$resource}->{$uri}->{remaining} < 1 ) { &error([$username, $fh], "Rate limit exceeded for $resource ($uri), try again after " . localtime $rate_limit->{resources}->{$resource}->{$uri}->{reset} ); $res = 1; } } } } return $res; } sub verify_twitter_object { my ( $server, $win, $user, $service, $twit ) = @_; if ( my $timeout = $settings{timeout} ) { if ( $twit->can('user_agent') ) { $twit->user_agent->timeout($timeout); } elsif ( $twit->can('ua') ) { $twit->ua->timeout($timeout); } else { $timeout = undef; } ¬ice( ["tweet", "$user\@$service"], "Twitter timeout for $user\@$service set to $timeout" ) if defined $timeout; } my $verified = 0; eval { $verified = $twit->verify_credentials(); }; if ( $@ or not $verified ) { my $msg = $@ // 'Not verified'; ¬ice( [ "tweet", "$user\@$service" ], "Login as $user\@$service failed: $msg" ); if ( not $settings{avoid_ssl} ) { ¬ice( [ "tweet", "$user\@$service" ], "It's possible you're missing one of the modules required for " . "SSL logins. Try setting twirssi_avoid_ssl to on. See " . "http://cpansearch.perl.org/src/GAAS/libwww-perl-5.831/README.SSL " . "for the detailed requirements." ); } $twit = undef; if ( keys %twits ) { &cmd_switch( ( keys %twits )[0], $server, $win ); } return; } if (&rate_limited($twit, "$user\@$service")) { $twit = undef; return; } &debug("%G$user\@$service%n saving object"); $twits{"$user\@$service"} = $twit; # &get_updates([ 1, [ "$user\@$service", {} ], ]); &ensure_updates(); foreach my $scr_name (keys %{ $friends{"$user\@$service"} }) { $nicks{$scr_name} = $friends{"$user\@$service"}{$scr_name}; } $nicks{$user} = 0; return 1; } sub cmd_add_follow { my ( $data, $server, $win ) = @_; unless ($data) { &error( "Usage: /twitter_add_follow_extra " ); return; } $data =~ s/^\s+|\s+$//g; $data =~ s/^\@//; $data = lc $data; if ( exists $state{__last_id}{"$user\@$defservice"}{__extras}{$data} ) { ¬ice( ["tweet"], "Already following all replies by \@$data" ); return; } $state{__last_id}{"$user\@$defservice"}{__extras}{$data} = 1; ¬ice( ["tweet"], "Will now follow all replies by \@$data" ); } sub cmd_del_follow { my ( $data, $server, $win ) = @_; unless ($data) { &error( "Usage: /twitter_del_follow_extra " ); return; } $data =~ s/^\s+|\s+$//g; $data =~ s/^\@//; $data = lc $data; unless ( exists $state{__last_id}{"$user\@$defservice"}{__extras}{$data} ) { &error( "Wasn't following all replies by \@$data" ); return; } delete $state{__last_id}{"$user\@$defservice"}{__extras}{$data}; ¬ice( ["tweet"], "Will no longer follow all replies by \@$data" ); } sub cmd_list_follow { my ( $data, $server, $win ) = @_; my $found = 0; foreach my $suser ( sort keys %{ $state{__last_id} } ) { next unless exists $state{__last_id}{$suser}{__extras}; my $frusers = join ', ', sort keys %{ $state{__last_id}{$suser}{__extras} }; if ($frusers) { $found = 1; ¬ice( ["tweet"], "Following all replies as $suser: $frusers" ); } } unless ($found) { ¬ice( ["tweet"], "Not following all replies by anyone" ); } } sub cmd_add_search { my ( $data, $server, $win ) = @_; unless ( $twit and $twit->can('search') ) { my $ref_type = ref($twit); ¬ice( ["search"], "ERROR: Your version of $ref_type (" . $ref_type->VERSION . ") " . "doesn't support searches." ); return; } my $want_win = 1 if $data =~ s/^\s*-w\s+//; $data =~ s/^\s+|\s+$//g; $data = lc $data; unless ($data) { ¬ice( ["search"], "Usage: /twitter_subscribe [-w] " ); return; } if ( exists $state{__last_id}{"$user\@$defservice"}{__search}{$data} ) { ¬ice( [ "search", $data ], "Already had a subscription for '$data'" ); return; } $state{__last_id}{"$user\@$defservice"}{__search}{$data} = 1; ¬ice( [ "search", $data ], "Added subscription for '$data'" ); if ($want_win) { my $win_name = $data; $win_name =~ tr/ /+/; &cmd_set_window("search $data $win_name", $server, $win); } } sub cmd_del_search { my ( $data, $server, $win ) = @_; unless ( $twit and $twit->can('search') ) { my $ref_type = ref($twit); ¬ice( ["search"], "ERROR: Your version of $ref_type (" . $ref_type->VERSION . ") " . "doesn't support searches." ); return; } $data =~ s/^\s+|\s+$//g; $data = lc $data; unless ($data) { ¬ice( ["search"], "Usage: /twitter_unsubscribe " ); return; } unless ( exists $state{__last_id}{"$user\@$defservice"}{__search}{$data} ) { ¬ice( [ "search", $data ], "No subscription found for '$data'" ); return; } delete $state{__last_id}{"$user\@$defservice"}{__search}{$data}; ¬ice( [ "search", $data ], "Removed subscription for '$data'" ); } sub cmd_list_search { my ( $data, $server, $win ) = @_; my $found = 0; foreach my $suser ( sort keys %{ $state{__last_id} } ) { my $topics = ''; foreach my $topic ( sort keys %{ $state{__last_id}{$suser}{__search} } ) { $topics .= ($topics ne '' ? ', ' : '') . "'$topic'"; } if ($topics ne '') { $found = 1; ¬ice( ["search"], "Search subscriptions for $suser: $topics" ); } } unless ($found) { ¬ice( ["search"], "No search subscriptions set up" ); } } sub cmd_upgrade { my ( $data, $server, $win ) = @_; my $loc = $settings{location}; unless ( -w $loc ) { &error( "$loc isn't writable, can't upgrade." . " Perhaps you need to /set twirssi_location?" ); return; } my $URL = "https://raw.githubusercontent.com/" . ( $settings{upgrade_beta} ? "$settings{upgrade_dev}/twirssi/$settings{upgrade_branch}" : "$settings{upgrade_dev}/twirssi/master" ) . "/twirssi.pl"; ¬ice( ["notice"], "Downloading twirssi from $URL" ); my $new_twirssi = get( $URL ); my $new_md5; unless ( $data or $settings{upgrade_beta} ) { eval " use Digest::MD5; "; if ($@) { &error( "Failed to load Digest::MD5." . " Try '/twirssi_upgrade nomd5' to skip MD5 verification" ); return; } $new_md5 = Digest::MD5::md5_hex($new_twirssi); my $fh; unless ( open( $fh, '<', $loc ) ) { &error( "Failed to read $loc." . " Check that /set twirssi_location is set to the correct location." ); return; } my $cur_md5 = Digest::MD5::md5_hex(<$fh>); close $fh; if ( $cur_md5 eq $new_md5 ) { &error( "Current twirssi seems to be up to date." ); return; } } open my $fh, '>', "$loc.upgrade" or return &error("Failed to write upgrade to $loc.upgrade $!"); print $fh $new_twirssi; close $fh; unless ( -s "$loc.upgrade" ) { &error( "Failed to save $loc.upgrade." . " Check that /set twirssi_location is set to the correct location." ); return; } rename $loc, "$loc.backup" or &error( "Failed to back up $loc: $!. Aborting" ) and return; rename "$loc.upgrade", $loc or &error( "Failed to rename $loc.upgrade: $!. Aborting" ) and return; my ( $dir, $file ) = ( $loc =~ m{(.*)/([^/]+)$} ); if ( -e "$dir/autorun/$file" ) { ¬ice( ["notice"], "Updating $dir/autorun/$file" ); unlink "$dir/autorun/$file" or &error( "Failed to remove old $file from autorun: $!" ); symlink "../$file", "$dir/autorun/$file" or &error( "Failed to create symlink in autorun directory: $!" ); } ¬ice( ["notice"], "Download complete. Reload twirssi with /twirssi_reload" ); } sub cmd_list_channels { my ( $data, $server, $win ) = @_; ¬ice("Current output channels:"); foreach my $type ( sort keys %{ $state{__channels} } ) { ¬ice("$type:"); foreach my $tag ( sort keys %{ $state{__channels}{$type} } ) { ¬ice(" $tag:"); foreach my $net_tag ( sort keys %{ $state{__channels}{$type}{$tag} } ) { ¬ice(" $net_tag: " . join ', ', @{ $state{__channels}{$type}{$tag}{$net_tag} }); } } } ¬ice("Add new entries using /twirssi_set_channel " . "[[-]type|*] [account|search_term|*] [net_tag] [channel]" ); ¬ice("Type can be one of: tweet, reply, dm, search, sender, error.", "A '*' for type/tag indicates wild" . " (if type is wild, ensure account qualified: [user]\@[service]).", "Remove settings by negating type, e.g. '-tweet'."); } sub cmd_set_channel { my ( $data, $server, $win ) = @_; my @words = split ' ', lc $data; unless (@words == 4) { return &cmd_list_channels(@_); } my ($type, $tag, $net_tag, $channame) = @words; my $delete = 1 if $type =~ s/^-//; unless ( grep { $type eq $_ } @{ $valid_types{'channel'} } ) { &error( "Invalid message type '$type'.", 'Valid types: ' . join(', ', @{ $valid_types{'channel'} })); return; } $tag = &normalize_username($tag) unless grep { $type eq $_ } qw/ search sender * / or $tag eq '*'; if ($delete) { if (not defined $state{__channels}{$type} or not defined $state{__channels}{$type}{$tag} or not defined $state{__channels}{$type}{$tag}{$net_tag} or not grep { $_ eq $channame } @{ $state{__channels}{$type}{$tag}{$net_tag} }) { ¬ice("No such channel setting for $type/$tag on $net_tag."); return; } ¬ice("$type/$tag messages will no longer be sent" . " to the '$channame' channel on $net_tag" ); @{ $state{__channels}{$type}{$tag}{$net_tag} } = grep { $_ ne $channame } @{ $state{__channels}{$type}{$tag}{$net_tag} }; delete $state{__channels}{$type}{$tag}{$net_tag} unless @{ $state{__channels}{$type}{$tag}{$net_tag} }; delete $state{__channels}{$type}{$tag} unless keys %{ $state{__channels}{$type}{$tag} }; delete $state{__channels}{$type} unless keys %{ $state{__channels}{$type} }; } elsif (defined $state{__channels}{$type}{$tag}{$net_tag} and grep { $_ eq $channame } @{ $state{__channels}{$type}{$tag}{$net_tag} }) { ¬ice("There is already such a channel setting."); return; } else { ¬ice("$type/$tag messages will now be sent" . " to the '$channame' channel on $net_tag" ); push @{ $state{__channels}{$type}{$tag}{$net_tag} }, $channame; } &save_state(); return; } sub cmd_list_windows { my ( $data, $server, $win ) = @_; ¬ice("Current output windows:"); foreach my $type ( sort keys %{ $state{__windows} } ) { ¬ice("$type:"); foreach my $tag ( sort keys %{ $state{__windows}{$type} } ) { ¬ice(" $tag: $state{__windows}{$type}{$tag}"); } } ¬ice( "Default window for all other messages: " . $settings{window} ); ¬ice("Add new entries with the /twirssi_set_window " . "[type] [tag] [window] command." ); ¬ice("Remove a setting by setting window name to '-'."); } sub cmd_set_window { my ( $data, $server, $win ) = @_; my @words = split ' ', $data; unless (@words) { &cmd_list_windows(@_); return; } my $winname = pop @words; # the last argument is the window name my $delete = $winname eq '-'; if ( @words == 0 ) { # just a window name $winname = 'twitter' if $delete; ¬ice("Changing the default twirssi window to $winname"); Irssi::settings_set_str( "twitter_window", $winname ); &ensure_logfile($settings{window} = $winname); } elsif ( @words > 2 and $words[0] ne 'search' ) { ¬ice( "Too many arguments to /twirssi_set_window. '@words'", "Usage: /twirssi_set_window [type] [account|search_term] [window].", 'Valid types: ' . join(', ', @{ $valid_types{'window'} }) ); return; } elsif ( @words >= 1 ) { my $type = lc $words[0]; unless ( grep { $_ eq $type } @{ $valid_types{'window'} } ) { &error("Invalid message type '$type'.", 'Valid types: ' . join(', ', @{ $valid_types{'window'} })); return; } my $tag = "default"; if ( @words >= 2 ) { $tag = lc $words[1]; if ($type eq 'sender') { $tag =~ s/^\@//; $tag =~ s/\@.+//; } elsif ($type ne 'search' and ($type ne 'default' or index($tag, '@') >= 0) and $tag ne 'default') { $tag = &normalize_username($tag); } elsif ($type eq 'search' and @words > 2) { $tag = lc join(' ', @words[1..$#words]); } if (substr($tag, -1, 1) eq '@') { &error("Invalid tag '$tag'."); return; } } if ($delete) { if (not defined $state{__windows}{$type} or not defined $state{__windows}{$type}{$tag}) { ¬ice("No such window setting for $type/$tag."); return; } ¬ice("$type/$tag messages will no longer be sent to the '" . $state{__windows}{$type}{$tag} . "' window" ); delete $state{__windows}{$type}{$tag}; delete $state{__windows}{$type} unless keys %{ $state{__windows}{$type} }; } else { ¬ice("$type/$tag messages will now" . " be sent to the '$winname' window" ); $state{__windows}{$type}{$tag} = $winname; } &save_state(); } &ensure_window($winname) if $winname ne '-'; return; } sub get_friends { my $u_twit = shift; my $username = shift; my $fh = shift; my $is_update = shift; my $new_friends = &scan_cursor('friends', $u_twit, $username, $fh, { fn=>'friends', cp=>(index($username, '@Twitter') != -1 ? 'c' : 'p'), set_key=>'users', item_key=>'screen_name', }); return if not defined $new_friends; return $new_friends if not $is_update; my ( $added, $removed ) = ( 0, 0 ); # &debug($fh, "%G$username%n Scanning for new friends..."); foreach ( keys %$new_friends ) { next if exists $friends{$username}{$_}; $friends{$username}{$_} = $new_friends->{$_}; $added++; } # &debug($fh, "%G$username%n Scanning for removed friends..."); foreach ( keys %{ $friends{$username} } ) { next if exists $new_friends->{$_}; delete $friends{$username}{$_}; &debug($fh, "%G$username%n removing friend: $_"); $removed++; } return ( $added, $removed ); } sub scan_cursor { my $type_str = shift; my $u_twit = shift; my $username = shift; my $fh = shift; my $fn_info = shift; my $whole_set = ($fn_info->{want_array} ? [] : {}); my $fn_args = { (defined $fn_info->{args} ? %{ $fn_info->{args} } : ()) }; my $fn_name = $fn_info->{fn}; my $pg_type = index($fn_info->{cp}, 'c') >= 0 ? 'cursor' : ($fn_info->{cp} =~ /p(\d*)/ ? 'page' : ''); my $max_page = 10; $max_page = $1 if $pg_type eq 'page' and length($1) > 0; eval { for (my($cursor, $page) = ("_TBC", 1); $cursor and $page <= $max_page; $page++) { if ($pg_type eq 'cursor') { $fn_args->{cursor} = $cursor if $cursor ne "_TBC"; } elsif ($pg_type eq 'page') { $fn_args->{page} = $page; } &debug($fh, "%G$username%n Loading $type_str $pg_type " . ($pg_type eq 'cursor' ? $cursor : $page)); my $collection; if ($fn_name =~ /^(get|post|put|delete)$/ and defined $fn_info->{endpoint}) { $collection = $u_twit->$fn_name($fn_info->{endpoint}, $fn_args); } else { $collection = $u_twit->$fn_name($fn_args); } last if not $collection; if ($pg_type eq 'cursor') { $cursor = $collection->{next_cursor}; $collection = $collection->{$fn_info->{set_key}} if defined $fn_info->{set_key}; } last if 0 == @$collection; if ($fn_info->{want_array}) { push @$whole_set, @$collection; next; } foreach my $coll_item (@$collection) { if ($pg_type eq 'page' and defined $whole_set->{$coll_item->{$fn_info->{item_key}}}) { &debug($fh, "%G$username%n repeated page $page key " . $fn_info->{item_key} . ' val ' . $coll_item->{$fn_info->{item_key}} . ''); #' pre ' . Dumper($whole_set->{$coll_item->{$fn_info->{item_key}}})); next; } $whole_set->{$coll_item->{$fn_info->{item_key}}} = ( defined $fn_info->{item_val} ? $coll_item->{$fn_info->{item_val}} : (defined $fn_info->{item_keys} ? (ref($fn_info->{item_keys}) eq 'ARRAY' ? { map { $_ => $coll_item->{$_} } @{ $fn_info->{item_keys} } } : { %$coll_item }) : time) ); $fn_args->{max_id} = $coll_item->{id_str} if defined $fn_args->{since_id}; } } if ($settings{debug}) { foreach my $item (split "\n", Dumper($whole_set)) { &debug($fh, "$pg_type: $item"); } # TODO remove } }; if ($@) { &error([$username, $fh], "Error updating $type_str. Aborted."); &debug($fh, "%G$username%n Error updating $type_str: $@"); return; } return $whole_set; } sub get_lists { my $u_twit = shift; my $username = shift; my $fh = shift; my $is_update = shift; my $userid = shift; my $list_name = shift; my $list_account = $username; if ($is_update and not defined $userid and $username =~ /(.+)\@/) { $userid = $1; } else { $list_account = &normalize_username($userid, 1); } my %stats = (added => 0, deleted => 0); # ensure $new_lists->{$list_name} = $id my %more_args = (); my $new_lists = &scan_cursor('lists', $u_twit, $username, $fh, { fn=>'list_ownerships', cp=>'c', set_key=>'lists', args=>{ user=>$userid, %more_args }, item_key=>'name', item_val=>'id', }); return if not defined $new_lists; # reduce $new_lists if $list_name specified (not $is_update) if (defined $list_name) { if (not defined $new_lists->{$list_name}) { return {}; # not is_update, so return empty } $new_lists = { $list_name => $new_lists->{$list_name} }; } foreach my $list (keys %$new_lists) { $stats{added}++ if not exists $state{__lists}{$list_account}{$list}; $state{__lists}{$list_account}{$list} = { id=>$new_lists->{$list}, members=>[], }; } if ($is_update) { # remove any newly-missing lists foreach my $old_list (keys %{ $state{__lists}{$list_account} }) { if (not defined $new_lists->{$old_list}) { delete $state{__lists}{$list_account}{$old_list}; &debug($fh, "%G$username%n removing list: $list_account / $old_list"); $stats{deleted}++; } } } foreach my $reget_list (keys %$new_lists) { &debug($fh, "%G$username%n updating list: $list_account / $reget_list id=" . $state{__lists}{$list_account}{$reget_list}{id}); my $members = &scan_cursor('list member', $u_twit, $username, $fh, { fn=>'list_members', cp=>'c', set_key=>'users', item_key=>'screen_name', item_val=>'id', args=>{ user=>$userid, list_id=>$state{__lists}{$list_account}{$reget_list}{id} }, }); return if not defined $members; $state{__lists}{$list_account}{$reget_list}{members} = [ keys %$members ]; } return ($stats{added}, $stats{deleted}); } sub get_blocks { my $u_twit = shift; my $username = shift; my $fh = shift; my $is_update = shift; my $new_blocks = &scan_cursor('blocks', $u_twit, $username, $fh, { fn=>'blocking', cp=>'c', set_key=>'users', item_key=>'screen_name', }); return if not defined $new_blocks; return $new_blocks if not $is_update; my ( $added, $removed ) = ( 0, 0 ); # &debug($fh, "%G$username%n Scanning for new blocks..."); foreach ( keys %$new_blocks ) { next if exists $blocks{$username}{$_}; $blocks{$username}{$_} = time; $added++; } # &debug($fh, "%G$username%n Scanning for removed blocks..."); foreach ( keys %{ $blocks{$username} } ) { next if exists $new_blocks->{$_}; delete $blocks{$username}{$_}; &debug($fh, "%G$username%n removing block: $_"); $removed++; } return ( $added, $removed ); } sub get_nl { my $nl = shift; return '' if not defined $nl; return 'nl:"' . $nl . '" '; } sub get_reply_to { # extract reply-to-information from tweets my $t = shift; if ($t->{in_reply_to_screen_name} and $t->{in_reply_to_status_id}) { return sprintf 'reply_to_user:%s reply_to_id:%s ', $t->{in_reply_to_screen_name}, $t->{in_reply_to_status_id}; } else { return ''; } } sub cmd_wipe { my ( $data, $server, $win ) = @_; my @cache_keys = qw/ __tweets __indexes __ids __usernames __reply_to_ids __reply_to_users __created_ats /; my @surplus_nicks = (); if ($data eq '') { for my $nick (keys %{ $state{__tweets} }) { my $followed = 0; for my $acct (keys %twits) { if (grep { lc($_) eq $nick } keys %{ $friends{$acct} }) { $followed = 1; last; } } push @surplus_nicks, $nick if not $followed; } } else { for my $to_wipe (split(/\s+/, $data)) { if (exists $state{$to_wipe}) { ¬ice("Wiping '$to_wipe' state."); $state{$to_wipe} = {}; } elsif ($to_wipe eq '-f') { push @surplus_nicks, keys %{ $state{__tweets} }; } elsif ($to_wipe eq '-A') { ¬ice('Wiping all info/settings.'); %state = (); } else { &error("No such twirssi_wipe argument '$to_wipe'."); } } } if (@surplus_nicks) { for my $surplus_nick (@surplus_nicks) { for my $cache_key (@cache_keys) { delete $state{$cache_key}{$surplus_nick}; } } &debug('Wiped data for ' . join(',', @surplus_nicks)); ¬ice('Wiped data for ' . (0+@surplus_nicks) . ' nicks.'); } } sub cmd_user { my $target = shift; my $server = shift; my $win = shift; $target =~ s/(?::\d+)?\s*$//; &cmd_set_window("sender $target $target", $server, $win) if $target =~ s/^\s*-w\s+// and $target ne ''; &get_updates([ 0, [ [ "$user\@$defservice", { up_user => $target } ], ], ]); } sub tweet_to_meta { my $obj = shift; my $t = shift; my $username = shift; my $type = shift; my $topic = shift; my %meta = ( username => $username, type => $type, nick => ($type eq 'dm' ? $t->{sender_screen_name} : $t->{user}{screen_name}), ); ($meta{account}, $meta{service}) = split('@', $username, 2); foreach my $meta_key (keys %meta_to_twit) { $meta{$meta_key} = $t->{$meta_to_twit{$meta_key}} if defined $t->{$meta_to_twit{$meta_key}}; } $meta{created_at} = $meta{ts} // &date_to_epoch($meta{created_at}); $meta{topic} = $topic if defined $topic; ($meta{text}, $meta{nl}) = &get_text($t, $obj); return \%meta; } sub tweet_or_reply { my $obj = shift; my $t = shift; my $username = shift; my $cache = shift; my $fh = shift; my $type = 'tweet'; if ( $t->{in_reply_to_screen_name} and $username !~ /^\Q$t->{in_reply_to_screen_name}\E\@/i and not exists $friends{$username}{ $t->{in_reply_to_screen_name} } ) { $nicks{ $t->{in_reply_to_screen_name} } = time; unless ( $cache->{ $t->{in_reply_to_status_id} } ) { eval { $cache->{ $t->{in_reply_to_status_id} } = $obj->show_status( $t->{in_reply_to_status_id} ); }; } &debug($fh, "REPLY $username rep2 $@ " . Dumper($cache->{ $t->{in_reply_to_status_id} })); if (my $t_reply = $cache->{ $t->{in_reply_to_status_id} }) { if (defined $fh) { my ($ctext, $nl) = &get_text( $t_reply, $obj ); printf $fh "t:tweet id:%s ac:%s %s%snick:%s ts:%s %s\n", $t_reply->{id}, $username, &get_reply_to($t_reply), &get_nl($nl), $t_reply->{user}{screen_name}, &get_ts($t_reply), $ctext; &get_unshorten_urls($ctext, $fh); } $type = 'reply'; } } return $type; } sub background_setup { my $pause_monitor = shift || 5000; my $max_pauses = shift || 24; my $is_update = shift; my $fn_to_call = shift; my $fn_args_ref = shift; &debug("bg_setup starting upd=$is_update"); return unless &logged_in($twit); my ( $fh, $filename ) = File::Temp::tempfile('tw_'.$$.'_XXXX', TMPDIR => 1); my $done_filename = "$filename.done"; unlink($done_filename) if -f $done_filename; binmode( $fh, ":" . &get_charset() ); $child_pid = fork(); if ($child_pid) { # parent Irssi::timeout_add_once( $pause_monitor, 'monitor_child', [ $done_filename, $max_pauses, $pause_monitor, $is_update, $filename . '.' . $child_pid, 0 ] ); Irssi::pidwait_add($child_pid); } elsif ( defined $child_pid ) { # child my $pid_filename = $filename . '.' . $$; rename $filename, $pid_filename; close STDIN; close STDOUT; close STDERR; { no strict 'refs'; &$fn_to_call($fh, @$fn_args_ref); } close $fh; rename $pid_filename, $done_filename; exit; } else { &error("Failed to fork for background call: $!"); } } sub ensure_updates { my $adhoc_interval = shift; my $poll_interval = (defined $adhoc_interval ? $adhoc_interval : &get_poll_time) * 1000; if ($poll_interval != $last_poll{__interval} or not $poll_event) { &debug("get_updates every " . int($poll_interval/1000)); Irssi::timeout_remove($poll_event) if $poll_event; $poll_event = Irssi::timeout_add( $poll_interval, \&get_updates, [ 1 ] ); $last_poll{__interval} = $poll_interval; } } sub get_updates { my $args = shift; my $is_regular = 0; my $to_be_updated; if (not ref $args) { # command-line request, so do regular $is_regular = 1; } else { $is_regular = $args->[0]; $to_be_updated = $args->[1]; } &debug("get_updates starting upd=$is_regular"); return unless &logged_in($twit); if ($is_regular) { if ($update_is_running) { &debug("get_updates aborted: already running"); return; } $update_is_running = 1; } if (not defined $to_be_updated) { $to_be_updated = []; foreach my $pref_user (@{ $settings{update_usernames} }) { next unless $pref_user = &valid_username($pref_user); next if grep { $_ eq $pref_user } @{ $settings{ignored_accounts} }; push @$to_be_updated, [ $pref_user, {} ]; } foreach my $other_user (keys %twits) { next if grep { $_ eq $other_user } @{ $settings{ignored_accounts} }; push @$to_be_updated, [ $other_user, {} ] if not grep { $other_user eq $_->[0] } @$to_be_updated; } } &background_setup(5000, (24*@$to_be_updated), $is_regular, 'get_updates_child', [ $is_regular, $to_be_updated ]); if ($is_regular) { &ensure_updates(); } } sub get_updates_child { my $fh = shift; my $is_regular = shift; my $to_be_updated = shift; my $time_before_update = time; my $error = 0; my @error_types = (); my %context_cache; foreach my $update_tuple ( @$to_be_updated ) { my $username = shift @$update_tuple; my $what_to_update = shift @$update_tuple; my $errors_beforehand = $error; if (0 == keys(%$what_to_update) or defined $what_to_update->{up_tweets}) { unless (&get_tweets( $fh, $username, $twits{$username}, \%context_cache )) { $error++; push @error_types, 'tweets'; } if ( exists $state{__last_id}{$username}{__extras} and keys %{ $state{__last_id}{$username}{__extras} } ) { my @frusers = sort keys %{ $state{__last_id}{$username}{__extras} }; unless (&get_timeline( $fh, $frusers[ $fix_replies_index{$username} ], $username, $twits{$username}, \%context_cache, $is_regular )) { $error++; push @error_types, 'replies'; } $fix_replies_index{$username}++; $fix_replies_index{$username} = 0 if $fix_replies_index{$username} >= @frusers; print $fh "t:fix_replies_index idx:$fix_replies_index{$username} ", "ac:$username\n"; } } next if $error > $errors_beforehand; if (defined $what_to_update->{up_user}) { unless (&get_timeline( $fh, $what_to_update->{up_user}, $username, $twits{$username}, \%context_cache, $is_regular )) { $error++; push @error_types, 'tweets'; } } next if $error > $errors_beforehand; if (0 == keys(%$what_to_update) or defined $what_to_update->{up_dms}) { unless (&do_dms( $fh, $username, $twits{$username}, $is_regular )) { $error++; push @error_types, 'dms'; } } next if $error > $errors_beforehand; if (0 == keys(%$what_to_update) or defined $what_to_update->{up_subs}) { unless (&do_subscriptions( $fh, $username, $twits{$username}, $what_to_update->{up_subs} )) { $error++; push @error_types, 'subs'; } } next if $error > $errors_beforehand; if (0 == keys(%$what_to_update) or defined $what_to_update->{up_searches}) { unless (&do_searches( $fh, $username, $twits{$username}, $what_to_update->{up_searches} )) { $error++; push @error_types, 'searches'; } } next if $error > $errors_beforehand; if ( (0 == keys(%$what_to_update) and time - $last_poll{$username}{friends} > $settings{friends_poll}) or defined $what_to_update->{up_friends} ) { my $show_friends; if ($is_regular) { my $time_before = time; my ( $added, $removed ) = &get_friends($twits{$username}, $username, $fh, 1); print $fh "t:debug %G$username%n Friends list updated: ", "$added added, $removed removed\n" if $added + $removed; print $fh "t:last_poll ac:$username poll_type:friends epoch:$time_before\n"; $show_friends = $friends{$username}; } else { $show_friends = &get_friends($twits{$username}, $username, $fh, 0); } foreach ( sort keys %$show_friends ) { print $fh "t:friend ac:$username nick:$_ epoch:$show_friends->{$_}\n"; } } next if $error > $errors_beforehand; if ( (0 == keys(%$what_to_update) and time - $last_poll{$username}{blocks} > $settings{blocks_poll} ) or defined $what_to_update->{up_blocks}) { my $show_blocks; if ($is_regular) { my $time_before = time; my ( $added, $removed ) = &get_blocks($twits{$username}, $username, $fh, 1); print $fh "t:debug %G$username%n Blocks list updated: ", "$added added, $removed removed\n" if $added + $removed; print $fh "t:last_poll ac:$username poll_type:blocks epoch:$time_before\n"; $show_blocks = $blocks{$username}; } else { $show_blocks = &get_blocks($twits{$username}, $username, $fh, 0); } foreach ( sort keys %$show_blocks ) { print $fh "t:block ac:$username nick:$_ epoch:$show_blocks->{$_}\n"; } } next if $error > $errors_beforehand; if ( (0 == keys(%$what_to_update) and time - $last_poll{$username}{lists} > $settings{lists_poll} ) or defined $what_to_update->{up_lists}) { my $list_account = $username; my $list_name_limit; if ($is_regular) { my $time_before = time; my ( $added, $removed ) = &get_lists($twits{$username}, $username, $fh, 1); print $fh "t:debug %G$username%n Lists list updated: ", "$added added, $removed removed\n" if $added or $removed; print $fh "t:last_poll ac:$username poll_type:lists epoch:$time_before\n"; } else { if (defined $what_to_update->{up_lists} and ref $what_to_update->{up_lists} and defined $what_to_update->{up_lists}->[0]) { $list_account = &normalize_username($what_to_update->{up_lists}->[0], 1); if (defined $what_to_update->{up_lists}->[1]) { $list_name_limit = $what_to_update->{up_lists}->[1]; } } if (not defined &get_lists($twits{$username}, $username, $fh, 0, @{ $what_to_update->{up_lists} })) { &debug($fh, "%G$username%n Polling for lists failed."); $error++; push @error_types, 'lists'; } } if (not defined $state{__lists}{$list_account}) { ¬ice(['info', undef, $fh], "List owner $list_account does not exist or has no lists.") if not $is_regular; } elsif (defined $list_name_limit and not defined $state{__lists}{$list_account}{$list_name_limit}) { ¬ice(['info', undef, $fh], "List $list_account/$list_name_limit does not exist.") if not $is_regular; } else { foreach my $list_name (sort keys %{ $state{__lists}{$list_account} }) { next if defined $list_name_limit and $list_name ne $list_name_limit; my $list_id = $state{__lists}{$list_account}{$list_name}{id}; foreach my $member ( @{ $state{__lists}{$list_account}{$list_name}{members} } ) { print $fh "t:list ac:$username list:$list_account/$list_name id:$list_id nick:$member\n"; } } } } next if $error > $errors_beforehand; } &put_unshorten_urls($fh, $time_before_update); if ($error) { &error([$fh], "Update encountered errors (@error_types). Aborted"); # &error( [$fh], "For recurring DMs errors, please re-auth (delete $settings{oauth_store})") if grep { $_ eq 'dms' } @error_types; } elsif ($is_regular) { print $fh "t:last_poll poll_type:__poll epoch:$time_before_update\n"; } } sub is_ignored { my $text = shift; my $twit = shift; my $text_no_colors = &remove_colors($text); foreach my $tag (@{ $settings{ignored_tags} }) { return $tag if $text_no_colors =~ /(?:^|\b|\s)\Q$tag\E(?:\b|\s|$)/i; } if (defined $twit and grep { $_ eq lc $twit } @{ $settings{ignored_twits} }) { return $twit; } return undef; } sub remove_tags { my $text = shift; foreach my $tag (@{ $settings{stripped_tags} }) { $text =~ s/\cC\d{2}\Q$tag\E\cO//gi; # with then without colors $text =~ s/(^|\b|\s)\Q$tag\E(\b|\s|$)/$1$2/gi; } return $text; } sub get_ts { my $t = shift; return $t->{created_timestamp} / 1000 if defined $t->{created_timestamp}; return &date_to_epoch($t->{created_at}); } sub get_tweets { my ( $fh, $username, $obj, $cache ) = @_; return if &rate_limited($obj, $username, $fh); my %call_attribs = ( tweet_mode => 'extended', count => 200, ); $call_attribs{since_id} = $state{__last_id}{$username}{timeline} if defined $state{__last_id}{$username}{timeline}; my $tweets = &scan_cursor('home_timeline', $obj, $username, $fh, { fn => 'home_timeline', cp => 'p', args => \%call_attribs, item_key => 'id_str', item_keys => 1, }); if (not defined $tweets) { print $fh "t:error $username Error during home_timeline call: Aborted.\n"; return; } $tweets = [ map { $tweets->{$_} } sort { cmp_id($b, $a) } keys %$tweets ]; print $fh "t:debug %G$username%n got ", scalar(@$tweets), ' tweets', (@$tweets ? ', first/last: ' . join('/', (sort {$a->{id} <=> $b->{id}} @$tweets)[0]->{id}, (sort {$a->{id} <=> $b->{id}} @$tweets)[$#{$tweets}]->{id} ) : ''), "\n"; my $new_poll_id = 0; my @own_ids = (); foreach my $t ( reverse @$tweets ) { my ($text, $nl) = &get_text( $t, $obj ); $text = &remove_tags($text); my $ign = &is_ignored($text, $t->{user}{screen_name}); $ign = (defined $ign ? 'ign:' . &encode_for_file($ign) . ' ' : ''); my $reply = &tweet_or_reply($obj, $t, $username, $cache, $fh); if ($t->{user}{screen_name} eq $username and not $settings{own_tweets}) { push @own_ids, $t->{id}; next; } printf $fh "t:%s id:%s ac:%s %s%s%snick:%s ts:%s %s\n", $reply, $t->{id}, $username, $ign, &get_reply_to($t), &get_nl($nl), $t->{user}{screen_name}, &get_ts($t), $text; &get_unshorten_urls($text, $fh); $new_poll_id = $t->{id} if $new_poll_id < $t->{id}; } &debug($fh, "%G$username%n skip own " . join(', ', @own_ids) . "\n") if @own_ids; printf $fh "t:last_id id:%s ac:%s id_type:timeline\n", $new_poll_id, $username if $new_poll_id; &debug($fh, "%G$username%n Polling for replies since " . $state{__last_id}{$username}{reply}); my $arg_ref = { tweet_mode => 'extended' }; if ( $state{__last_id}{$username}{reply} ) { $arg_ref->{since_id} = $state{__last_id}{$username}{reply}; } eval { $tweets = $obj->replies( $arg_ref ) || []; }; if ($@) { print $fh "t:debug %G$username%n Error during replies call. Aborted.\n"; &debug($fh, "%G$username%n Error: " . $@); return; } $new_poll_id = 0; foreach my $t ( reverse @$tweets ) { next if exists $friends{$username}{ $t->{user}{screen_name} }; my ($text, $nl) = &get_text( $t, $obj ); $new_poll_id = $t->{id} if $new_poll_id < $t->{id}; $text = &remove_tags($text); &get_unshorten_urls($text, $fh); my $ign = &is_ignored($text); $ign = (defined $ign ? 'ign:' . &encode_for_file($ign) . ' ' : ''); printf $fh "t:tweet id:%s ac:%s %s%s%snick:%s ts:%s %s\n", $t->{id}, $username, $ign, &get_reply_to($t), &get_nl($nl), $t->{user}{screen_name}, &get_ts($t), $text; } printf $fh "t:last_id id:%s ac:%s id_type:reply\n", $new_poll_id, $username if $new_poll_id; return 1; } sub do_dms { my ( $fh, $username, $obj, $is_regular ) = @_; my $new_poll_id = 0; my $dm_args = { tweet_mode => 'extended' }; if ( $is_regular and $state{__last_id}{$username}{dm} ) { $dm_args->{since_id} = $state{__last_id}{$username}{dm}; &debug($fh, "%G$username%n Polling for DMs since_id " . $state{__last_id}{$username}{dm}); } else { &debug($fh, "%G$username%n Polling for DMs"); } my $dms; eval { $dms = &scan_cursor('DMs', $obj, $username, $fh, { fn=>'get', endpoint=>'direct_messages/events/list', cp=>'c', args=>$dm_args, set_key=>'events', want_array=>1, }); return if not defined $dms; #$dms = $obj->post('direct_messages/events/list', $dm_args) || {}; }; if ($@) { &debug($fh, "%G$username%n Error during direct_messages call. Aborted."); &debug($fh, "%G$username%n Error: " . $@); return; } &debug($fh, "%G$username%n got DMs: " . (0+@$dms)); return 1 unless 0+@$dms; if ($settings{debug}) { foreach my $item (split "\n", Dumper($dms)) { &debug($fh, "dm: $item"); } # TODO remove } foreach my $t ( reverse @$dms ) { # XXX last if $t->{id_str} eq $state{__last_id}{$username}{dm}; next if defined $dm_args->{since_id} and $dm_args->{since_id} eq $t->{id}; my $text = decode_entities( get_full_text($t->{message_create}->{message_data}) ); my $nl; ($text, $nl) = &encode_nl($text); my $sender_id = $t->{message_create}->{sender_id}; my $sender_nick = &id_to_user($obj, $sender_id, "dms", $fh); if (not defined $sender_nick) { &error(['dms', $fh], "update encountered error. Skipping DM for " . $sender_id) if not defined $state{__i_is_bad}{$sender_id}; next; } next if &normalize_username($sender_nick) eq $username; printf $fh "t:dm id:%s ac:%s %s%snick:%s ts:%s %s\n", $t->{id}, $username, &get_reply_to($t), &get_nl($nl), $sender_nick, &get_ts($t), $text; $new_poll_id = $t->{id} if $new_poll_id < $t->{id}; } printf $fh "t:last_id id:%s ac:%s id_type:dm\n", $new_poll_id, $username if $new_poll_id; return 1; } sub do_subscriptions { my ( $fh, $username, $obj, $search_limit ) = @_; &debug($fh, "%G$username%n Polling for subscriptions"); if ( $obj->can('search') and $state{__last_id}{$username}{__search} ) { my $search; foreach my $topic ( sort keys %{ $state{__last_id}{$username}{__search} } ) { next if defined $search_limit and @$search_limit and not grep { $topic eq $_ } @$search_limit; print $fh "t:debug %G$username%n Search '$topic' id was ", "$state{__last_id}{$username}{__search}{$topic}\n"; eval { $search = $obj->search( { tweet_mode => 'extended', q => $topic, since_id => $state{__last_id}{$username}{__search}{$topic} eq '9223372036854775807' ? 0 : $state{__last_id}{$username}{__search}{$topic}, } ); }; if ($@) { print $fh "t:debug %G$username%n Error during search($topic) call. Aborted.\n"; &debug($fh, "%G$username%n Error: " . $@); return; } unless ( $search->{search_metadata}->{max_id} ) { print $fh "t:debug %G$username%n Invalid search results when searching", " for '$topic'. Aborted.\n"; return; } elsif ( $search->{search_metadata}->{max_id} eq '9223372036854775807' ) { &debug($fh, "%G$username%n Error: search max_id = MAX_INT64"); $state{__last_id}{$username}{__search}{$topic} = 0; foreach my $t ( reverse @{ $search->{statuses} } ) { $state{__last_id}{$username}{__search}{$topic} = $t->{id} if cmp_id($t->{id}, $state{__last_id}{$username}{__search}{$topic}) > 0; } } else { $state{__last_id}{$username}{__search}{$topic} = $search->{search_metadata}->{max_id}; } printf $fh "t:searchid id:%s ac:%s topic:%s\n", $state{__last_id}{$username}{__search}{$topic}, $username, &encode_for_file($topic); foreach my $t ( reverse @{ $search->{statuses} } ) { next if exists $blocks{$username}{ $t->{user}->{screen_name} }; my ($text, $nl) = &get_text( $t, $obj ); $text = &remove_tags($text); my $ign = &is_ignored($text, $t->{user}->{screen_name}); &get_unshorten_urls($text, $fh); $ign = (defined $ign ? 'ign:' . &encode_for_file($ign) . ' ' : ''); printf $fh "t:search id:%s ac:%s %s%snick:%s topic:%s ts:%s %s\n", $t->{id}, $username, $ign, &get_nl($nl), $t->{user}->{screen_name}, &encode_for_file($topic), &get_ts($t), $text; } } } return 1; } sub do_searches { my ( $fh, $username, $obj, $search_limit ) = @_; &debug($fh, "%G$username%n Polling for one-time searches"); if ( $obj->can('search') and exists $search_once{$username} ) { my $search; foreach my $topic ( sort keys %{ $search_once{$username} } ) { next if defined $search_limit and @$search_limit and not grep { $topic eq $_ } @$search_limit; my $max_results = $search_once{$username}->{$topic}; $topic = &make_utf8($topic); print $fh "t:debug %G$username%n search $topic once (max $max_results)\n"; eval { $search = $obj->search( { q => $topic, tweet_mode => 'extended', } ); }; if (my $err = $@) { $err = $err->error . ' (' . $err->code . ' ' . $err->message . ')' if ref($err) =~ /(?:Net::Twitter|Twitter::API)::Error/; print $fh "t:debug %G$username%n Error during search_once($topic) call. Aborted.\n"; &debug($fh, "%G$username%n Error: $err"); return; } unless ( $search->{search_metadata}->{max_id} ) { print $fh "t:debug %G$username%n Invalid search results when searching once", " for $topic. Aborted.\n"; return; } # TODO: consider applying ignore-settings to search results my @results = (); foreach my $res (@{ $search->{statuses} }) { if (exists $blocks{$username}{ $res->{user}->{screen_name} }) { print $fh "t:debug %G$username%n blocked $topic: $res->{user}->{screen_name}\n"; next; } push @results, $res; } if ( $max_results > 0 ) { splice @results, $max_results; } foreach my $t ( reverse @results ) { my ($text, $nl) = &get_text( $t, $obj ); $text = &remove_tags($text); &get_unshorten_urls($text, $fh); my $ign = &is_ignored($text, $t->{user}->{screen_name}); $ign = (defined $ign ? 'ign:' . &encode_for_file($ign) . ' ' : ''); printf $fh "t:search_once id:%s ac:%s %s%s%snick:%s topic:%s ts:%s %s\n", $t->{id}, $username, $ign, &get_reply_to($t), &get_nl($nl), $t->{user}->{screen_name}, &encode_for_file($topic), &get_ts($t), $text; } } } return 1; } sub get_timeline { my ( $fh, $target, $username, $obj, $cache, $is_update ) = @_; my $tweets; my $last_id = $state{__last_id}{$username}{__extras}{$target} if $is_update; &debug($fh, "%G$username%n get_timeline $target" . ($is_update ? "($fix_replies_index{$username} > $last_id)" : '')); my $arg_ref = { id => $target, tweet_mode => 'extended', }; if ($is_update) { $arg_ref->{since_id} = $last_id if $last_id; $arg_ref->{include_rts} = 1 if $settings{retweet_show}; } elsif ($settings{limit_user_tweets} and $settings{limit_user_tweets} =~ /\b(\d+)\b/) { $arg_ref->{count} = $1; } eval { $tweets = $obj->user_timeline($arg_ref); }; if ($@) { print $fh "t:error $username user_timeline($target) call: Aborted.\n"; print $fh "t:debug : $_\n" foreach split /\n/, Dumper($@); return; } unless ($tweets) { print $fh "t:error $username user_timeline($target) call returned undef! Aborted\n"; return 1; } my $not_before = time - $1*86400 if not $is_update and $settings{limit_user_tweets} and $settings{limit_user_tweets} =~ /\b(\d+)d\b/; foreach my $t ( reverse @$tweets ) { my $ts = &get_ts($t); next if defined $not_before and $ts < $not_before; my ($text, $nl) = &get_text( $t, $obj ); my $reply = &tweet_or_reply($obj, $t, $username, $cache, $fh); printf $fh "t:%s id:%s ac:%s %s%snick:%s ts:%s %s\n", $reply, $t->{id}, $username, &get_reply_to($t), &get_nl($nl), $t->{user}{screen_name}, $ts, $text; $last_id = $t->{id} if $last_id < $t->{id}; &get_unshorten_urls($text, $fh); } if ($is_update) { printf $fh "t:last_id_fixreplies id:%s ac:%s id_type:%s\n", $last_id, $username, $target; } return 1; } sub encode_for_file { my $datum = shift; $datum =~ s/\t/%09/g; $datum =~ s/ /%20/g; return $datum; } sub decode_from_file { my $datum = shift; $datum =~ s/%20/ /g; $datum =~ s/%09/\t/g; return $datum; } sub date_to_epoch { # parse created_at style date to epoch time my $date = shift; if (not @datetime_parser) { foreach my $date_fmt ( '%a %b %d %T %z %Y', # Fri Nov 05 10:14:05 +0000 2010 '%a, %d %b %Y %T %z', # Fri, 05 Nov 2010 16:59:40 +0000 ) { my $parser = DateTime::Format::Strptime->new(pattern => $date_fmt); if (not defined $parser) { @datetime_parser = (); return; } push @datetime_parser, $parser; } } # my $orig_date = $date; $date = $datetime_parser[index($date, ',') == -1 ? 0 : 1]->parse_datetime($date); # &debug("date '$orig_date': " . ref($date)); return if not defined $date; return $date->epoch(); } sub id_to_marker { # id to index my ($lc_nick, $id) = @_; return unless defined $state{__ids}{ $lc_nick }; for (my $mark_idx = 0; $mark_idx < @{ $state{__ids}{ $lc_nick } }; $mark_idx++) { return $mark_idx if $state{__ids}{ $lc_nick }[$mark_idx] eq $id; } return; } sub meta_to_line { my $meta = shift; my %line_attribs = ( username => $meta->{username}, epoch => $meta->{created_at}, type => $meta->{type}, account => $meta->{account}, service => $meta->{service}, nick => $meta->{nick}, hilight => 0, hi_nick => $meta->{nick}, text => $meta->{text}, topic => $meta->{topic}, level => MSGLEVEL_PUBLIC, ); if ($meta->{type} eq 'dm' or $meta->{type} eq 'error' or $meta->{type} eq 'deerror') { $line_attribs{level} = MSGLEVEL_MSGS; } my $nick = "\@$meta->{account}"; if ( $meta->{text} =~ /\Q$nick\E(?:\W|$)/i ) { $line_attribs{level} |= MSGLEVEL_HILIGHT; # $line_attribs{hi_nick} = &get_color($settings{hilight_color}, $meta->{nick}); } if ($settings{nick_color} eq 'rotate') { $line_attribs{hi_nick} = get_nick_color($meta->{nick}, $meta->{nick}); } $line_attribs{nl} = $meta->{nl} if defined $meta->{nl}; if (defined $meta->{ign}) { $line_attribs{ignoring} = 1; $line_attribs{marker} = '-' . $meta->{ign}; # must have a marker for tweet theme } elsif ( $meta->{type} ne 'dm' and $meta->{nick} and $meta->{id} and not $meta->{ign} ) { ### not ignored, so we probably want it cached and create a :marker... my $lc_nick = lc $meta->{nick}; my $marker = id_to_marker($lc_nick, $meta->{id}); if (not defined $marker) { $marker = ( $state{__indexes}{ $lc_nick } + 1 ) % $settings{track_replies}; $state{__ids} { $lc_nick }[$marker] = $meta->{id}; $state{__indexes}{ $lc_nick } = $marker; $state{__tweets} { $lc_nick }[$marker] = $meta->{text}; foreach my $key (qw/username reply_to_user reply_to_id nl created_at/) { # __usernames __reply_to_ids __reply_to_users __created_ats $state{"__${key}s"}{ $lc_nick }[$marker] = $meta->{$key} if defined $meta->{$key}; } } $line_attribs{marker} = ":$marker"; } return %line_attribs; } sub cache_to_meta { my $line = shift; my $type = shift; my %meta = ( type => $type ); foreach my $key (@{ $_[0] }) { if ($key eq 'nl' and $line =~ s/^$key:"([^"]+)"\s*//) { $meta{$key} = $1; } elsif ($line =~ s/^$key:(\S+)\s*//) { $key = 'account' if $key eq 'ac'; $meta{$key} = $1; $meta{$key} = &decode_from_file($meta{$key}); if ($key eq 'account') { $meta{username} = &normalize_username($meta{account}); # username is account@Service $meta{account} =~ s/\@(\w+)$//; $meta{service} = $1; } elsif ($key eq 'ts') { $meta{created_at} = $meta{ts}; } elsif ($key eq 'created_at') { $meta{created_at} = &date_to_epoch($meta{created_at}); } } } $meta{text} = $line; return %meta; } sub monitor_child { my $args = shift; my $filename = $args->[0]; my $attempts_to_go = $args->[1]; my $wait_time = $args->[2]; my $is_update = $args->[3]; my $filename_tmp = $args->[4]; my $prev_mtime = $args->[5]; my $file_progress = 'no ' . $filename_tmp; my $this_mtime = $prev_mtime; if (-f $filename_tmp) { $this_mtime = (stat(_))[9]; $file_progress = 'mtime=' . $this_mtime; } &debug("checking child log at $filename [$file_progress v $prev_mtime] ($attempts_to_go)"); # reap any random leftover processes - work around a bug in irssi on gentoo waitpid( -1, WNOHANG ); # first time we run we don't want to print out *everything*, so we just # pretend my @lines = (); my %new_cache = (); my %types_per_user = (); my $got_errors = 0; my %show_now = (); # for non-update info my $fh; if ( -e $filename and open $fh, '<', $filename ) { binmode $fh, ":" . &get_charset(); } else { # file not ready yet if ( $attempts_to_go > 0 ) { Irssi::timeout_add_once( $wait_time, 'monitor_child', [ $filename, $attempts_to_go - 1, $wait_time, $is_update, $filename_tmp, $this_mtime ] ); } else { &debug("Giving up on polling $filename"); Irssi::pidwait_remove($child_pid); waitpid( -1, WNOHANG ); unlink $filename unless &debug(); if (not $is_update) { &error("Failed to get response. Giving up."); return; } $update_is_running = 0 if $is_update; return unless $settings{notify_timeouts}; my $since; if ( time - $last_poll{__poll} < 24 * 60 * 60 ) { my @time = localtime($last_poll{__poll}); $since = sprintf( "%d:%02d", @time[ 2, 1 ] ); } else { $since = scalar localtime($last_poll{__poll}); } if ( $failstatus < 2 and time - $last_poll{__poll} > 60 * 60 ) { &error( $settings{mini_whale} ? 'FAIL WHALE' : q{ v v v}, q{ | | v | v}, q{ | .-, | | |}, q{ .--./ / | _.---.| }, q{ '-. (__..-" \\}, q{ \\ a |}, q{ ',.__. ,__.-'/}, q{ '--/_.'----'`} ); $failstatus = 2; } if ( $failstatus == 0 and time - $last_poll{__poll} < 600 ) { &error("Haven't been able to get updated tweets since $since"); $failstatus = 1; } } return; } # make sure we're not in slurp mode local $/ = "\n"; while (<$fh>) { unless (/\n$/) { # skip partial lines &debug($fh, "Skipping partial line: $_"); next; } chomp; my $type; if (s/^t:(\w+)\s+//) { $type = $1; } else { &error("invalid: $_"); next; } if ($type eq 'debug') { &debug($_); } elsif ($type =~ /^(error|info|deerror)$/) { $got_errors++ if $type eq 'error'; ¬ice([$type], $_); } elsif ($type eq 'unuid') { my %meta = &cache_to_meta($_, $type, [ qw/ id / ]); $state{__i_is_bad}{$meta{id}} = time; } elsif ($type eq 'uid') { my %meta = &cache_to_meta($_, $type, [ qw/ nick id / ]); $state{__i}{$meta{id}} = $meta{nick}; $state{__u}{$meta{nick}}{id} = $meta{id}; } elsif ($type eq 'url') { my %meta = &cache_to_meta($_, $type, [ qw/epoch https site uri/ ]); $expanded_url{$meta{site}}{$meta{https} ? 1 : 0}{$meta{uri}} = { url => $meta{text}, epoch => $meta{epoch}, }; } elsif ($type eq 'last_poll') { my %meta = &cache_to_meta($_, $type, [ qw/ac poll_type epoch/ ]); if ( not defined $meta{ac} and $meta{poll_type} eq '__poll' ) { $last_poll{$meta{poll_type}} = $meta{epoch}; } elsif ( $meta{epoch} >= $last_poll{$meta{username}}{$meta{poll_type}} ) { $last_poll{$meta{username}}{$meta{poll_type}} = $meta{epoch}; &debug("%G$meta{username}%n $meta{poll_type} updated to $meta{epoch}"); } else { &debug("%G$meta{username}%n Impossible! $meta{poll_type}: " . "new poll=$meta{epoch} < prev=$last_poll{$meta{username}}{$meta{poll_type}}!"); $got_errors++; } } elsif ($type eq 'fix_replies_index') { my %meta = &cache_to_meta($_, $type, [ qw/idx ac topic id_type/ ]); $fix_replies_index{ $meta{username} } = $meta{idx}; &debug("%G$meta{username}%n fix_replies_index set to $meta{idx}"); } elsif ($type eq 'searchid' or $type eq 'last_id_fixreplies' or $type eq 'last_id') { my %meta = &cache_to_meta($_, $type, [ qw/id ac topic id_type/ ]); if ( $meta{type} eq 'searchid' ) { &debug("%G$meta{username}%n Search '$meta{topic}' got id $meta{id}"); if (not exists $state{__last_id}{ $meta{username} }{__search}{ $meta{topic} } or $state{__last_id}{ $meta{username} }{__search}{ $meta{topic} } eq '9223372036854775807' or cmp_id($meta{id}, $state{__last_id}{ $meta{username} }{__search}{ $meta{topic} }) > 0) { $state{__last_id}{ $meta{username} }{__search}{ $meta{topic} } = $meta{id}; } else { &debug("%G$meta{username}%n Search '$meta{topic}' bad id $meta{id}"); $got_errors++; } } elsif ( $meta{type} eq 'last_id') { $state{__last_id}{ $meta{username} }{ $meta{id_type} } = $meta{id} # timeline reply dm ... if cmp_id($meta{id}, $state{__last_id}{ $meta{username} }{ $meta{id_type} }) > 0; } elsif ( $meta{type} eq 'last_id_fixreplies' ) { $state{__last_id}{ $meta{username} }{__extras}{ $meta{id_type} } = $meta{id} if cmp_id($meta{id}, $state{__last_id}{ $meta{username} }{__extras}{ $meta{id_type} }) > 0; } } elsif ($type eq 'tweet' or $type eq 'dm' or $type eq 'reply' or $type eq 'search' or $type eq 'search_once') { # cf theme_register my %meta = &cache_to_meta($_, $type, [ qw/id ac ign reply_to_user reply_to_id nl nick topic created_at ts / ]); if (exists $new_cache{ $meta{id} }) { &debug("SKIP newly-cached $meta{id}"); next; } $new_cache{ $meta{id} } = time; if (exists $tweet_cache{ $meta{id} }) { # and (not $retweeted_id{$username} or not $retweeted_id{$username}{ $meta{id} }); &debug("SKIP cached $meta{id}"); next; } my %line_attribs = &meta_to_line(\%meta); push @lines, { %line_attribs }; if ( $meta{type} eq 'search' ) { if ( exists $state{__last_id}{ $meta{username} }{__search}{ $meta{topic} } and cmp_id($meta{id}, $state{__last_id}{ $meta{username} }{__search}{ $meta{topic} }) > 0) { $state{__last_id}{ $meta{username} }{__search}{ $meta{topic} } = $meta{id}; } } elsif ( $meta{type} eq 'search_once' ) { delete $search_once{ $meta{username} }->{ $meta{topic} }; } } elsif ($type eq 'friend' or $type eq 'block' or $type eq 'list') { my %meta = &cache_to_meta($_, $type, [ qw/ac list id nick epoch/ ]); if ($is_update and not defined $types_per_user{$meta{username}}{$meta{type}}) { if ($meta{type} eq 'friend') { $friends{$meta{username}} = (); } elsif ($meta{type} eq 'block') { $blocks{$meta{username}} = (); } elsif ($meta{type} eq 'list') { my ($list_account, $list_name) = split '/', $meta{list}; $state{__lists}{$list_account} = {}; } $types_per_user{$meta{username}}{$meta{type}} = 1; } if ($meta{type} eq 'friend') { $nicks{$meta{nick}} = $friends{$meta{username}}{$meta{nick}} = $meta{epoch}; } elsif ($meta{type} eq 'block') { $blocks{$meta{username}}{$meta{nick}} = $meta{epoch}; } elsif ($meta{type} eq 'list') { my ($list_account, $list_name) = split '/', $meta{list}; if (not exists $state{__lists}{$list_account}{$list_name}) { $state{__lists}{$list_account}{$list_name} = { id=>$meta{id}, members=>[] }; } $show_now{lists}{$list_account}{$list_name} = $meta{id} if not $is_update; push @{ $state{__lists}{$list_account}{$list_name}{members} }, $meta{nick}; } } else { &error("invalid type ($type): $_"); } } # file was opened, so we tried to parse... close $fh; # make sure the pid is removed from the waitpid list Irssi::pidwait_remove($child_pid); # and that we don't leave any zombies behind, somehow waitpid( -1, WNOHANG ); &debug("new last_poll = $last_poll{__poll}", "new last_poll_id = " . Dumper( $state{__last_id} )) if $is_update; if ($is_update and $first_call and not $settings{force_first}) { &debug("First call, not printing updates"); } else { if (exists $show_now{lists}) { for my $list_account (keys %{ $show_now{lists} }) { my $list_ac = ($list_account eq "$user\@$defservice" ? '' : "$list_account/"); for my $list_name (keys %{ $show_now{lists}{$list_account} }) { if (0 == @{ $state{__lists}{$list_account}{$list_name}{members} }) { ¬ice(['info'], "List $list_ac$list_name is empty."); } else { ¬ice("List $list_ac$list_name members: " . join(', ', @{ $state{__lists}{$list_account}{$list_name}{members} })); } } } } &write_lines(\@lines, $is_update); } unlink $filename or warn "Failed to remove $filename: $!" unless &debug(); # commit the pending cache lines to the actual cache, now that # we've printed our output for my $updated_id (keys %new_cache) { $tweet_cache{$updated_id} = $new_cache{$updated_id}; } # keep enough cached tweets, to make sure we don't show duplicates for my $loop_id ( keys %tweet_cache ) { next if $tweet_cache{$loop_id} >= $last_poll{__poll} - 3600; delete $tweet_cache{$loop_id}; } if (not $got_errors) { &save_state(); } if ($is_update) { if ($failstatus and not $got_errors) { ¬ice([ 'deerror' ], "Update succeeded."); $failstatus = 0; } $first_call = 0; $update_is_running = 0; } } sub cmp_id { my $id1 = shift; my $id2 = shift; return -1 if length $id1 < length $id2; return 1 if length $id1 > length $id2; return $id1 cmp $id2; } # write_lines to windows, channels and/or logs sub write_lines { my $lines_ref = shift; my $is_update = shift; my @date_now = localtime(); my $ymd_now = sprintf('%04d-%02d-%02d', $date_now[5]+1900, $date_now[4]+1, $date_now[3]); # &debug("line: " . Dumper $lines_ref); foreach my $line (@$lines_ref) { my $line_want_extras = $is_update; my $win_name = &window( $line->{type}, $line->{username}, $line->{nick}, $line->{topic} ); my $ac_tag = ''; if ( lc $line->{service} ne lc $settings{default_service} ) { $ac_tag = "$line->{username}: "; } elsif ( $line->{username} ne "$user\@$defservice" and lc $line->{account} ne lc $win_name ) { $ac_tag = $line->{account} . ': '; } my $reply_to_user; my $theme = "twirssi_" . $line->{type}; # theme e.g. twirssi_tweet twirssi_reply if ($line->{type} eq 'reply') { # $3 is whom reply_to_ $reply_to_user = $state{__reply_to_users}{$line->{nick}}[$line->{id}]; if ($reply_to_user) { my $reply_to_id = $state{__reply_to_ids}{$line->{nick}}[$line->{id}]; my $reply_to_marker = id_to_marker(lc($reply_to_user), $reply_to_id); if ($reply_to_user and defined $reply_to_marker) { $theme = 'twirssi_reply_to'; $reply_to_user .= ":$reply_to_marker"; } } } my @print_opts = ( $line->{level}, $theme, $ac_tag, # $0 ); push @print_opts, (lc $line->{topic} ne lc $win_name ? $line->{topic} . ':' : '') if $line->{type} =~ /search/; my ($nick_idx, $marker_idx); if ($line->{type} ne 'error' and $line->{type} ne 'deerror') { push @print_opts, $line->{hi_nick}; $nick_idx = $#print_opts; } if (defined $line->{marker}) { push @print_opts, $line->{marker}; $marker_idx = $#print_opts; } if (defined $reply_to_user) { push @print_opts, $reply_to_user; # $3 is to whom replied with marker } # epoch needed for setting timestamp on output of $line if (not defined $line->{epoch}) { &ensure_timestamp_format(); Irssi::window_find_name($settings{debug_win_name})->printformat( @print_opts, &hilight( $line->{text}, { clean_nl => 1 } ) . " " . &get_color($settings{ymd_color}, "BAD DATE") ); next; } my @date = localtime($line->{epoch}); my $ymd = sprintf('%04d-%02d-%02d', $date[5]+1900, $date[4]+1, $date[3]); my $ymd_suffix = ''; if (defined $line->{ignoring}) { next if not $settings{debug}; $line->{text} = &get_color('%b', "IGNORED") . " " . $line->{text}; if ($settings{debug_win_name} ne '' ) { $win_name = $settings{debug_win_name}; } else { $win_name = '(status)'; $line->{text} = "%g[$IRSSI{name}] %n " . $line->{text}; } $line_want_extras = 0; } elsif (not $is_update) { $ymd_suffix = " " . &get_color($settings{ymd_color}, $ymd) if $ymd_now ne $ymd; } elsif (not defined $last_ymd{wins}{$win_name} or $last_ymd{wins}{$win_name}->{ymd} ne $ymd) { &ensure_timestamp_format(); Irssi::window_find_name($win_name)->printformat(MSGLEVEL_PUBLIC, 'twirssi_new_day', $ymd, ''); $last_ymd{wins}{$win_name}->{ymd} = $ymd; } $line->{text} = &post_process_tweet($line->{text}); my $width_num_lines; my @lines = &get_multilines($line); if (@lines > 1) { $width_num_lines = length(0+@lines); # if there are 101 lines, then we get 3 spaces (wide) } my $ts = DateTime->from_epoch( epoch => $line->{epoch}, time_zone => $local_tz )->strftime($settings{timestamp_format}); &ensure_timestamp_format($ts); my $ts_fmt_len = length($ts); for (my $line_num = 1; $line_num <= @lines; $line_num++) { if (@lines > 1) { if (defined $marker_idx) { my $sub_marker = sprintf(".%0*d", $width_num_lines, $line_num); $print_opts[$marker_idx] = ($line_num > 1 ? ' ' x length($line->{marker}) : $line->{marker}) . $sub_marker; } if ($line_num > 1) { if (defined $nick_idx and $line_num == 2) { $print_opts[$nick_idx] = ' ' x length($print_opts[$nick_idx]); } $print_opts[2] = ' ' x length($print_opts[2]); # $ac_tag } } Irssi::window_find_name($win_name)->printformat( @print_opts, &hilight( $lines[$line_num-1] ) . $ymd_suffix ); $ymd_suffix = ''; # only show on first line } &ensure_timestamp_format(); # reset timestamp format if ($line_want_extras) { &write_log($line, $win_name, \@date); &write_channels($line, \@date); } } } sub write_channels { my $line = shift; my $date_ref = shift; my %msg_seen; for my $type ($line->{type}, 'sender', '*') { next unless defined $state{__channels}{$type}; for my $tag (($type eq 'sender' ? $line->{nick} : ($line->{type} =~ /search/ ? $line->{topic} : $line->{username})), '*') { next unless defined $state{__channels}{$type}{$tag}; for my $net_tag (keys %{ $state{__channels}{$type}{$tag} }) { for my $channame (@{ $state{__channels}{$type}{$tag}{$net_tag} }) { next if defined $msg_seen{$net_tag}{$channame}; my $server = Irssi::server_find_tag($net_tag); $last_ymd{chans}{$channame} = {} if not defined $last_ymd{chans}{$channame}; for my $log_line (&log_format($line, $channame, $last_ymd{chans}{$channame}, $date_ref)) { if (defined $server) { $server->command("msg -$net_tag $channame $log_line"); $msg_seen{$net_tag}{$channame} = 1; } else { ¬ice("no server for $net_tag/$channame: $log_line"); } } } } } } } sub write_log { my $line = shift; my $win_name = shift; my $date_ref = shift; return unless my $logfile_obj = &ensure_logfile($win_name); my $fh = $logfile_obj->{fh}; for my $log_line (&log_format($line, $logfile_obj->{filename}, $logfile_obj, $date_ref, { to_file => 1 })) { print $fh $log_line, "\n"; } } sub log_format { my $line = shift; my $target_name = shift; my $ymd_obj = shift; # can be $last_ymd{chans}{$chan} or $logfile_obj (both need to have ->{ymd}) my $date_ref = shift; my $opts = shift // {}; # to_file my @logs = (); my $ymd = sprintf('%04d-%02d-%02d', $date_ref->[5]+1900, $date_ref->[4]+1, $date_ref->[3]); if ($ymd_obj->{ymd} ne $ymd) { # cf twirssi_new_day push @logs, "Day changed to $ymd" . (length($ymd_obj->{ymd}) ? " (was ".$ymd_obj->{ymd}.")" : '') if $ymd ne ''; $ymd_obj->{ymd} = $ymd; } my %out = ( i180_prenick => '@', i200_nick => $line->{hi_nick}, i900_gap => ' ', ); $out{i000_timestamp} = sprintf('%02d:%02d:%02d ', $date_ref->[2], $date_ref->[1], $date_ref->[0]) if $opts->{to_file}; if ( $line->{type} eq 'dm' ) { $out{i100_prefix} = 'DM '; $out{i300_suffix} = ':'; } elsif ( $line->{type} eq 'search' or $line->{type} eq 'search_once' ) { $out{i100_prefix} = '['; $out{i150_topic} = "$line->{topic}:" unless $target_name =~ /$line->{topic}/; $out{i300_suffix} = ']'; } elsif ( $line->{type} eq 'tweet' or $line->{type} eq 'reply' ) { $out{i100_prefix} = '<'; $out{i150_account} = "$line->{account}:" unless $target_name =~ /$line->{account}/; $out{i300_suffix} = '>'; } else { %out = ( i100_prefix => 'ERR:' ); } my @lines = &get_multilines($line, { no_colors => $opts->{to_file} }); for (my $line_idx = 0; $line_idx < @lines; $line_idx++) { if (defined $out{i200_nick} and @lines > 1) { $out{i210_marker} = sprintf(".%0*d", length(0+@lines), $line_idx+1); # marker } push @logs, join('', map { $out{$_} } sort keys %out) . $lines[$line_idx]; } return @logs; } sub get_multilines { my $line_obj = shift; my $opts = shift // {}; # no_colors show_multiline_prefix my @lines = ($line_obj->{text}); my @delete_empty = (); @lines = split($line_obj->{nl}, $line_obj->{text}) if defined $line_obj->{nl}; for (my $line_idx = 0; $line_idx < @lines; $line_idx++) { if (@lines > 1 and ( (length($lines[$line_idx]) == 0 and $settings{multiline_show_empty} == 0) or ($lines[$line_idx] =~ /^\s*$/ and $settings{multiline_show_blank} == 0) )) { # if blank and no-show-blanks push @delete_empty, $line_idx; next; } $lines[$line_idx] = &remove_colors($lines[$line_idx]) if $opts->{no_colors}; } if (@delete_empty == @lines) { return () if $settings{multiline_show_contentless}; return ($lines[0]); } for my $line_idx (reverse @delete_empty) { splice @lines, $line_idx, 1; } return @lines; } sub remove_colors { my $txt = shift; $txt =~ s/( \e\[ [\d;]* m | \cC\d{2}(?:,\d{2})? | \cO ) //gx; return $txt; } sub ensure_timestamp_format { my $ts = shift; Irssi::command("^set timestamp_format " . ($ts // $settings{timestamp_format})); } sub save_state { # save state hash if ( keys %state and my $file = $settings{replies_store} ) { if ( open my $fh, '>', $file ) { print $fh encode_json( \%state ); close $fh; } else { &error("Failed to write state to $file: $!"); } } # save id hash if ( my $file = $settings{id_store} ) { if ( open my $fh, '>', $file ) { print $fh encode_json( \%tweet_cache ); close $fh; } else { &error("Failed to write IDs to $file: $!"); } } } sub save_polls { # save last_poll hash if ( keys %last_poll and my $file = $settings{poll_store} ) { if ( open my $fh, '>', $file ) { print $fh encode_json( \%last_poll ); close $fh; } else { &error("Failed to write polls to $file: $!"); } } } sub debug { return if not $settings{debug}; my $fh; $fh = shift if ref($_[0]) eq 'GLOB'; while (@_) { my $line = shift; next if not defined $line; chomp $line; for my $sub_line (split("\n", $line)) { next if $sub_line eq ''; if ($fh) { print $fh 't:debug +', substr(time, -3), ' ', $sub_line, "\n"; } elsif ($settings{debug_win_name} ne '') { my $dbg_win = $settings{debug_win_name}; # TODO &ensure_timestamp_format(); # seems to cause lockup on startup $dbg_win = $settings{window} if not &ensure_window($dbg_win); Irssi::window_find_name($dbg_win)->print( $sub_line, MSGLEVEL_PUBLIC ); } else { print "[$IRSSI{name}] ", $sub_line; } } } return 1; } sub error { my $ref = $_[0]; if (ref $ref) { shift; unshift @$ref, undef if 1 == @$ref and ref($ref->[0]) eq 'GLOB'; # [$fh] so add null tag } else { $ref = []; } ¬ice([ 'error', @$ref ], @_); } sub notice { my ( $type, $tag, $fh, $theme ); if ( ref $_[0] ) { ( $type, $tag, $fh ) = @{ shift @_ }; $theme = 'twirssi_' . $type; } foreach my $msg (@_) { if (defined $fh) { for my $sub_line (split("\n", $msg)) { print $fh "t:$type ", ($tag ? "$tag " : '') . $sub_line, "\n" if $sub_line ne ''; } } else { my $col = '%G'; my $win_level = MSGLEVEL_PUBLIC; my $win; if ($tag eq '_tw_in_Win') { $win = Irssi::active_win(); } elsif ($type eq 'crap') { $win = Irssi::window_find_name(&window()); $col = '%R'; $win_level = MSGLEVEL_CLIENTCRAP; } else { $win = Irssi::window_find_name(&window( $type, $tag )); } if ($type =~ /^(error|info|deerror)$/) { # TODO &ensure_timestamp_format(); # seems to cause lockup on startup $win->printformat(MSGLEVEL_PUBLIC, $theme, $msg); # theme } else { $win->print("${col}***%n $msg", $win_level ); } } } } sub update_away { my $data = shift; if ( $data !~ /\@\w/ and $data !~ /^[dD] / ) { my $server = Irssi::server_find_tag( $settings{bitlbee_server} ); if ($server) { $server->send_raw("away :$data"); return 1; } else { &error("Can't find bitlbee server.", "Update bitlbee_server or disable tweet_to_away" ); return 0; } } return 0; } sub too_long { my $data = shift; my $alert_to = shift; my $doing = 'Tweet'; my $max_len = $settings{tweet_max_chars}; if ($alert_to and $alert_to->[0] eq 'dm') { # Twitter removed (more or less) the DM limit: # https://blog.twitter.com/official/en_us/a/2015/removing-the-140-character-limit-from-direct-messages.html $max_len = $settings{dm_max_chars}; $doing = 'DM'; } if ( length $data > $max_len ) { ¬ice( $alert_to, "$doing is " . ( length $data - $max_len ) . " characters too long (max is " . $max_len . " chars, attempt was " . length($data) . " chars) - aborted" ) if defined $alert_to; return 1; } return 0; } sub make_utf8 { my $data = shift; if ( !utf8::is_utf8($data) ) { return decode &get_charset(), $data; } else { return $data; } } sub valid_username { my $username = shift; my $orig_username = $username; $username = &normalize_username($username); unless ( exists $twits{$username} ) { &error( [$username], "Unknown username '$username' from '$orig_username'" ); return; } return $username; } sub logged_in { my $obj = shift; unless ($obj) { &error( "Not logged in! Use /twitter_login username" ); return 0; } return 1; } sub sig_complete { my ( $complist, $window, $word, $linestart, $want_space ) = @_; my $cmdchars = quotemeta Irssi::settings_get_str('cmdchars'); my $comp_type = ''; my $keep_at = 0; my $lc_stag = ''; my $cmd = ''; my @args = (); my $want_account = 0; if ($linestart =~ m@^ [$cmdchars] (\S+?)(_as)? ((?: \s+ \S+ )*) \s* $@xi) { $cmd = lc $1; my $cmd_as = $2; my $args = $3; $args =~ s/^\s+//; @args = split(/\s+/, $args); if ($cmd_as) { if (@args) { # act as if "_as ac" is not there shift @args; } elsif ($cmd =~ /^(?:twitter|twirssi|tweet|dm|retweet)/) { $want_account = 1; } } } if (not @args) { if ($want_account or grep { $cmd eq $_ } @{ $completion_types{'account'} }) { # '*_as' and 'account' types expect account as first arg $word =~ s/^@//; @$complist = grep /^\Q$word/i, map { s/\@.*// and $_ } keys %twits; return; } if (grep { $cmd eq $_ } @{ $completion_types{'tweet'} }) { # 'tweet' expects nick:num (we offer last num for each nick) $word =~ s/^@//; @$complist = map { "$_:$state{__indexes}{lc $_}" } sort { $nicks{$b} <=> $nicks{$a} } grep /^\Q$word/i, keys %{ $state{__indexes} }; return; } if (grep { $cmd eq $_ } @{ $completion_types{'nick'} }) { # 'nick' expects a nick $comp_type = 'nick'; } } # retweet_to non-first args if ($cmd eq 'retweet_to') { if (@args == 1) { @$complist = grep /^\Q$word/i, map { "-$_->{tag}" } Irssi::servers(); return; } elsif (@args == 2) { @$complist = grep /^\Q$word/i, qw/ -channel -nick /; return; } elsif (@args == 3 and $args[2] =~ m{^ -(channel|nick) $}x) { $lc_stag = lc $args[1]; $lc_stag = substr($lc_stag, 1) if substr($lc_stag, 0, 1) eq '-'; $comp_type = $1; } } # twirssi_set_window twirssi_set_channel if ($cmd eq 'twirssi_set_window' or $cmd eq 'twirssi_set_channel') { my $set_type = substr($cmd, 12); if (@args == 0) { @$complist = grep /^\Q$word/i, @{ $valid_types{$set_type} }; return; } elsif (@args == 1) { $comp_type = 'nick'; } elsif (@args == 2) { if ($set_type eq 'window') { @$complist = map { $_->{name} || $_->{active}->{name} } grep { my $n = $_->{name} || $_->{active}->{name}; $n =~ /^\Q$word\E/i } Irssi::windows(); return; } elsif ($set_type eq 'channel') { $comp_type = $set_type; } } } # anywhere in line... if (not $comp_type and grep { $cmd eq $_ } @{ $completion_types{'re_nick'} }) { # 're_nick' can have @nick anywhere $comp_type = 'nick'; $keep_at = 1; } if ($comp_type eq 'channel') { @$complist = map { $_->{name} } grep { $_->{name} =~ /^\Q$word\E/i and ($lc_stag eq '' or lc($_->{server}->{tag}) eq $lc_stag) } Irssi::channels(); return; } elsif ($comp_type eq 'nick') { my $prefix = $1 if $word =~ s/^(@)//; @$complist = map { ($prefix and $keep_at) ? "$prefix$_" : $_ } grep /^\Q$word/i, sort { $nicks{$b} <=> $nicks{$a} } keys %nicks; return; } } sub event_send_text { my ( $line, $server, $win ) = @_; my $awin = Irssi::active_win(); # if the window where we got our text was the twitter window, and the user # wants to be lazy, tweet away! my $acc = &window_to_account( $awin->get_active_name() ); if ( $acc and $settings{window_input} ) { &cmd_tweet_as( "$acc $line", $server, $win ); } } sub event_setup_changed { my $do_add = shift; # first run, want to add, too my @changed_stgs = (); foreach my $setting (@settings_defn) { my $setting_changed = 0; my $stg_type .= '_' . ($setting->[2] eq 'b' ? 'bool' : $setting->[2] eq 'i' ? 'int' : $setting->[2] eq 's' ? 'str' : ''); if ($stg_type eq '_') { if ($do_add) { print "ERROR: Bad opt '$setting->[2]' for $setting->[0]"; } else { &error( "Bad opt '$setting->[2]' for $setting->[0]" ); } next; } my $stg_type_fn; if ($do_add) { $stg_type_fn = 'Irssi::settings_add' . $stg_type; # settings_add_str, settings_add_int, settings_add_bool no strict 'refs'; $settings{ $setting->[0] } = &$stg_type_fn( $IRSSI{name}, $setting->[1], $setting->[3] ); } my $prev_stg; { $prev_stg = $settings{ $setting->[0] }; $stg_type_fn = 'Irssi::settings_get' . $stg_type; # settings_get_str, settings_get_int, settings_get_bool no strict 'refs'; $settings{ $setting->[0] } = &$stg_type_fn( $setting->[1] ); } if ($setting->[2] eq 's') { my $pre_proc = $setting->[4]; my $trim = 1; my $norm_user = 0; my $is_list = 0; while (defined $pre_proc and $pre_proc ne '') { if ($pre_proc =~ s/^lc(?:,|$)//) { $settings{$setting->[0]} = lc $settings{$setting->[0]}; } elsif ($pre_proc =~ s/^list\{(.)}(?:,|$)//) { my $re = $1; $re = qr/\s*$re\s*/ if $trim; if ($settings{$setting->[0]} eq '') { $settings{$setting->[0]} = [ ]; } else { $settings{$setting->[0]} = [ split($re, $settings{$setting->[0]}) ]; if (grep { $_ eq $setting->[0] } ('passwords')) { # ends '\', unescape separator: concatenate with next for (my $i = 0; $i+1 < @{ $settings{$setting->[0]} }; $i++) { while ( $settings{$setting->[0]}->[$i] =~ /\\$/ ) { $settings{$setting->[0]}->[$i] .= "," . delete $settings{$setting->[0]}->[$i+1]; } } } } $is_list = 1; } elsif ($pre_proc =~ s/^norm_user(?:,|$)//) { $norm_user = 1; } elsif ($do_add) { print "ERROR: Bad opt pre-proc '$pre_proc' for $setting->[0]"; } else { &error( "Bad opt pre-proc '$pre_proc' for $setting->[0]" ); } if ($norm_user) { my @normed = (); for my $to_norm ($is_list ? @{ $settings{$setting->[0]} } : $settings{$setting->[0]} ) { next if $to_norm eq ''; &debug($setting->[0] . ' to_norm {' . $to_norm . '}'); push @normed, &normalize_username($to_norm, 1); } $is_list = 1; $settings{$setting->[0]} = ($is_list ? \@normed : $normed[0]); } } if (Dumper($prev_stg) ne Dumper($settings{ $setting->[0] })) { $setting_changed = 1; } } elsif ($prev_stg != $settings{ $setting->[0] }) { $setting_changed = 1; } push @changed_stgs, $setting->[0] if $setting_changed and not $do_add; if ($setting_changed or $do_add) { if ($setting->[0] eq 'poll_interval' or $setting->[0] eq 'poll_schedule' ) { &ensure_updates(); } } } &debug('changed settings: ' . join(', ', @changed_stgs)) if @changed_stgs; &ensure_logfile($settings{window}); if ($do_add or grep 'url_unshorten', @changed_stgs) { # want to load this in the parent to allow child to use it expediently &load_ua(); } &debug("Settings changed ($do_add):" . Dumper \%settings); } sub ensure_logfile() { my $win_name = shift; return unless $settings{logging}; my $new_logfile = Irssi::settings_get_str('autolog_path'); return if $new_logfile eq ''; $new_logfile =~ s/^~/$ENV{HOME}/; $new_logfile = strftime($new_logfile, localtime()); $new_logfile =~ s/\$(tag\b|\{tag\})/$IRSSI{name}/g; if ($new_logfile !~ s/\$(0\b|\{0\})/$win_name/g) { # not per-window logging, so use default window name as key $win_name = $settings{window}; } return $logfile{$win_name} if defined $logfile{$win_name} and $new_logfile eq $logfile{$win_name}->{filename}; return if not &ensure_dir_for($new_logfile); my $old_umask = umask(0177); &debug("Logging to $new_logfile"); my $res; if ( my $fh = FileHandle->new( $new_logfile, '>>' ) ) { umask($old_umask); binmode $fh, ':utf8'; $fh->autoflush(1); $res = $logfile{$win_name} = { 'fh' => $fh, 'filename' => $new_logfile, 'ymd' => '', }; } else { &error( "Failed to append to $new_logfile: $!" ); } umask($old_umask); return $res; } sub ensure_dir_for { my $path = shift; if (not $path =~ s@/[^/]+$@@) { &debug("Cannot cd up $path"); return; } return 1 if $path eq '' or -d $path or $path eq '/'; return if not &ensure_dir_for($path); if (not mkdir($path, 0700)) { &debug("Cannot make $path: $!"); return; } return 1; } sub get_poll_time { my $poll = $settings{poll_interval}; my $hhmm; foreach my $tuple ( @{ $settings{poll_schedule} } ) { if ( $tuple =~ /^(\d{4})-(\d{4}):(\d+)$/ ) { $hhmm = sprintf('%02d%02d', (localtime())[2,1]) if not defined $hhmm; my($range_from, $range_to, $poll_val) = ($1, $2, $3); if ( ( $hhmm ge $range_from and $hhmm lt $range_to ) or ( $range_from gt $range_to and ( $hhmm ge $range_from or $hhmm lt $range_to ) ) ) { $poll = $poll_val; } } } return $poll if $poll >= 60; return 60; } sub get_charset { my $charset = $settings{charset}; return "utf8" if $charset =~ /^\s*$/; return $charset; } sub get_color { my $col = shift; my $text = shift; if (defined $irssi_to_mirc_colors{$col}) { $col = "\cC" . $irssi_to_mirc_colors{$col}; } elsif ($col =~ /^%([Xx])([1-6])([0-9a-zA-Z])$/ or $col =~ /^%([Xx])(7)([0-9a-xA-X])$/) { my ($fgbg, $encoding, $dig2) = ( $1, ($2-1)*36, $3 ); $encoding += ($dig2 =~ /[0-9]/ ? 0+$dig2 : ord(lc $dig2)-ord('a')+10); $col = "\e[" . ($fgbg eq 'X' ? 38 : 48) . ";5;${encoding}m"; } elsif ($col =~ /^%([Zz])([0-9a-f]{2})([0-9a-f]{2})([0-9a-f]{2})$/) { my ($fgbg, $r, $g, $b) = ( $1, hex("0x$2"), hex("0x$3"), hex("0x$4") ); $col = "\e[" . ($fgbg eq 'Z' ? 38 : 48) . ";2;" . join(";", $r, $g, $b) . "m"; } else { return $text if defined $text; } return "$col$text\cO" if defined $text; return $col; } my @available_nick_colors = ( '00', '02', '03', '04', '05', '06', '07', '08', '09', 10, 11, 12, 13, '00,02', '00,03', '00,05', '00,06', '01,00', '01,03', '01,05', '01,06', '01,07', '01,10', '01,15', '02,03', '02,07', '02,10', '02,15', '03,02', '03,05', '03,10', '04,02', '04,07', '05,02', '05,03', '05,07', '05,10', '05,15', '06,02', '06,07', '06,10', '06,15', '08,02', '08,05', '08,06', '09,02', '09,05', '09,06', '10,02', '10,05', '10,06', '11,02', '11,05', '11,06', '12,02', '12,05', '13,02', '13,15', '14,02', '14,05', '14,06', '15,02', '15,05', '15,06' ); my %nick_colors; sub get_nick_color { my $nick = shift; my $text = shift; return get_color($settings{nick_color}, $text) if $settings{nick_color} ne 'rotate'; if (not defined $nick_colors{$nick}) { my $value = 0; foreach my $char (split //, lc $nick) { $value += ord $char; } $nick_colors{$nick} = $available_nick_colors[$value % @available_nick_colors]; } my $col = "\cC" . $nick_colors{$nick}; return "$col$text\cO" if defined $text; return $col; } sub hilight { # nick or topic my $text = shift; my $opts = shift // {}; if ( $settings{nick_color} ) { $text =~ s[(^|\W)\@(\w+)] { $1 . get_nick_color($2, "\@$2"); }eg; } if ( $settings{topic_color} ) { my $c = $settings{topic_color}; $text =~ s/(^|\W)(\#|\!)([-\w]+)/$1 . &get_color($c, "$2$3")/eg if $c; } $text =~ s/[\n\r]/ /g if $opts->{clean_nl}; return $text; } sub shorten { my $data = shift; my $provider = $settings{url_provider}; if ( ( $settings{always_shorten} or &too_long($data) ) and $provider ) { my @args; if ( $provider eq 'Bitly' ) { @args[ 1, 2 ] = split ',', $settings{url_args}, 2; unless ( @args == 3 ) { ¬ice([ 'crap' ], "WWW::Shorten::Bitly requires a username and API key.", "Set short_url_args to username,API_key or change your", "short_url_provider." ); return &make_utf8($data); } } foreach my $url ( $data =~ /(https?:\/\/\S+[\w\/])/g ) { eval { $args[0] = $url; my $short = makeashorterlink(@args); if ($short) { $data =~ s/\Q$url/$short/g; } else { &error( "Failed to shorten $url!" ); } }; } } return &make_utf8($data); } sub load_ua { return if defined $ua or not @{ $settings{url_unshorten} }; ¬ice("Loading LWP and ua..."); eval "use LWP;"; $ua = LWP::UserAgent->new( env_proxy => 1, timeout => 10, agent => "$IRSSI{name}/$VERSION", requests_redirectable => [], ); } sub is_url_from_shortener { my $url = shift; return unless @{ $settings{url_unshorten} } and $url =~ s@^https?://([\w.]+)/.*@lc $1@e; return grep { $url eq $_ } @{ $settings{url_unshorten} }; } sub get_url_parts { my $url = shift; my @parts = ($url =~ m@^(https?)://([^/]+)/(.+)@i); $parts[0] = lc $parts[0]; $parts[1] = lc $parts[1]; return @parts; } sub get_unshorten_urls { my $text = shift; my $fh = shift; return unless @{ $settings{url_unshorten} }; foreach my $url ( $text =~ m@\b(https?://\S+[\w/])@g ) { my @orig_url_parts; my @url_parts; my $new_url = $url; my $max_redir = 4; my $resp; while ($max_redir-- > 0 and @url_parts = &get_url_parts($new_url) and grep { $url_parts[1] eq $_ } @{ $settings{url_unshorten} } and not defined $expanded_url{$url_parts[1]}{$url_parts[0] eq 'https' ? 1 : 0}{$url_parts[2]} and $resp = $ua->head($new_url) and (defined $resp->header('Location') or (&debug($fh, "cut_short $new_url => " . $resp->header('Host')) and 0) )) { &debug($fh, "deshort $new_url => " . $resp->header('Location')); @orig_url_parts = @url_parts if not @orig_url_parts; $new_url = $resp->header('Location'); } if (@orig_url_parts) { $expanded_url{$orig_url_parts[1]}{$orig_url_parts[0] eq 'https' ? 1 : 0}{$orig_url_parts[2]} = { url => $new_url, epoch => time, }; } } } sub put_unshorten_urls { my $fh = shift; my $epoch = shift; for my $site (keys %expanded_url) { for my $https (keys %{ $expanded_url{$site} }) { for my $uri (keys %{ $expanded_url{$site}{$https} }) { next if $expanded_url{$site}{$https}{$uri}{epoch} < $epoch; print $fh "t:url epoch:$expanded_url{$site}{$https}{$uri}{epoch} ", ($https ? 'https:1 ' : ''), "site:$site uri:$uri $expanded_url{$site}{$https}{$uri}{url}\n"; } } } } sub post_process_tweet { my $data = shift; my $skip_unshorten = shift; if (@{ $settings{url_unshorten} } and not $skip_unshorten) { for my $site (keys %expanded_url) { for my $https (keys %{ $expanded_url{$site} }) { my $url = ($https ? 'https' : 'http') . '://' . $site . '/'; next if -1 == index($data, $url); for my $uri (keys %{ $expanded_url{$site}{$https} }) { $data =~ s/\Q$url$uri\E/ &get_color($settings{shorter_color}, $&) . " " . &get_color($settings{unshorten_color}, "<$expanded_url{$site}{$https}{$uri}{url}>") /eg; } } } } return &make_utf8($data); } sub normalize_username { my $user = shift; my $non_login = shift; return '' if $user eq ''; my ( $username, $service ) = split /\@/, lc($user), 2; if ($service) { $service = ucfirst $service; } else { $service = ucfirst lc $settings{default_service}; unless ( $non_login or exists $twits{"$username\@$service"} ) { $service = undef; foreach my $t ( sort keys %twits ) { next unless $t =~ /^\Q$username\E\@(Twitter|Identica)/; $service = $1; last; } unless ($service) { &error( "Can't find a logged in user '$user'" ); return "$username\@$settings{default_service}"; } } } return "$username\@$service"; } sub encode_nl { my $text = shift; return ($text, undef) unless $text =~ /[\n\r]/; for my $in_nl ('', 'a'..'z', 'A'..'Z') { my $nl = " _NL${in_nl}_ "; next if $text =~ /$nl/; $text =~ s/\r\n/$nl/g; $text =~ s/\n\r/$nl/g; $text =~ s/[\n\r]/$nl/g; return ($text, $nl); } $text =~ s/[\n\r]/ /g; # cannot find suitable encoding, so throw all nl away return ($text, undef); } # convert $tweet's text to string (also return the $nl infix) sub get_text { my $tweet = shift; my $object = shift; my $text = decode_entities( get_full_text($tweet) ); if ( exists $tweet->{retweeted_status} ) { $text = &format_expand( fmt => $settings{retweeted_format} || $settings{retweet_format}, nick => $tweet->{retweeted_status}{user}{screen_name}, data => '', tweet => decode_entities( get_full_text($tweet->{retweeted_status}) ), ); } elsif ( $tweet->{truncated} and ( $object->isa('Net::Twitter') or $object->isa('Twitter::API') ) ) { $text .= " -- http://twitter.com/$tweet->{user}{screen_name}" . "/status/$tweet->{id}"; } return &encode_nl($text); } sub get_full_text { my $t = shift; return defined($t->{full_text}) ? $t->{full_text} : $t->{text}; } sub window { my $type = shift || "default"; my $uname = shift || "default"; my $sname = lc(shift); my $topic = lc(shift || ''); $type = "search" if $type eq 'search_once'; $type = "error" if $type eq 'deerror'; my $win; my @all_priorities = qw/ account sender list /; my @win_priorities = split ',', $settings{window_priority}; my $done_rest = 0; while (@win_priorities and not defined $win) { my $win_priority = shift @win_priorities; if ($win_priority eq 'account') { for my $type_iter ($type, 'default') { next unless exists $state{__windows}{$type_iter}; $win = $state{__windows}{$type_iter}{$uname} || $state{__windows}{$type_iter}{$topic} || $state{__windows}{$type_iter}{$user} || $state{__windows}{$type_iter}{default}; last if defined $win or $type_iter eq 'default'; } } elsif ($win_priority eq 'sender') { if (defined $sname and defined $state{__windows}{$win_priority}{$sname}) { $win = $state{__windows}{$win_priority}{$sname}; } } elsif ($win_priority eq 'list') { if (defined $sname and defined $state{__windows}{$win_priority}{$sname}) { $win = $state{__windows}{$win_priority}{$sname}; } } if (not defined $win and not @win_priorities and not $done_rest) { $done_rest = 1; for my $check_priority (@all_priorities) { if (not grep { $check_priority eq $_ } split ',', $settings{window_priority}) { push @win_priorities, $check_priority; } } } } $win = $settings{window} if not defined $win; if (not &ensure_window($win, '_tw_in_Win')) { $win = $settings{window}; } # &debug("window($type, $uname, $sname, $topic) -> $win"); return $win; } sub ensure_window { my $win = shift; my $using_win = shift; return $win if Irssi::window_find_name($win); ¬ice([ 'crap', $using_win ], "Creating window '$win'."); my $newwin = Irssi::Windowitem::window_create( $win, 1 ); if (not $newwin) { &error([ $using_win ], "Failed to create window $win!"); return; } $newwin->set_name($win); return $win; } sub window_to_account { my $name = shift; foreach my $type ( keys %{ $state{__windows} } ) { foreach my $uname ( keys %{ $state{__windows}{$type} } ) { if ( lc $state{__windows}{$type}{$uname} eq lc $name ) { return $uname; } } } if ( lc $name eq $settings{window} ) { return $user; } return; } sub read_json { my $file = shift; my $store = shift; my $desc = shift; if ( $file and -r $file ) { if ( open( my $fh, '<', $file ) ) { my $json; do { local $/; $json = <$fh>; }; close $fh; eval { my $ref = decode_json($json); %$store = %$ref; }; } else { &error( "Failed to load $desc from $file: $!" ); } } } Irssi::signal_add( "send text", "event_send_text" ); Irssi::signal_add( "setup changed", "event_setup_changed" ); Irssi::theme_register( # theme [ 'twirssi_tweet', '[$0%B@$1%n$2] $3', # $pre @$ac :$num 'twirssi_search', '[$0%r$1%n%B@$2%n$3] $4', 'twirssi_search_once', '[$0%r$1%n%B@$2%n$3] $4', 'twirssi_reply', '[$0\--> %B@$1%n$2] $3', 'twirssi_reply_to', '[$0%b$3%n<-- %B@$1%n$2] $4', 'twirssi_dm', '[$0%r@$1%n (%WDM%n)] $2', 'twirssi_error', '%RERROR%n: $0', 'twirssi_deerror', '%RUPDATE%n: $0', 'twirssi_info', '%CINFO:%N $0', 'twirssi_new_day', '%CDay changed to $0%N', ] ); $last_poll{__poll} = time - &get_poll_time; &event_setup_changed(1); if ( Irssi::window_find_name(window()) ) { Irssi::command_bind( "dm", "cmd_direct" ); Irssi::command_bind( "dm_as", "cmd_direct_as" ); Irssi::command_bind( "tweet", "cmd_tweet" ); Irssi::command_bind( "tweet_as", "cmd_tweet_as" ); Irssi::command_bind( "retweet", "cmd_retweet" ); Irssi::command_bind( "retweet_as", "cmd_retweet_as" ); Irssi::command_bind( "retweet_to", "cmd_retweet_to_window" ); Irssi::command_bind( "twitter_broadcast", "cmd_broadcast" ); Irssi::command_bind( "twitter_info", "cmd_info" ); Irssi::command_bind( "twitter_user", "cmd_user" ); Irssi::command_bind( "twitter_reply", "cmd_reply" ); Irssi::command_bind( "twitter_reply_as", "cmd_reply_as" ); Irssi::command_bind( "twitter_login", "cmd_login" ); Irssi::command_bind( "twitter_logout", "cmd_logout" ); Irssi::command_bind( "twitter_search", "cmd_search" ); Irssi::command_bind( "twitter_listinfo", "cmd_listinfo" ); Irssi::command_bind( "twitter_dms", "cmd_dms" ); Irssi::command_bind( "twitter_dms_as", "cmd_dms_as" ); Irssi::command_bind( "twitter_switch", "cmd_switch" ); Irssi::command_bind( "twitter_subscribe", "cmd_add_search" ); Irssi::command_bind( "twitter_unsubscribe", "cmd_del_search" ); Irssi::command_bind( "twitter_list_subscriptions", "cmd_list_search" ); Irssi::command_bind( "twirssi_upgrade", "cmd_upgrade" ); Irssi::command_bind( "twirssi_reload", "cmd_reload" ); Irssi::command_bind( "twirssi_oauth", "cmd_oauth" ); Irssi::command_bind( "twitter_updates", "get_updates" ); Irssi::command_bind( "twitter_add_follow_extra", "cmd_add_follow" ); Irssi::command_bind( "twitter_del_follow_extra", "cmd_del_follow" ); Irssi::command_bind( "twitter_list_follow_extra", "cmd_list_follow" ); Irssi::command_bind( "twirssi_set_channel", "cmd_set_channel" ); Irssi::command_bind( "twirssi_list_channels", "cmd_list_channels" ); Irssi::command_bind( "twirssi_set_window", "cmd_set_window" ); Irssi::command_bind( "twirssi_list_windows", "cmd_list_windows" ); Irssi::command_bind( "twirssi_wipe", "cmd_wipe" ); Irssi::command_bind( "bitlbee_away", "update_away" ); if ( $settings{use_reply_aliases} ) { Irssi::command_bind( "reply", "cmd_reply" ); Irssi::command_bind( "reply_as", "cmd_reply_as" ); } Irssi::command_bind( "twirssi_dump", sub { &debug( "twits: ", join ", ", map { "u: $_\@" . ref($twits{$_}) } keys %twits ); &debug( "selected: $user\@$defservice" ); &debug( "friends: ", Dumper \%friends ); &debug( "blocks: ", Dumper \%blocks ); &debug( "nicks: ", join ", ", sort keys %nicks ); &debug( "searches: ", join('; ', map { $state{__last_id}{$_}{__search} and "$_ : " . join(', ', keys %{ $state{__last_id}{$_}{__search} }) } keys %{ $state{__last_id} } )); &debug( "windows: ", Dumper \%{ $state{__windows} } ); &debug( "channels: ", Dumper \%{ $state{__channels} } ); &debug( "u_info ", Dumper \%{ $state{__u} } ); &debug( "id_info ", Dumper \%{ $state{__i} } ); &debug( "lists: ", Dumper \%{ $state{__lists} } ); &debug( "settings: ", Dumper \%settings ); &debug( "last poll: ", Dumper \%last_poll ); if ( open my $fh, '>', "/tmp/$IRSSI{name}.cache.txt" ) { print $fh Dumper \%tweet_cache; close $fh; ¬ice([ 'crap' ], "cache written out to /tmp/$IRSSI{name}.cache.txt"); } if ( open my $fh, '>', "$settings{dump_store}" ) { print $fh Dumper \%state; close $fh; ¬ice([ 'crap' ], "state written out to $settings{dump_store}"); } } ); Irssi::command_bind( "twirssi_version", sub { ¬ice( "$IRSSI{name} v$VERSION; " . ( $Twitter::API::VERSION ? "Twitter::API v$Twitter::API::VERSION. " : "" ) . ( $Net::Twitter::VERSION ? "Net::Twitter v$Net::Twitter::VERSION. " : "" ) . ( $Net::Identica::VERSION ? "Net::Identica v$Net::Identica::VERSION. " : "" ) . "JSON in use: " . ref(JSON::MaybeXS->new()) . ". See details at http://twirssi.com/" ); } ); Irssi::command_bind( "twitter_delete", &gen_cmd( "/twitter_delete ", "destroy_status", sub { ¬ice( ["tweet"], "Tweet deleted." ); }, sub { my ( $nick, $num ) = split /:/, lc $_[0], 2; return $state{__last_id}{ &normalize_username($nick) }{__sent} unless defined $num; return $state{__ids}{$nick}[$num]; } ) ); Irssi::command_bind( "twitter_fav", &gen_cmd( "/twitter_fav ", "create_favorite", sub { ¬ice( ["tweet"], "Tweet favorited." ); }, sub { my ( $nick, $num ) = split ':', lc $_[0], 2; return $state{__last_id}{ &normalize_username($nick) }{__sent} unless defined $num; return $state{__ids}{$nick}[$num]; } ) ); Irssi::command_bind( "twitter_unfav", &gen_cmd( "/twitter_unfav ", "destroy_favorite", sub { ¬ice( ["tweet"], "Tweet un-favorited." ); }, sub { my ( $nick, $num ) = split ':', lc $_[0], 2; return $state{__last_id}{ &normalize_username($nick) }{__sent} unless defined $num; return $state{__ids}{$nick}[$num]; } ) ); Irssi::command_bind( "twitter_follow", &gen_cmd( "/twitter_follow [-w] ", "create_friend", sub { ¬ice( ["tweet", "$user\@$defservice"], "Following $_[0]" ); $nicks{ $_[0] } = time; &cmd_user(@_); }, sub { &cmd_set_window("sender $_[0] $_[0]", $_[1], $_[2]) if $_[0] =~ s/^\s*-w\s+// and $_[0] ne ''; return $_[0]; } ) ); Irssi::command_bind( "twitter_unfollow", &gen_cmd( "/twitter_unfollow ", "destroy_friend", sub { ¬ice( ["tweet"], "Stopped following $_[0]" ); delete $nicks{ $_[0] }; } ) ); Irssi::command_bind( "twitter_device_updates", &gen_cmd( "/twitter_device_updates none|im|sms", "update_delivery_device", sub { ¬ice( ["tweet"], "Device updated to $_[0]" ); } ) ); Irssi::command_bind( "twitter_block", &gen_cmd( "/twitter_block ", "create_block", sub { ¬ice( ["tweet"], "Blocked $_[0]" ); } ) ); Irssi::command_bind( "twitter_unblock", &gen_cmd( "/twitter_unblock ", "destroy_block", sub { ¬ice( ["tweet"], "Unblock $_[0]" ); } ) ); Irssi::command_bind( "twitter_spam", &gen_cmd( "/twitter_spam ", "report_spam", sub { ¬ice( ["tweet"], "Reported $_[0] for spam" ); } ) ); %completion_types = ( 'account' => [ 'twitter_switch', ], 'tweet' => [ 'retweet', 'retweet_to', 'twitter_delete', 'twitter_fav', 'twitter_info', 'twitter_reply', 'twitter_unfav', ], 'nick' => [ 'dm', 'twitter_block', 'twitter_add_follow_extra', 'twitter_del_follow_extra', 'twitter_follow', 'twitter_spam', 'twitter_unblock', 'twitter_unfollow', 'twitter_user', 'twitter_dms', # here for twitter_dms_as ], 're_nick' => [ 'dm', 'retweet', 'tweet', ], ); push @{ $completion_types{'tweet'} }, 'reply' if $settings{use_reply_aliases}; Irssi::signal_add_last( 'complete word' => \&sig_complete ); ¬ice( " %Y<%C(%B^%C)%N TWIRSSI v%R$VERSION%N", " %C(_(\\%N http://twirssi.com/ for full docs", " %Y||%C `%N Log in with /twitter_login, send updates with /tweet" ); my $file = $settings{replies_store}; if ( $file and -r $file ) { if ( open( my $fh, '<', $file ) ) { my $json; do { local $/; $json = <$fh>; }; close $fh; eval { my $ref = decode_json($json); %state = %$ref; # fix legacy vulnerable ids for (grep !/^__\w+$/, keys %state) { $state{__ids}{$_} = $state{$_}; delete $state{$_}; } # # remove legacy broken searches (without service name) # map { /\@/ or delete $state{__searches}{$_} } keys %{$state{__searches}}; # convert legacy/broken window tags (without @service, or unnormalized) for my $type (keys %{$state{__windows}}) { next if $type eq 'search' or $type eq 'sender'; for my $tag (keys %{$state{__windows}{$type}}) { next if $tag eq 'default'; my $new_tag = &normalize_username($tag); next if -1 == index($new_tag, '@') or $new_tag eq $tag; $state{__windows}{$type}{$new_tag} = $state{__windows}{$type}{$tag}; delete $state{__windows}{$type}{$tag}; } } my $num = keys %{ $state{__indexes} }; ¬ice( sprintf "Loaded old replies from %d contact%s.", $num, ( $num == 1 ? "" : "s" ) ); &cmd_list_search; &cmd_list_follow; }; } else { &error( "Failed to load old replies from $file: $!" ); } } &read_json($settings{poll_store}, \%last_poll, "prev. poll times"); &read_json($settings{id_store}, \%tweet_cache, "cached IDs"); if ( my $provider = $settings{url_provider} ) { ¬ice("Loading WWW::Shorten::$provider..."); eval "use WWW::Shorten::$provider;"; if ($@) { &error( "Failed to load WWW::Shorten::$provider - either clear", "short_url_provider or install the CPAN module"); } } if ( @{ $settings{usernames} } ) { &cmd_login(); &ensure_updates(15) if keys %twits; } } else { Irssi::active_win() ->print( "Create a window named " . $settings{window} . " or change the value of twitter_window. Then, reload $IRSSI{name}." ); } # vim: set sts=4 expandtab: