diff options
| author | Daniel Baumann <daniel.baumann@progress-linux.org> | 2024-04-15 20:19:02 +0000 |
|---|---|---|
| committer | Daniel Baumann <daniel.baumann@progress-linux.org> | 2024-04-15 20:19:02 +0000 |
| commit | 03929dac2a29664878d2c971648a4fe1fb698462 (patch) | |
| tree | 02c5e2b3e006234aa29545f7a93a1ce01b291a8b /scripts/twirssi.pl | |
| parent | Initial commit. (diff) | |
| download | irssi-scripts-03929dac2a29664878d2c971648a4fe1fb698462.tar.xz irssi-scripts-03929dac2a29664878d2c971648a4fe1fb698462.zip | |
Adding upstream version 20231031.upstream/20231031upstream
Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>
Diffstat (limited to '')
| -rw-r--r-- | scripts/twirssi.pl | 4217 |
1 files changed, 4217 insertions, 0 deletions
diff --git a/scripts/twirssi.pl b/scripts/twirssi.pl new file mode 100644 index 0000000..75d8e11 --- /dev/null +++ b/scripts/twirssi.pl @@ -0,0 +1,4217 @@ +use strict; +use Irssi; +use Irssi::Irc; +use HTTP::Date; +use HTML::Entities; +use File::Temp; +use LWP::Simple; +use Data::Dumper; +use Encode; +use FileHandle; +use POSIX qw/:sys_wait_h strftime/; +use Net::Twitter qw/3.11009/; +use Twitter::API; +use JSON::MaybeXS; +use DateTime; +use DateTime::Format::Strptime; +$Data::Dumper::Indent = 1; + +use vars qw($VERSION %IRSSI); + +$VERSION = sprintf '%s', q$Version: v2.8.1$ =~ /^\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: 2019-06-29 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{__tweets} {$lc_nick}[$cache_idx] = $tweet_text + # $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' ], + [ '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 ], + + [ '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', + '%r' => '05', + '%g' => '03', + '%y' => '07', + '%b' => '02', + '%m' => '06', + '%c' => '10', + '%w' => '15', + '%K' => '14', + '%R' => '04', + '%G' => '09', + '%Y' => '08', + '%B' => '12', + '%M' => '13', + '%C' => '11', + '%W' => '00', +); + +sub cmd_direct { + my ( $data, $server, $win ) = @_; + + my ( $target, $text ) = split ' ', $data, 2; + unless ( $target and $text ) { + ¬ice( ["dm"], "Usage: /dm <nick> <message>" ); + 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 ($@) { + &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 <username> <nick> <message>" ); + 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 <nick[:num]> [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 <username> <nick[:num]> [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 <update>" ); + 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 <username> <update>" ); + 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 <nick[:num]>" ); + 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 $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 <http://twitter.com/$nick_orig>" ); + ¬ice( [ "info" ], "| id: $statusid" . ($url ? " <$url>" : '')); + ¬ice( [ "info" ], "| time: " . ($timestamp + ? DateTime->from_epoch( epoch => $timestamp, time_zone => $local_tz) + : '<unknown>') ); + ¬ice( [ "info" ], "| account: " . ($username ? $username : '<unknown>' ) ); + ¬ice( [ "info" ], "| text: " . ($tweet ? $tweet : '<unknown>' ) ); + ¬ice( [ "info" ], "| +url: " . $exp_tweet ) if $exp_tweet ne $tweet; + + if ($reply_to_id and $reply_to_user) { + ¬ice( [ "info" ], "| ReplyTo: $reply_to_user:$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 <nick[:num]> <update>" ); + return; + } + + ( my $id, $data ) = split ' ', $data, 2; + unless ( $id and $data ) { + ¬ice( ["reply"], "Usage: /reply <nick[:num]> <update>" ); + 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 <username> <nick[:num]> <update>" ); + 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 [ <user> [<list name>] ]' ); + } +} + +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 <search term>" ); + } +} + + +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 <username>' ); + 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 <username>') ); + 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 <username>[\@<service>] [<password>*]", + " *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 <pin>", + ); + + $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 <username>" ); + 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 <username>" ); + 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] <topic>" ); + 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 <topic>" ); + 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) = (-1, 1); $cursor and $page <= $max_page; $page++) { + if ($pg_type eq 'cursor') { + $fn_args->{cursor} = $cursor if $cursor > 0; + } 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_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} = &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 = &get_text( $t_reply, $obj ); + printf $fh "t:tweet id:%s ac:%s %snick:%s ts:%s %s\n", + $t_reply->{id}, $username, &get_reply_to($t_reply), + $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 = &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%snick:%s ts:%s %s\n", + $reply, $t->{id}, $username, $ign, &get_reply_to($t), $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 = &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%snick:%s ts:%s %s\n", + $t->{id}, $username, $ign, &get_reply_to($t), $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=>{}, + 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}; + my $text = decode_entities( get_full_text($t->{message_create}->{message_data}) ); + $text =~ s/[\n\r]/ /g; + + 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); + next; + } + next if &normalize_username($sender_nick) eq $username; + + printf $fh "t:dm id:%s ac:%s %snick:%s ts:%s %s\n", + $t->{id}, $username, &get_reply_to($t), $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 = &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 %snick:%s topic:%s ts:%s %s\n", + $t->{id}, $username, $ign, $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 = &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%snick:%s topic:%s ts:%s %s\n", + $t->{id}, $username, $ign, &get_reply_to($t), $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 = &get_text( $t, $obj ); + my $reply = &tweet_or_reply($obj, $t, $username, $cache, $fh); + printf $fh "t:%s id:%s ac:%s %snick:%s ts:%s %s\n", + $reply, $t->{id}, $username, &get_reply_to($t), $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 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 ) { + my $hilight_color = $irssi_to_mirc_colors{ $settings{hilight_color} }; + $line_attribs{level} |= MSGLEVEL_HILIGHT; + $line_attribs{hi_nick} = "\cC$hilight_color$meta->{nick}\cO"; + } + elsif ($settings{nick_color} eq 'rotate') { + my $c = get_nick_color($meta->{nick}); + $line_attribs{hi_nick} = "\cC$c$meta->{nick}\cO"; + } + + 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 $marker; + my $lc_nick = lc $meta->{nick}; + for (my $mark_idx = 0; + defined $state{__ids}{ $lc_nick } and $mark_idx < @{ $state{__ids}{ $lc_nick } }; + $mark_idx++) { + if ($state{__ids}{ $lc_nick }[$mark_idx] eq $meta->{id}) { + $marker = $mark_idx; + last; + } + } + 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_id reply_to_user 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 ($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 '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} + 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 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; +} + +sub write_lines { + my $lines_ref = shift; + my $is_update = shift; + my $ymd_color = $irssi_to_mirc_colors{ $settings{ymd_color} }; + my @date_now = localtime(); + my $ymd_now = sprintf('%04d-%02d-%02d', $date_now[5]+1900, $date_now[4]+1, $date_now[3]); + my $old_tf; + # &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 @print_opts = ( + $line->{level}, + "twirssi_" . $line->{type}, # theme + $ac_tag, + ); + push @print_opts, (lc $line->{topic} ne lc $win_name ? $line->{topic} . ':' : '') + if $line->{type} =~ /search/; + push @print_opts, $line->{hi_nick} if $line->{type} ne 'error' and $line->{type} ne 'deerror'; + push @print_opts, $line->{marker} if defined $line->{marker}; + + # set timestamp + if (not defined $line->{epoch}) { + Irssi::window_find_name($settings{debug_win_name})->printformat( + @print_opts, &hilight( $line->{text} ) . " \cC${ymd_color}BAD DATE\cO" + ); + 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} = "\cC$irssi_to_mirc_colors{'%b'}IGNORED\cO " . $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 = " \cC$ymd_color$ymd\cO" if $ymd_now ne $ymd; + } elsif (not defined $last_ymd{wins}{$win_name} + or $last_ymd{wins}{$win_name}->{ymd} ne $ymd) { + Irssi::window_find_name($win_name)->printformat(MSGLEVEL_PUBLIC, 'twirssi_new_day', $ymd, ''); + $last_ymd{wins}{$win_name}->{ymd} = $ymd; + } + my $ts = DateTime->from_epoch( epoch => $line->{epoch}, time_zone => $local_tz + )->strftime($settings{timestamp_format}); + if (not defined $old_tf) { + $old_tf = Irssi::settings_get_str('timestamp_format'); + } + $line->{text} = &post_process_tweet($line->{text}); + Irssi::command("^set timestamp_format $ts"); + Irssi::window_find_name($win_name)->printformat( + @print_opts, &hilight( $line->{text} ) . $ymd_suffix + ); + if ($line_want_extras) { + &write_log($line, $win_name, \@date); + &write_channels($line, \@date); + } + } + # recall timestamp format + if (defined $old_tf) { + Irssi::command("^set timestamp_format $old_tf"); + } +} + +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, 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 $to_file = shift; + + 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) { + push @logs, "Day changed to $ymd (was ".$ymd_obj->{ymd}.")" if $ymd ne ''; + $ymd_obj->{ymd} = $ymd; + } + + my $out = ''; + $out .= sprintf('%02d:%02d:%02d ', $date_ref->[2], $date_ref->[1], $date_ref->[0]) if $to_file; + if ( $line->{type} eq 'dm' ) { + $out .= 'DM @' . $line->{hi_nick} . ':'; + } elsif ( $line->{type} eq 'search' or $line->{type} eq 'search_once' ) { + $out .= '[' . ($target_name =~ /$line->{topic}/ ? '' : "$line->{topic}:") + . '@' . $line->{hi_nick} . ']'; + } elsif ( $line->{type} eq 'tweet' or $line->{type} eq 'reply' ) { + $out .= '<' . ($target_name =~ /$line->{account}/ ? '' : "$line->{account}:") + . '@' . $line->{hi_nick} . '>'; + } else { + $out .= 'ERR:'; + } + push @logs, $out . ' ' . ($to_file ? &remove_colors($line->{text}) : $line->{text}); + return @logs; +} + +sub remove_colors { + my $txt = shift; + $txt =~ s/\cC\d{2}(.*?)\cO/$1/g; + return $txt; +} + +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}; + $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)$/) { + $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; +} + +my @available_nick_colors =( + 0, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, + '0,2', '0,3', '0,5', '0,6', + '1,0', '1,3', '1,5', '1,6', '1,7', '1,10', '1,15', + '2,3', '2,7', '2,10', '2,15', + '3,2', '3,5', '3,10', + '4,2', '4,7', + '5,2', '5,3', '5,7', '5,10', '5,15', + '6,2', '6,7', '6,10', '6,15', + '8,2', '8,5', '8,6', + '9,2', '9,5', '9,6', + '10,2', '10,5', '10,6', + '11,2', '11,5', '11,6', + '12,2', '12,5', + '13,2', '13,15', + '14,2', '14,5', '14,6', + '15,2', '15,5', '15,6' +); +my %nick_colors; + +sub get_nick_color { + if ($settings{nick_color} eq 'rotate') { + my $nick = shift; + + if (!defined $nick_colors{$nick}) { + my @chars = split //, lc $nick; + my $value = 0; + foreach my $char (@chars) { + $value += ord $char; + } + $nick_colors{$nick} = $available_nick_colors[$value % @available_nick_colors]; + } + return $nick_colors{$nick}; + } else { + return $irssi_to_mirc_colors{$settings{nick_color}}; + } +} + +sub hilight { + my $text = shift; + + if ( $settings{nick_color} ) { + $text =~ s[(^|\W)\@(\w+)] { + my $c = get_nick_color($2); + qq[$1\cC$c\@$2\cO]; + }eg; + } + if ( $settings{topic_color} ) { + my $c = $settings{topic_color}; + $c = $irssi_to_mirc_colors{$c}; + $text =~ s/(^|\W)(\#|\!)([-\w]+)/$1\cC$c$2$3\cO/g if $c; + } + $text =~ s/[\n\r]/ /g; + + 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/$& \cC$irssi_to_mirc_colors{$settings{unshorten_color}}<$expanded_url{$site}{$https}{$uri}{url}>\cO/g; + } + } + } + } + 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 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}"; + } + + $text =~ s/[\n\r]/ /g; + + return $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', + '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_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 <username:id>", + "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 <username:id>", + "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 <username:id>", + "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] <username>", + "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 <username>", + "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 <username>", + "create_block", + sub { ¬ice( ["tweet"], "Blocked $_[0]" ); } + ) + ); + Irssi::command_bind( + "twitter_unblock", + &gen_cmd( + "/twitter_unblock <username>", + "destroy_block", + sub { ¬ice( ["tweet"], "Unblock $_[0]" ); } + ) + ); + Irssi::command_bind( + "twitter_spam", + &gen_cmd( + "/twitter_spam <username>", + "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: |