summaryrefslogtreecommitdiffstats
path: root/scripts/twirssi.pl
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--scripts/twirssi.pl4217
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 ) {
+ &notice( ["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 ) {
+ &notice( ["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;
+ &notice( [ "dm", $target_norm ], "DM to $target failed" );
+ return;
+ }
+ &notice( [ "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) {
+ &notice( [ "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) {
+ &notice( ["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 } ) {
+ &notice( [ "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] ) {
+ &notice( [ "tweet", $username ],
+ "Can't find a tweet numbered $id from $nick to retweet!" );
+ return;
+ }
+
+ unless ( $state{__tweets}{ lc $nick }[$id] ) {
+ &notice( [ "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) {
+ &notice( [ "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;
+ }
+
+ &notice( [ "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 } ) {
+ &notice( [ "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] ) {
+ &notice( [ "tweet" ],
+ "Can't find a tweet numbered $id from $nick to retweet!" );
+ return;
+ }
+
+ unless ( $state{__tweets}{ lc $nick }[$id] ) {
+ &notice( [ "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) {
+ &notice( [ "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) {
+ &notice( ["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 ) {
+ &notice( ["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) ) {
+ &notice( [ "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)";
+ }
+ &notice( [ "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 ) {
+ &notice( ["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 } ) {
+ &notice( [ "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 ) {
+ &notice( [ "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";
+ }
+ }
+
+ &notice( [ "info" ], ",--------- $nick:$id" );
+ &notice( [ "info" ], "| nick: $nick_orig <http://twitter.com/$nick_orig>" );
+ &notice( [ "info" ], "| id: $statusid" . ($url ? " <$url>" : ''));
+ &notice( [ "info" ], "| time: " . ($timestamp
+ ? DateTime->from_epoch( epoch => $timestamp, time_zone => $local_tz)
+ : '<unknown>') );
+ &notice( [ "info" ], "| account: " . ($username ? $username : '<unknown>' ) );
+ &notice( [ "info" ], "| text: " . ($tweet ? $tweet : '<unknown>' ) );
+ &notice( [ "info" ], "| +url: " . $exp_tweet ) if $exp_tweet ne $tweet;
+
+ if ($reply_to_id and $reply_to_user) {
+ &notice( [ "info" ], "| ReplyTo: $reply_to_user:$reply_to_id" );
+ &notice( [ "info" ], "| thread: http://twitter.theinfo.org/$statusid");
+ }
+ &notice( [ "info" ], "`---------" );
+}
+
+sub cmd_reply {
+ my ( $data, $server, $win ) = @_;
+
+ $data =~ s/^\s+|\s+$//;
+ unless ($data) {
+ &notice( ["reply"], "Usage: /reply <nick[:num]> <update>" );
+ return;
+ }
+
+ ( my $id, $data ) = split ' ', $data, 2;
+ unless ( $id and $data ) {
+ &notice( ["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 ) {
+ &notice( ["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 } ) {
+ &notice( [ "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] ) {
+ &notice( [ "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]
+ }
+ )
+ ) {
+ &notice( [ "reply", $username ], "Update failed" );
+ $success = 0;
+ }
+ };
+ return unless $success;
+
+ if ($@) {
+ &notice( [ "reply", $username ],
+ "Update caused an error: $@. Aborted" );
+ return;
+ }
+
+ foreach ( $data =~ /@([-\w]+)/g ) {
+ $nicks{$_} = time;
+ }
+
+ my $away = $settings{to_away} ? &update_away($data) : 0;
+
+ &notice( [ "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) {
+ &notice("Usage: $usage_str");
+ return;
+ }
+
+ my $success = 1;
+ eval {
+ unless ( $twit->$api_name($data) ) {
+ &notice("$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) {
+ &notice("Getting list: '$list_ac$list_name'");
+ } else {
+ &notice("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} ) {
+ &notice( [ "search", $data ], "Search is already queued" );
+ return;
+ }
+ $search_once{$username}->{$data} = $settings{search_results};
+ &notice( [ "search", $data ], "Searching for '$data'" );
+ &get_updates([ 0, [
+ [ $username, { up_searches => [ $data ] } ],
+ ],
+ ]);
+ } else {
+ &notice( ["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 ) {
+ &notice( ['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;
+ }
+ &notice( [ '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} ) {
+ &notice( [ "tweet", $data ], "Switching to $data" );
+ $twit = $twits{$data};
+ if ( $data =~ /(.*)\@(.*)/ ) {
+ $user = $1;
+ $defservice = $2;
+ } else {
+ &notice( [ "tweet", $data ],
+ "Couldn't figure out what service '$data' is on" );
+ }
+ } else {
+ &notice( ["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);
+
+ &notice( [ "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 ) {
+ &notice( ["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;
+ }
+ &notice( ["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';
+ &notice(
+ [ "tweet", "$user\@$service" ],
+ "Login as $user\@$service failed: $msg"
+ );
+
+ if ( not $settings{avoid_ssl} ) {
+ &notice(
+ [ "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} ) {
+ &notice( ["tweet"], "Already following all replies by \@$data" );
+ return;
+ }
+
+ $state{__last_id}{"$user\@$defservice"}{__extras}{$data} = 1;
+ &notice( ["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};
+ &notice( ["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;
+ &notice( ["tweet"], "Following all replies as $suser: $frusers" );
+ }
+ }
+
+ unless ($found) {
+ &notice( ["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);
+ &notice( ["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) {
+ &notice( ["search"], "Usage: /twitter_subscribe [-w] <topic>" );
+ return;
+ }
+
+ if ( exists $state{__last_id}{"$user\@$defservice"}{__search}{$data} ) {
+ &notice( [ "search", $data ],
+ "Already had a subscription for '$data'" );
+ return;
+ }
+
+ $state{__last_id}{"$user\@$defservice"}{__search}{$data} = 1;
+ &notice( [ "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);
+ &notice( ["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) {
+ &notice( ["search"], "Usage: /twitter_unsubscribe <topic>" );
+ return;
+ }
+
+ unless ( exists $state{__last_id}{"$user\@$defservice"}{__search}{$data} ) {
+ &notice( [ "search", $data ], "No subscription found for '$data'" );
+ return;
+ }
+
+ delete $state{__last_id}{"$user\@$defservice"}{__search}{$data};
+ &notice( [ "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;
+ &notice( ["search"], "Search subscriptions for $suser: $topics" );
+ }
+ }
+
+ unless ($found) {
+ &notice( ["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";
+ &notice( ["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" ) {
+ &notice( ["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: $!" );
+ }
+
+ &notice( ["notice"],
+ "Download complete. Reload twirssi with /twirssi_reload" );
+}
+
+sub cmd_list_channels {
+ my ( $data, $server, $win ) = @_;
+
+ &notice("Current output channels:");
+ foreach my $type ( sort keys %{ $state{__channels} } ) {
+ &notice("$type:");
+ foreach my $tag ( sort keys %{ $state{__channels}{$type} } ) {
+ &notice(" $tag:");
+ foreach my $net_tag ( sort keys %{ $state{__channels}{$type}{$tag} } ) {
+ &notice(" $net_tag: "
+ . join ', ', @{ $state{__channels}{$type}{$tag}{$net_tag} });
+ }
+ }
+ }
+ &notice("Add new entries using /twirssi_set_channel "
+ . "[[-]type|*] [account|search_term|*] [net_tag] [channel]" );
+ &notice("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} }) {
+ &notice("No such channel setting for $type/$tag on $net_tag.");
+ return;
+ }
+ &notice("$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} }) {
+ &notice("There is already such a channel setting.");
+ return;
+
+ } else {
+ &notice("$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 ) = @_;
+
+ &notice("Current output windows:");
+ foreach my $type ( sort keys %{ $state{__windows} } ) {
+ &notice("$type:");
+ foreach my $tag ( sort keys %{ $state{__windows}{$type} } ) {
+ &notice(" $tag: $state{__windows}{$type}{$tag}");
+ }
+ }
+ &notice( "Default window for all other messages: " . $settings{window} );
+
+ &notice("Add new entries with the /twirssi_set_window "
+ . "[type] [tag] [window] command." );
+ &notice("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;
+ &notice("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' ) {
+ &notice(
+ "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}) {
+ &notice("No such window setting for $type/$tag.");
+ return;
+ }
+ &notice("$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 {
+ &notice("$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}) {
+ &notice("Wiping '$to_wipe' state.");
+ $state{$to_wipe} = {};
+ } elsif ($to_wipe eq '-f') {
+ push @surplus_nicks, keys %{ $state{__tweets} };
+ } elsif ($to_wipe eq '-A') {
+ &notice('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));
+ &notice('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}) {
+ &notice(['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}) {
+ &notice(['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';
+ &notice([$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} }) {
+ &notice(['info'], "List $list_ac$list_name is empty.");
+ } else {
+ &notice("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) {
+ &notice([ '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 {
+ &notice("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 = [];
+ }
+ &notice([ '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 ) {
+ &notice( $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 ) {
+ &notice([ '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} };
+ &notice("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);
+ &notice([ '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;
+ &notice([ 'crap' ], "cache written out to /tmp/$IRSSI{name}.cache.txt");
+ }
+ if ( open my $fh, '>', "$settings{dump_store}" ) {
+ print $fh Dumper \%state;
+ close $fh;
+ &notice([ 'crap' ], "state written out to $settings{dump_store}");
+ }
+ }
+ );
+ Irssi::command_bind(
+ "twirssi_version",
+ sub {
+ &notice(
+ "$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 { &notice( ["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 { &notice( ["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 { &notice( ["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 {
+ &notice( ["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 {
+ &notice( ["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 { &notice( ["tweet"], "Device updated to $_[0]" ); }
+ )
+ );
+ Irssi::command_bind(
+ "twitter_block",
+ &gen_cmd(
+ "/twitter_block <username>",
+ "create_block",
+ sub { &notice( ["tweet"], "Blocked $_[0]" ); }
+ )
+ );
+ Irssi::command_bind(
+ "twitter_unblock",
+ &gen_cmd(
+ "/twitter_unblock <username>",
+ "destroy_block",
+ sub { &notice( ["tweet"], "Unblock $_[0]" ); }
+ )
+ );
+ Irssi::command_bind(
+ "twitter_spam",
+ &gen_cmd(
+ "/twitter_spam <username>",
+ "report_spam",
+ sub { &notice( ["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 );
+
+ &notice(
+ " %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} };
+ &notice( 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} ) {
+ &notice("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: