1use strict;
2use Irssi;
3use Irssi::Irc;
4use HTTP::Date;
5use HTML::Entities;
6use File::Temp;
7use LWP::Simple;
8use Data::Dumper;
9use Encode;
10use FileHandle;
11use POSIX qw/:sys_wait_h strftime/;
12use Net::Twitter qw/3.11009/;
13use Twitter::API;
14use JSON::MaybeXS;
15use DateTime;
16use DateTime::Format::Strptime;
17$Data::Dumper::Indent = 1;
18
19use vars qw($VERSION %IRSSI);
20
21$VERSION = sprintf '%s', q$Version: v2.8.0$ =~ /^\w+:\s+v(\S+)/;
22%IRSSI   = (
23    authors     => '@zigdon, @gedge',
24    contact     => 'gedgey@gmail.com',
25    name        => 'twirssi',
26    description => 'Send twitter updates using /tweet.  '
27      . 'Can optionally set your bitlbee /away message to same',
28    license => 'GNU GPL v2',
29    url     => 'http://twirssi.com',
30    changed => '$Date: 2018-09-21 15:00:00 +0000$',
31);
32
33my $twit;	# $twit is current logged-in Net::Twitter or Twitter::API object (usually one of %twits)
34my %twits;	# $twits{$username} = logged-in object
35my %oauth;
36my $user;	# current $account
37my $defservice; # current $service
38my $poll_event;		# timeout_add event object (regular update)
39my %last_poll;		# $last_poll{$username}{tweets|friends|blocks|lists}	= time of last update
40			#	    {__interval|__poll}			= time
41my %nicks;              # $nicks{$screen_name} = last seen/mentioned time (for sorting completions)
42my %friends;		# $friends{$username}{$nick} = $epoch_when_refreshed (rhs value used??)
43my %blocks;		# $blocks {$username}{$nick} = $epoch_when_refreshed (rhs value used??)
44my %tweet_cache;	# $tweet_cache{$tweet_id} = time of tweet (helps keep last hour of IDs, to avoid dups)
45my %state;
46		# $state{__ids}			{$lc_nick}[$cache_idx]	= $tweet_id
47		# $state{__u}			{$lc_nick}		= { id=>$user_id }
48		# $state{__i}			{$user_id}		= $lc_nick
49		# $state{__tweets}		{$lc_nick}[$cache_idx]	= $tweet_text
50		# $state{__usernames}		{$lc_nick}[$cache_idx]	= $username_that_polled_tweet
51		# $state{__reply_to_ids}	{$lc_nick}[$cache_idx]	= $polled_tweet_replies_to_this_id
52		# $state{__reply_to_users}	{$lc_nick}[$cache_idx]	= $polled_tweet_replies_to_this_user
53		# $state{__created_ats}		{$lc_nick}[$cache_idx]	= $time_of_tweet
54		# $state{__indexes}		{$lc_nick}		= $last_cache_idx_used
55		# $state{__last_id}	{$username}{timeline|reply|dm}	= $id_of_last_tweet
56		#				   {__sent}		= $id_of_last_tweet_from_act
57		#				   {__extras}{$lc_nick}	= $id_of_last_tweet (fix_replies)
58		#				   {__search}{$topic}	= $id_of_last_tweet
59		# $state{__lists}	{$username}{$list_name}		= { id => $list_id, members=>[$nick,...] }
60		# $state{__channels}	{$type}{$tag}{$net_tag}		= [ channel,... ]
61		# $state{__windows}	{$type}{$tag}			=  $window_name
62my $failstatus = 0;		# last update status:  0=ok, 1=warned, 2=failwhaled
63my $first_call = 1;
64my $child_pid;
65my %fix_replies_index;	# $fix_replies_index($username} = 0..100 idx in sort keys $state{__last_id}{$username}{__extras}
66my %search_once;
67my $update_is_running = 0;
68my %logfile;
69my %settings;
70my %last_ymd;		# $last_ymd{$chan_or_win} = $last_shown_ymd
71my @datetime_parser;
72my %completion_types = ();
73my %expanded_url = ();
74my $ua;
75my %valid_types = (
76	'window'	=> [ qw/ tweet search dm reply sender error default /],	# twirssi_set_window
77	'channel'	=> [ qw/ tweet search dm reply sender error * / ],	# twirssi_set_channel
78);
79
80my $local_tz = DateTime::TimeZone->new( name => 'local' );
81
82my @settings_defn = (
83        [ 'broadcast_users',   'twirssi_broadcast_users',   's', undef,			'list{,}' ],
84        [ 'charset',           'twirssi_charset',           's', 'utf8', ],
85        [ 'default_service',   'twirssi_default_service',   's', 'Twitter', ],
86        [ 'ignored_accounts',  'twirssi_ignored_accounts',  's', '',			'list{,},norm_user' ],
87        [ 'ignored_twits',     'twirssi_ignored_twits',     's', '',			'lc,list{,}' ],
88        [ 'ignored_tags',      'twirssi_ignored_tags',      's', '',			'lc,list{,}' ],
89        [ 'location',          'twirssi_location',          's', Irssi::get_irssi_dir . "/scripts/$IRSSI{name}.pl" ],
90        [ 'nick_color',        'twirssi_nick_color',        's', '%B', ],
91        [ 'ymd_color',         'twirssi_ymd_color',         's', '%r', ],
92        [ 'oauth_store',       'twirssi_oauth_store',       's', Irssi::get_irssi_dir . "/scripts/$IRSSI{name}.oauth" ],
93        [ 'replies_store',     'twirssi_replies_store',     's', Irssi::get_irssi_dir . "/scripts/$IRSSI{name}.json" ],
94        [ 'dump_store',        'twirssi_dump_store',        's', Irssi::get_irssi_dir . "/scripts/$IRSSI{name}.dump" ],
95        [ 'poll_store',        'twirssi_poll_store',        's', Irssi::get_irssi_dir . "/scripts/$IRSSI{name}.polls" ],
96        [ 'id_store',          'twirssi_id_store',          's', Irssi::get_irssi_dir . "/scripts/$IRSSI{name}.ids" ],
97        [ 'retweet_format',    'twirssi_retweet_format',    's', 'RT $n: "$t" ${-- $c$}' ],
98        [ 'retweeted_format',  'twirssi_retweeted_format',  's', 'RT $n: $t' ],
99        [ 'stripped_tags',     'twirssi_stripped_tags',     's', '',			'list{,}' ],
100        [ 'topic_color',       'twirssi_topic_color',       's', '%r', ],
101        [ 'timestamp_format',  'twirssi_timestamp_format',  's', '%H:%M:%S', ],
102        [ 'window_priority',   'twirssi_window_priority',   's', 'account', ],
103        [ 'upgrade_branch',    'twirssi_upgrade_branch',    's', 'master', ],
104        [ 'upgrade_dev',       'twirssi_upgrade_dev',       's', 'gedge', ],
105        [ 'bitlbee_server',    'bitlbee_server',            's', 'bitlbee' ],
106        [ 'hilight_color',     'twirssi_hilight_color',     's', '%M' ],
107        [ 'unshorten_color',   'twirssi_unshorten_color',   's', '%b' ],
108        [ 'passwords',         'twitter_passwords',         's', undef,			'list{,}' ],
109        [ 'usernames',         'twitter_usernames',         's', undef,			'list{,}' ],
110        [ 'update_usernames',  'twitter_update_usernames',  's', undef,			'list{,}' ],
111        [ 'url_provider',      'short_url_provider',        's', 'TinyURL' ],
112        [ 'url_unshorten',     'short_url_domains',         's', '',			'lc,list{ }' ],
113        [ 'url_args',          'short_url_args',            's', undef ],
114        [ 'window',            'twitter_window',            's', 'twitter' ],
115        [ 'debug_win_name',    'twirssi_debug_win_name',    's', '' ],
116        [ 'limit_user_tweets', 'twitter_user_results',      's', '20' ],
117
118        [ 'always_shorten',    'twirssi_always_shorten',    'b', 0 ],
119        [ 'rt_to_expand',      'twirssi_retweet_to_expand', 'b', 1 ],
120        [ 'avoid_ssl',         'twirssi_avoid_ssl',         'b', 0 ],
121        [ 'debug',             'twirssi_debug',             'b', 0 ],
122        [ 'notify_timeouts',   'twirssi_notify_timeouts',   'b', 1 ],
123        [ 'logging',           'twirssi_logging',           'b', 0 ],
124        [ 'mini_whale',        'twirssi_mini_whale',        'b', 0 ],
125        [ 'own_tweets',        'show_own_tweets',           'b', 1 ],
126        [ 'to_away',           'tweet_to_away',             'b', 0 ],
127        [ 'upgrade_beta',      'twirssi_upgrade_beta',      'b', 1 ],
128        [ 'use_oauth',         'twirssi_use_oauth',         'b', 1 ],
129        [ 'use_reply_aliases', 'twirssi_use_reply_aliases', 'b', 0 ],
130        [ 'window_input',      'tweet_window_input',        'b', 0 ],
131        [ 'retweet_classic',   'retweet_classic',           'b', 0 ],
132        [ 'retweet_show',      'retweet_show',              'b', 0 ],
133        [ 'force_first',       'twirssi_force_first',       'b', 0 ],
134
135        [ 'friends_poll',      'twitter_friends_poll',      'i', 600 ],
136        [ 'blocks_poll',       'twitter_blocks_poll',       'i', 900 ],
137        [ 'lists_poll',        'twitter_lists_poll',        'i', 900 ],
138        [ 'poll_interval',     'twitter_poll_interval',     'i', 300 ],
139        [ 'poll_schedule',     'twitter_poll_schedule',     's', '',			'list{,}' ],
140        [ 'search_results',    'twitter_search_results',    'i', 5 ],
141        [ 'autosearch_results','twitter_autosearch_results','i', 0 ],
142        [ 'timeout',           'twitter_timeout',           'i', 30 ],
143        [ 'track_replies',     'twirssi_track_replies',     'i', 100 ],
144        [ 'tweet_max_chars',   'twirssi_tweet_max_chars',   'i', 280 ],
145        [ 'dm_max_chars',      'twirssi_dm_max_chars',      'i', 10000 ],
146);
147
148my %meta_to_twit = (    # map file keys to twitter keys
149        'id'		=> 'id',
150        'created_at'    => 'created_at',
151        'reply_to_user'	=> 'in_reply_to_screen_name',
152        'reply_to_id'	=> 'in_reply_to_status_id',
153);
154
155my %irssi_to_mirc_colors = (
156    '%k' => '01',
157    '%r' => '05',
158    '%g' => '03',
159    '%y' => '07',
160    '%b' => '02',
161    '%m' => '06',
162    '%c' => '10',
163    '%w' => '15',
164    '%K' => '14',
165    '%R' => '04',
166    '%G' => '09',
167    '%Y' => '08',
168    '%B' => '12',
169    '%M' => '13',
170    '%C' => '11',
171    '%W' => '00',
172);
173
174sub cmd_direct {
175    my ( $data, $server, $win ) = @_;
176
177    my ( $target, $text ) = split ' ', $data, 2;
178    unless ( $target and $text ) {
179        &notice( ["dm"], "Usage: /dm <nick> <message>" );
180        return;
181    }
182
183    &cmd_direct_as( "$user $data", $server, $win );
184}
185
186sub user_to_id {
187    my $obj  = shift;
188    my $user = shift;
189    my $ctx  = shift // "u2id";
190    my $fh   = shift;
191
192    if (not defined $state{__u}{lc $user} or not defined $state{__u}{lc $user}{id}) {
193        my $r;
194        eval {
195            $r = $obj->lookup_users({screen_name=>$user, include_entities=>0});
196            if (not defined $r) {
197                &error([$ctx, $fh], "Cannot get id for user: $user" );
198                return;
199            }
200        };
201        if ($@) {
202            &error([$ctx, $fh], "Failed to get id for user: $user" );
203            return;
204        }
205        if (not defined $r->[0] or not exists $r->[0]->{id_str}) {
206            &error([$ctx, $fh], "Bad response for id for user: $user" );
207            return;
208        }
209        if (defined $fh) { printf $fh "t:uid id:%s nick:%s\n", $r->[0]->{id_str}, lc $user; }
210        $state{__u}{lc $user}{id} = $r->[0]->{id_str};
211        $state{__i}{$r->[0]->{id_str}} = lc $user;
212    }
213
214    return $state{__u}{lc $user}{id};
215}
216
217sub id_to_user {
218    my $obj  = shift;
219    my $u_id = shift;
220    my $ctx  = shift // "id2u";
221    my $fh   = shift;
222
223    if (not defined $state{__i}{$u_id}) {
224        my $r;
225        eval {
226            $r = $obj->lookup_users({user_id=>$u_id, include_entities=>0});
227            if (not defined $r) {
228                &error([$ctx, $fh], "Cannot get user for id $u_id" );
229                return;
230            }
231        };
232        if ($@) {
233            &error([$ctx, $fh], "Failed to get user for id $u_id" );
234            return;
235        }
236        if (not defined $r->[0] or not exists $r->[0]->{screen_name}) {
237            &error([$ctx, $fh], "Bad response for id for user: $u_id" );
238            return;
239        }
240        if (defined $fh) { printf $fh "t:uid id:%s nick:%s\n", $u_id, lc $r->[0]->{screen_name}; }
241        $state{__i}{$u_id} = lc $r->[0]->{screen_name};
242        $state{__u}{lc $r->[0]->{screen_name}}{id} = $u_id;
243    }
244
245    return $state{__i}{$u_id};
246}
247
248sub cmd_direct_as {
249    my ( $data, $server, $win ) = @_;
250
251    my ( $username, $target, $text ) = split ' ', $data, 3;
252    unless ( $username and $target and $text ) {
253        &notice( ["dm"], "Usage: /dm_as <username> <nick> <message>" );
254        return;
255    }
256
257    return unless $username = &valid_username($username);
258    return unless &logged_in($twits{$username});
259
260    my $target_norm = &normalize_username($target, 1);
261    my $target_id   = &user_to_id($twits{$username}, $target, "dm");
262    return unless defined $target_id;
263
264    $text = &shorten($text);
265
266    return if &too_long($text, ['dm', $target_norm]);
267
268    eval {
269        my $r = $twits{$username}->request(post => 'direct_messages/events/new', {
270            -to_json => {
271                event => {
272                    type           => 'message_create',
273                    message_create => {
274                        target       => { recipient_id => $target_id, },
275                        message_data => { text => $text, },
276                    },
277                },
278            },
279        });
280        if (not defined $r) {
281            my $error;
282            eval {
283                $error = decode_json( $twits{$username}->get_error() );
284                $error = $error->{error};
285            };
286            die "$error\n" if $error;
287            &notice( [ "dm", $target_norm ], "DM to $target failed" );
288            return;
289        }
290        &notice( [ "dm", $target_norm ], "DM sent to $target: $text" );
291        $nicks{$target} = time;
292    };
293
294    if ($@) {
295        &error( "DM caused an error: $@" );
296        return;
297    }
298}
299
300sub cmd_retweet {
301    my ( $data, $server, $win ) = @_;
302
303    $data =~ s/^\s+|\s+$//;
304    unless ($data) {
305        &notice( [ "tweet", $user ], "Usage: /retweet <nick[:num]> [comment]" );
306        return;
307    }
308
309    (my $id, $data ) = split ' ', $data, 2;
310
311    &cmd_retweet_as( "$user $id $data", $server, $win );
312}
313
314sub cmd_retweet_as {
315    my ( $data, $server, $win ) = @_;
316
317    $data =~ s/^\s+|\s+$//;
318    ( my $username, my $id, $data ) = split ' ', $data, 3;
319
320    unless ($username) {
321        &notice( ["tweet"],
322            "Usage: /retweet_as <username> <nick[:num]> [comment]" );
323        return;
324    }
325
326    return unless $username = &valid_username($username);
327
328    return unless &logged_in($twits{$username});
329
330    my $nick;
331    $id =~ s/[^\w\d\-:]+//g;
332    ( $nick, $id ) = split /:/, $id;
333    unless ( exists $state{__ids}{ lc $nick } ) {
334        &notice( [ "tweet", $username ],
335            "Can't find a tweet from $nick to retweet!" );
336        return;
337    }
338
339    $id = $state{__indexes}{lc $nick} unless defined $id;
340    unless ( $state{__ids}{ lc $nick }[$id] ) {
341        &notice( [ "tweet", $username ],
342            "Can't find a tweet numbered $id from $nick to retweet!" );
343        return;
344    }
345
346    unless ( $state{__tweets}{ lc $nick }[$id] ) {
347        &notice( [ "tweet", $username ],
348            "The text of this tweet isn't saved, sorry!" );
349        return;
350    }
351
352    my $text = &format_expand(fmt => $settings{retweet_format}, nick => $nick, data => $data,
353                 tweet => $state{__tweets}{ lc $nick }[$id]);
354
355    my $modified = $data;
356    $data = &shorten($text);
357
358    return if ($modified or $settings{retweet_classic})
359              and &too_long($data, ['tweet', $username]);
360
361    my $success = 1;
362    my $extra_info = '';
363    eval {
364        if ($modified or $settings{retweet_classic}) {
365            $success = $twits{$username}->update(
366                {
367                    status => $data,
368                    # in_reply_to_status_id => $state{__ids}{ lc $nick }[$id]
369                }
370            );
371            $extra_info = ' (classic/edited)';
372        } else {
373            $success =
374              $twits{$username}->retweet( { id => $state{__ids}{ lc $nick }[$id] } );
375            # $retweeted_id{$username}{ $state{__ids}{ lc $nick }[$id] } = 1;
376            $extra_info = ' (native)';
377        }
378    };
379    unless ($success) {
380        &notice( [ "tweet", $username ], "Update failed" );
381        return;
382    }
383
384    if ($@) {
385        &error( [ $username ], "Update caused an error: $@.  Aborted" );
386        return;
387    }
388
389    $extra_info .= ' id=' . $success->{id} if $settings{debug};
390
391    foreach ( $data =~ /@([-\w]+)/g ) {
392        $nicks{$_} = time;
393    }
394
395    &notice( [ "tweet", $username ], "Retweet of $nick:$id sent" . $extra_info );
396}
397
398
399sub format_expand {
400    my %args = @_;
401    $args{fmt} =~ s/\$n/\@$args{nick}/g;
402    if (defined $args{data} and $args{data} ne '') {
403        $args{fmt} =~ s/\$\{|\$}//g;
404        $args{fmt} =~ s/\$c/$args{data}/g;
405    } else {
406        $args{fmt} =~ s/\$\{.*?\$}//g;
407    }
408    $args{fmt} =~ s/\$t/$args{tweet}/g;
409    return $args{fmt};
410}
411
412
413sub cmd_retweet_to_window {
414    my ( $data, $server, $win ) = @_;
415
416    $data =~ s/^\s+|\s+$//;
417
418    ( my $id, $data ) = split ' ', $data, 2;
419    $id =~ s/[^\w\d\-:]+//g;
420    ( my $nick, $id ) = split ':', $id;
421    unless ( exists $state{__ids}{ lc $nick } ) {
422        &notice( [ "tweet" ],
423            "Can't find a tweet from $nick to retweet!" );
424        return;
425    }
426
427    $id = $state{__indexes}{lc $nick} unless defined $id;
428    unless ( $state{__ids}{ lc $nick }[$id] ) {
429        &notice( [ "tweet" ],
430            "Can't find a tweet numbered $id from $nick to retweet!" );
431        return;
432    }
433
434    unless ( $state{__tweets}{ lc $nick }[$id] ) {
435        &notice( [ "tweet" ],
436            "The text of this tweet isn't saved, sorry!" );
437        return;
438    }
439
440    my $target = '';
441    my $got_net = 0;
442    my $got_target = 0;
443    while (not $got_target and $data =~ s/^(\S+)\s*//) {
444        my $arg = $1;
445        if (not $got_net and lc($arg) ne '-channel' and lc($arg) ne '-nick' and $arg =~ /^-/) {
446            $got_net = 1;
447        } else {
448            if (lc($arg) eq '-channel' or lc($arg) eq '-nick') {
449                last if not $data =~ s/^(\S+)\s*//;
450                $arg .= " $1";
451            }
452            $got_target = 1;
453        }
454        $target .= ($target ne '' ? ' ' : '') . $arg;
455    }
456    if (not $got_target) {
457        &notice( [ "tweet" ], "Missing target." );
458        return;
459    }
460
461    my $text = &format_expand(fmt => $settings{retweet_format}, nick => $nick, data => $data,
462                 tweet => &post_process_tweet($state{__tweets}{ lc $nick }[$id], not $settings{rt_to_expand}));
463
464    Irssi::command("msg $target $text");
465
466    foreach ( $text =~ /@([-\w]+)/g ) {
467        $nicks{$_} = time;
468    }
469
470    &debug("Retweet of $nick:$id sent to $target");
471}
472
473sub cmd_reload {
474    if ($settings{force_first} and $settings{poll_store}) {
475        &save_state();
476        &save_polls();
477    }
478    Irssi::command("script load $IRSSI{name}");
479}
480
481sub cmd_tweet {
482    my ( $data, $server, $win ) = @_;
483
484    $data =~ s/^\s+|\s+$//;
485    unless ($data) {
486        &notice( ["tweet"], "Usage: /tweet <update>" );
487        return;
488    }
489
490    &cmd_tweet_as( "$user\@$defservice $data", $server, $win );
491}
492
493sub cmd_tweet_as {
494    my ( $data, $server, $win ) = @_;
495
496    $data =~ s/^\s+|\s+$//;
497    $data =~ s/\s\s+/ /g;
498    ( my $username, $data ) = split ' ', $data, 2;
499
500    unless ( $username and $data ) {
501        &notice( ["tweet"], "Usage: /tweet_as <username> <update>" );
502        return;
503    }
504
505    return unless $username = &valid_username($username);
506
507    return unless &logged_in($twits{$username});
508
509    $data = &shorten($data);
510
511    return if &too_long($data, ['tweet', $username]);
512
513    my $success = 1;
514    my $res;
515    eval {
516        unless ( $res = $twits{$username}->update($data) ) {
517            &notice( [ "tweet", $username ], "Update failed" );
518            $success = 0;
519        }
520    };
521    return unless $success;
522
523    if ($@) {
524        &error( [ $username ], "Update caused an error: $@.  Aborted." );
525        return;
526    }
527
528    foreach ( $data =~ /@([-\w]+)/g ) {
529        $nicks{$_} = time;
530    }
531
532    # TODO: What's the official definition of a Hashtag? Let's use #[-\w]+ like above for now.
533    if ( $settings{autosearch_results} > 0 and $data =~ /#[-\w]+/ ) {
534	my @topics;
535	while ( $data =~ /(#[-\w]+)/g ) {
536	    push @topics, $1;
537	    $search_once{$username}->{$1} = $settings{autosearch_results};
538	}
539	&get_updates([ 0, [
540			   [ $username, { up_searches => [ @topics ] } ],
541		       ],
542		     ]);
543    }
544
545    $state{__last_id}{$username}{__sent} = $res->{id};
546    my $id_info = ' id=' . $res->{id} if $settings{debug};
547
548    my $away_info = '';
549    if ( $username eq "$user\@$defservice"
550          and $settings{to_away}
551          and &update_away($data) ) {
552        $away_info = " (and away msg set)";
553    }
554    &notice( [ "tweet", $username ], "Update sent" . $away_info . $id_info );
555}
556
557sub cmd_broadcast {
558    my ( $data, $server, $win ) = @_;
559
560    my @bcast_users = @{ $settings{broadcast_users} };
561    @bcast_users = keys %twits if not @bcast_users;
562
563    foreach my $buser (@bcast_users) {
564        &cmd_tweet_as( "$buser $data", $server, $win );
565    }
566}
567
568sub cmd_info {
569    my ( $data, $server, $win ) = @_;
570
571    $data =~ s/^\s+|\s+$//g;
572    unless ( $data ) {
573        &notice( ["info"], "Usage: /twitter_info <nick[:num]>" );
574        return;
575    }
576
577    $data =~ s/[^\w\-:]+//g;
578    my ( $nick_orig, $id ) = split /:/, $data;
579    my $nick = lc $nick_orig;
580    unless ( exists $state{__ids}{ $nick } ) {
581        &notice( [ "info" ],
582            "Can't find any tweet from $nick_orig!" );
583        return;
584    }
585
586    $id = $state{__indexes}{$nick} unless defined $id;
587    my $statusid = $state{__ids}{$nick}[$id];
588    unless ( $statusid ) {
589        &notice( [ "info" ],
590            "Can't find a tweet numbered $id from $nick_orig!" );
591        return;
592    }
593
594    my $username      = $state{__usernames}{$nick}[$id];
595    my $timestamp     = $state{__created_ats}{$nick}[$id];
596    my $tweet         = $state{__tweets}{$nick}[$id];
597    my $reply_to_id   = $state{__reply_to_ids}{$nick}[$id];
598    my $reply_to_user = $state{__reply_to_users}{$nick}[$id];
599    my $exp_tweet     = $tweet;
600    if ($tweet) {
601        $tweet        = &post_process_tweet($tweet, 1);
602        $exp_tweet    = &post_process_tweet($exp_tweet);
603    }
604
605    my $url = '';
606    if ( defined $username ) {
607        if ( $username =~ /\@Twitter/ ) {
608            $url = "http://twitter.com/$nick/statuses/$statusid";
609        } elsif ( $username =~ /\@Identica/ ) {
610            $url = "http://identi.ca/notice/$statusid";
611        }
612    }
613
614    &notice( [ "info" ], ",--------- $nick:$id" );
615    &notice( [ "info" ], "| nick:    $nick_orig <http://twitter.com/$nick_orig>" );
616    &notice( [ "info" ], "| id:      $statusid" . ($url ? " <$url>" : ''));
617    &notice( [ "info" ], "| time:    " . ($timestamp
618                             ? DateTime->from_epoch( epoch => $timestamp, time_zone => $local_tz)
619                             : '<unknown>') );
620    &notice( [ "info" ], "| account: " . ($username ? $username : '<unknown>' ) );
621    &notice( [ "info" ], "| text:    " . ($tweet ? $tweet : '<unknown>' ) );
622    &notice( [ "info" ], "|    +url: " . $exp_tweet ) if $exp_tweet ne $tweet;
623
624    if ($reply_to_id and $reply_to_user) {
625       &notice( [ "info" ], "| ReplyTo: $reply_to_user:$reply_to_id" );
626       &notice( [ "info" ], "| thread:  http://twitter.theinfo.org/$statusid");
627    }
628    &notice( [ "info" ], "`---------" );
629}
630
631sub cmd_reply {
632    my ( $data, $server, $win ) = @_;
633
634    $data =~ s/^\s+|\s+$//;
635    unless ($data) {
636        &notice( ["reply"], "Usage: /reply <nick[:num]> <update>" );
637        return;
638    }
639
640    ( my $id, $data ) = split ' ', $data, 2;
641    unless ( $id and $data ) {
642        &notice( ["reply"], "Usage: /reply <nick[:num]> <update>" );
643        return;
644    }
645
646    &cmd_reply_as( "$user $id $data", $server, $win );
647}
648
649sub cmd_reply_as {
650    my ( $data, $server, $win ) = @_;
651
652    $data =~ s/^\s+|\s+$//;
653    ( my $username, my $id, $data ) = split ' ', $data, 3;
654
655    unless ( $username and $data ) {
656        &notice( ["reply"],
657            "Usage: /reply_as <username> <nick[:num]> <update>" );
658        return;
659    }
660
661    return unless $username = &valid_username($username);
662
663    return unless &logged_in($twits{$username});
664
665    my $nick;
666    $id =~ s/[^\w\d\-:]+//g;
667    ( $nick, $id ) = split /:/, $id;
668    unless ( exists $state{__ids}{ lc $nick } ) {
669        &notice( [ "reply", $username ],
670            "Can't find a tweet from $nick to reply to!" );
671        return;
672    }
673
674    $id = $state{__indexes}{lc $nick} unless defined $id;
675    unless ( $state{__ids}{ lc $nick }[$id] ) {
676        &notice( [ "reply", $username ],
677            "Can't find a tweet numbered $id from $nick to reply to!" );
678        return;
679    }
680
681    $data = "\@$nick $data";
682    $data = &shorten($data);
683
684    return if &too_long($data, ['reply', $username]);
685
686    my $success = 1;
687    eval {
688        unless (
689            $twits{$username}->update(
690                {
691                    status                => $data,
692                    in_reply_to_status_id => $state{__ids}{ lc $nick }[$id]
693                }
694            )
695          ) {
696            &notice( [ "reply", $username ], "Update failed" );
697            $success = 0;
698        }
699    };
700    return unless $success;
701
702    if ($@) {
703        &notice( [ "reply", $username ],
704            "Update caused an error: $@.  Aborted" );
705        return;
706    }
707
708    foreach ( $data =~ /@([-\w]+)/g ) {
709        $nicks{$_} = time;
710    }
711
712    my $away = $settings{to_away} ? &update_away($data) : 0;
713
714    &notice( [ "reply", $username ],
715        "Update sent" . ( $away ? " (and away msg set)" : "" ) );
716}
717
718sub gen_cmd {
719    my ( $usage_str, $api_name, $post_ref, $data_ref ) = @_;
720
721    return sub {
722        my ( $data, $server, $win ) = @_;
723
724        return unless &logged_in($twit);
725
726        if ($data_ref) {
727            $data = $data_ref->($data);
728        }
729
730        $data =~ s/^\s+|\s+$//;
731        unless ($data) {
732            &notice("Usage: $usage_str");
733            return;
734        }
735
736        my $success = 1;
737        eval {
738            unless ( $twit->$api_name($data) ) {
739                &notice("$api_name failed");
740                $success = 0;
741            }
742        };
743        return unless $success;
744
745        if ($@) {
746            &error("$api_name caused an error.  Aborted: $@");
747            return;
748        }
749
750        &$post_ref($data, $server, $win) if $post_ref;
751      }
752}
753
754sub cmd_listinfo {
755    my ( $data, $server, $win ) = @_;
756
757    $data =~ s/^\s+|\s+$//g;
758    if ( length $data > 0 ) {
759        my ($list_user, $list_name) = split(' ', lc $data, 2);
760        my $list_account = &normalize_username($list_user, 1);
761        my $list_ac = ($list_account eq "$user\@$defservice" ? '' : "$list_account/");
762        if (defined $list_name) {
763            &notice("Getting list: '$list_ac$list_name'");
764        } else {
765            &notice("Getting all lists for '$list_account'");
766        }
767        &get_updates([ 0, [
768                                [ "$user\@$defservice", { up_lists => [ $list_user, $list_name ] } ],
769                        ],
770        ]);
771
772    } else {
773        &error( 'Usage: /twitter_listinfo [ <user> [<list name>] ]' );
774    }
775}
776
777sub cmd_search {
778    my ( $data, $server, $win ) = @_;
779
780    $data =~ s/^\s+|\s+$//g;
781    if ( length $data > 0 ) {
782        my $username = &normalize_username($user);
783        if ( exists $search_once{$username}->{$data} ) {
784            &notice( [ "search", $data ], "Search is already queued" );
785            return;
786        }
787        $search_once{$username}->{$data} = $settings{search_results};
788        &notice( [ "search", $data ], "Searching for '$data'" );
789        &get_updates([ 0, [
790                                [ $username, { up_searches => [ $data ] } ],
791                        ],
792        ]);
793    } else {
794        &notice( ["search"], "Usage: /twitter_search <search term>" );
795    }
796}
797
798
799sub cmd_dms_as {
800    my ( $data, $server, $win ) = @_;
801
802    $data =~ s/^\s+|\s+$//g;
803    ( my $username, $data ) = split ' ', $data, 2;
804    unless ( $username ) {
805        &notice( ['dm'], 'Usage: /twitter_dms_as <username>' );
806        return;
807    }
808    return unless $username = &valid_username($username);
809    return unless &logged_in($twits{$username});
810
811    if ( length $data > 0 ) {
812        &error( 'Usage: /' .  ($username eq "$user\@$defservice"
813                                ? 'twitter_dms' : 'twitter_dms_as <username>') );
814        return;
815    }
816    &notice( [ 'dm' ], 'Fetching direct messages' );
817    &get_updates([ 0, [
818                          [ $username, { up_dms => 1 } ],
819                      ],
820    ]);
821}
822
823
824sub cmd_dms {
825    my ( $data, $server, $win ) = @_;
826    &cmd_dms_as("$user $data", $server, $win);
827}
828
829sub cmd_switch {
830    my ( $data, $server, $win ) = @_;
831
832    $data =~ s/^\s+|\s+$//g;
833    $data = &normalize_username($data);
834    if ( exists $twits{$data} ) {
835        &notice( [ "tweet", $data ], "Switching to $data" );
836        $twit = $twits{$data};
837        if ( $data =~ /(.*)\@(.*)/ ) {
838            $user       = $1;
839            $defservice = $2;
840        } else {
841            &notice( [ "tweet", $data ],
842                "Couldn't figure out what service '$data' is on" );
843        }
844    } else {
845        &notice( ["tweet"], "Unknown user $data" );
846    }
847}
848
849sub cmd_logout {
850    my ( $data, $server, $win ) = @_;
851
852    $data =~ s/^\s+|\s+$//g;
853    $data = $user unless $data;
854    return unless $data = &valid_username($data);
855
856    &notice( [ "tweet", $data ], "Logging out $data..." );
857    eval { $twits{$data}->end_session(); };
858    delete $twits{$data};
859    delete $last_poll{$data};
860    undef $twit;
861    if ( keys %twits ) {
862        &cmd_switch( ( keys %twits )[0], $server, $win );
863    } else {
864        Irssi::timeout_remove($poll_event) if $poll_event;
865        undef $poll_event;
866    }
867}
868
869sub cmd_login {
870    my ( $data, $server, $win ) = @_;
871    my $username;
872    my $pass;
873    &debug("logging in: $data");
874    if ($data) {
875        ( $username, $pass ) = split ' ', $data, 2;
876        unless ( $settings{use_oauth} or $pass ) {
877            &notice( ["tweet"],
878                "usage: /twitter_login <username>[\@<service>] <password>" );
879            return;
880        }
881        &debug("%G$username%n manual data login");
882
883    } elsif ( $settings{use_oauth} and @{ $settings{usernames} } ) {
884        &debug("oauth autouser login @{ $settings{usernames} }" );
885        %nicks = ();
886        my $some_success = 0;
887        foreach my $user ( @{ $settings{usernames} } ) {
888            $some_success = &cmd_login($user);
889        }
890        return $some_success;
891
892    } elsif ( @{ $settings{usernames} } and @{ $settings{passwords} } ) {
893        &debug("autouser login");
894
895        if ( @{ $settings{usernames} } != @{ $settings{passwords} } ) {
896            &error( "Number of usernames doesn't match "
897                  . "the number of passwords - auto-login failed" );
898            return;
899        } else {
900            %nicks = ();
901            my $some_success = 0;
902            for (my $i = 0;  $i < @{ $settings{usernames} };  $i++) {
903                $some_success ||= &cmd_login("$settings{usernames}->[$i] $settings{passwords}->[$i]");
904            }
905            return $some_success;
906        }
907
908    } else {
909        &error( "/twitter_login requires either a username/password "
910              . "or twitter_usernames and twitter_passwords to be set. "
911              . "Note that if twirssi_use_oauth is true, passwords are "
912              . "not required" );
913        return;
914    }
915
916    $username = &normalize_username($username, 1);
917    ( $user, $defservice ) = split('@', $username, 2);
918
919    $state{__lists}{$username} = {};
920    $blocks{$username} = {};
921    $friends{$username} = {};
922
923    if ( $defservice eq 'Twitter' and $settings{use_oauth} ) {
924        &debug("%G$username%n Attempting OAuth");
925        eval {
926            if ( $defservice eq 'Identica' ) {
927                $twit = Net::Twitter->new(
928                    identica => 1,
929                    traits   => [ 'API::REST', 'API::Search' ],
930                    source   => "twirssi",	# XXX
931                    ssl      => !$settings{avoid_ssl},
932                );
933            } else {
934                $twit = Twitter::API->new_with_traits(
935                    traits => [ qw/ Migration ApiMethods RetryOnError / ],
936                    (
937                        grep tr/a-zA-Z/n-za-mN-ZA-M/, map $_,
938                        pbafhzre_xrl => 'OMINiOzn4TkqvEjKVioaj',
939                        pbafhzre_frperg =>
940                          '0G5xnujYlo34ipvTMftxN9yfwgTPD05ikIR2NCKZ',
941                    ),
942                    source => "twirssi",	# XXX
943                    ssl    => !$settings{avoid_ssl},
944                );
945            }
946        };
947
948        if ($@) {
949            &error( "Error when creating object:  $@" );
950        }
951
952        if ($twit) {
953            if ( open( my $oa_fh, '<', $settings{oauth_store} ) ) {
954                while (<$oa_fh>) {
955                    chomp;
956                    next unless /^$username (\S+) (\S+)/i;
957                    &debug("%G$username%n Trying cached oauth creds");
958                    $twit->access_token($1);
959                    $twit->access_token_secret($2);
960                    last;
961                }
962                close $oa_fh;
963            }
964
965            # leave undefined if authorized
966            my $authorize_url;
967            if ( ref($twit) eq 'Twitter::API'
968                       and not ($twit->has_access_token and $twit->has_access_token_secret ) ) {
969                eval { $authorize_url = $twit->oauth_authorization_url({ oauth_token => $twit->get_access_token }); };
970                if ($@) {
971                    &error( "Failed to get oauth_authorization_url: $@" );
972                    return;
973                }
974            }
975            elsif ( $twit->can('authorized') and not $twit->authorized ) {
976                eval { $authorize_url = $twit->get_authorization_url; };
977                if ($@) {
978                    &error( "Failed to get OAuth authorization_url: $@" );
979                    return;
980                }
981            }
982
983            if ( $authorize_url ) {
984                &error( "$user: $IRSSI{name} not authorized to access $defservice.",
985                    "Please authorize at the following url, then enter the PIN",
986                    "supplied with /twirssi_oauth $username <pin>",
987                    $authorize_url
988                );
989
990                $oauth{pending}{$username} = $twit;
991                return;
992            }
993        }
994    } else {
995        $twit = Net::Twitter->new(
996            $defservice eq 'Identica' ? ( identica => 1 ) : (),
997            username => $user,
998            password => $pass,
999            source   => "twirssi",	# XXX
1000            ssl      => $settings{avoid_ssl},
1001        );
1002    }
1003
1004    unless ($twit) {
1005        &error( "Failed to create object!  Aborting." );
1006        return;
1007    }
1008
1009    return &verify_twitter_object( $server, $win, $user, $defservice, $twit );
1010}
1011
1012sub cmd_oauth {
1013    my ( $data, $server, $win ) = @_;
1014    my ( $key, $pin ) = split ' ', $data;
1015    my ( $user, $service );
1016    $key = &normalize_username($key);
1017    if ( $key =~ /^(.*)@(Twitter|Identica)$/ ) {
1018        ( $user, $service ) = ( $1, $2 );
1019    }
1020    $pin =~ s/\D//g;
1021    &debug("Applying pin to $key");
1022
1023    unless ( exists $oauth{pending}{$key} ) {
1024        &error( "There isn't a pending oauth request for $key. "
1025              . "Try /twitter_login first" );
1026        return;
1027    }
1028
1029    my $twit = $oauth{pending}{$key};
1030    my ( $access_token, $access_token_secret );
1031    eval {
1032        ( $access_token, $access_token_secret ) =
1033          $twit->request_access_token( verifier => $pin );
1034    };
1035
1036    if ($@) {
1037        &error( "Invalid pin, try again: $@" );
1038        return;
1039    }
1040
1041    delete $oauth{pending}{$key};
1042
1043    my $store_file = $settings{oauth_store};
1044    if ($store_file) {
1045        my @store;
1046        if ( open( my $oa_fh, '<', $store_file ) ) {
1047            while (<$oa_fh>) {
1048                chomp;
1049                next if /$key/i;
1050                push @store, $_;
1051            }
1052            close $oa_fh;
1053
1054        }
1055
1056        push @store, "$key $access_token $access_token_secret";
1057
1058        if ( open( my $oa_fh, '>', "$store_file.new" ) ) {
1059            print $oa_fh "$_\n" foreach @store;
1060            close $oa_fh;
1061            rename "$store_file.new", $store_file
1062              or &error( "Failed to rename $store_file.new: $!" );
1063        } else {
1064            &error( "Failed to write $store_file.new: $!" );
1065        }
1066    } else {
1067        &error( "No persistant storage set for OAuth.  "
1068              . "Please /set twirssi_oauth_store to a writable filename." );
1069    }
1070
1071    return &verify_twitter_object( $server, $win, $user, $service, $twit );
1072}
1073
1074sub rate_limited {
1075    my $obj      = shift;
1076    my $username = shift;
1077    my $fh       = shift;
1078
1079    my $rate_limit;
1080    eval {
1081        $rate_limit = $obj->rate_limit_status();
1082    };
1083    my $res = 0;
1084    if ( $rate_limit and $rate_limit->{resources} ) {
1085        for my $resource (keys %{ $rate_limit->{resources} }) {
1086            for my $uri (keys %{ $rate_limit->{resources}->{$resource} }) {
1087                if ( $rate_limit->{resources}->{$resource}->{$uri}->{remaining} < 1 ) {
1088                    &error([$username, $fh],
1089                        "Rate limit exceeded for $resource ($uri), try again after " .
1090			localtime $rate_limit->{resources}->{$resource}->{$uri}->{reset} );
1091                    $res = 1;
1092                }
1093            }
1094        }
1095    }
1096    return $res;
1097}
1098
1099sub verify_twitter_object {
1100    my ( $server, $win, $user, $service, $twit ) = @_;
1101
1102    if ( my $timeout = $settings{timeout} ) {
1103        if ( $twit->can('user_agent') ) {
1104            $twit->user_agent->timeout($timeout);
1105        } elsif ( $twit->can('ua') ) {
1106            $twit->ua->timeout($timeout);
1107        } else {
1108            $timeout = undef;
1109        }
1110        &notice( ["tweet", "$user\@$service"],
1111                 "Twitter timeout for $user\@$service set to $timeout" ) if defined $timeout;
1112    }
1113
1114    my $verified = 0;
1115    eval { $verified = $twit->verify_credentials(); };
1116
1117    if ( $@ or not $verified ) {
1118        my $msg = $@ // 'Not verified';
1119        &notice(
1120            [ "tweet", "$user\@$service" ],
1121            "Login as $user\@$service failed: $msg"
1122        );
1123
1124        if ( not $settings{avoid_ssl} ) {
1125            &notice(
1126                [ "tweet", "$user\@$service" ],
1127                "It's possible you're missing one of the modules required for "
1128                  . "SSL logins.  Try setting twirssi_avoid_ssl to on.  See "
1129                  . "http://cpansearch.perl.org/src/GAAS/libwww-perl-5.831/README.SSL "
1130                  . "for the detailed requirements."
1131            );
1132        }
1133
1134        $twit = undef;
1135        if ( keys %twits ) {
1136            &cmd_switch( ( keys %twits )[0], $server, $win );
1137        }
1138        return;
1139    }
1140
1141    if (&rate_limited($twit, "$user\@$service")) {
1142        $twit = undef;
1143        return;
1144    }
1145
1146    &debug("%G$user\@$service%n saving object");
1147    $twits{"$user\@$service"} = $twit;
1148
1149    # &get_updates([ 1, [ "$user\@$service", {} ], ]);
1150    &ensure_updates();
1151
1152    foreach my $scr_name (keys %{ $friends{"$user\@$service"} }) {
1153        $nicks{$scr_name} = $friends{"$user\@$service"}{$scr_name};
1154    }
1155    $nicks{$user} = 0;
1156    return 1;
1157}
1158
1159sub cmd_add_follow {
1160    my ( $data, $server, $win ) = @_;
1161
1162    unless ($data) {
1163        &error( "Usage: /twitter_add_follow_extra <username>" );
1164        return;
1165    }
1166
1167    $data =~ s/^\s+|\s+$//g;
1168    $data =~ s/^\@//;
1169    $data = lc $data;
1170
1171    if ( exists $state{__last_id}{"$user\@$defservice"}{__extras}{$data} ) {
1172        &notice( ["tweet"], "Already following all replies by \@$data" );
1173        return;
1174    }
1175
1176    $state{__last_id}{"$user\@$defservice"}{__extras}{$data} = 1;
1177    &notice( ["tweet"], "Will now follow all replies by \@$data" );
1178}
1179
1180sub cmd_del_follow {
1181    my ( $data, $server, $win ) = @_;
1182
1183    unless ($data) {
1184        &error( "Usage: /twitter_del_follow_extra <username>" );
1185        return;
1186    }
1187
1188    $data =~ s/^\s+|\s+$//g;
1189    $data =~ s/^\@//;
1190    $data = lc $data;
1191
1192    unless ( exists $state{__last_id}{"$user\@$defservice"}{__extras}{$data} ) {
1193        &error( "Wasn't following all replies by \@$data" );
1194        return;
1195    }
1196
1197    delete $state{__last_id}{"$user\@$defservice"}{__extras}{$data};
1198    &notice( ["tweet"], "Will no longer follow all replies by \@$data" );
1199}
1200
1201sub cmd_list_follow {
1202    my ( $data, $server, $win ) = @_;
1203
1204    my $found = 0;
1205    foreach my $suser ( sort keys %{ $state{__last_id} } ) {
1206        next unless exists $state{__last_id}{$suser}{__extras};
1207        my $frusers = join ', ', sort keys %{ $state{__last_id}{$suser}{__extras} };
1208        if ($frusers) {
1209            $found = 1;
1210            &notice( ["tweet"], "Following all replies as $suser: $frusers" );
1211        }
1212    }
1213
1214    unless ($found) {
1215        &notice( ["tweet"], "Not following all replies by anyone" );
1216    }
1217}
1218
1219sub cmd_add_search {
1220    my ( $data, $server, $win ) = @_;
1221
1222    unless ( $twit and $twit->can('search') ) {
1223        my $ref_type = ref($twit);
1224        &notice( ["search"],
1225                "ERROR: Your version of $ref_type (" . $ref_type->VERSION . ") "
1226              . "doesn't support searches." );
1227        return;
1228    }
1229
1230    my $want_win = 1 if $data =~ s/^\s*-w\s+//;
1231
1232    $data =~ s/^\s+|\s+$//g;
1233    $data = lc $data;
1234
1235    unless ($data) {
1236        &notice( ["search"], "Usage: /twitter_subscribe [-w] <topic>" );
1237        return;
1238    }
1239
1240    if ( exists $state{__last_id}{"$user\@$defservice"}{__search}{$data} ) {
1241        &notice( [ "search", $data ],
1242            "Already had a subscription for '$data'" );
1243        return;
1244    }
1245
1246    $state{__last_id}{"$user\@$defservice"}{__search}{$data} = 1;
1247    &notice( [ "search", $data ], "Added subscription for '$data'" );
1248    if ($want_win) {
1249        my $win_name = $data;
1250        $win_name =~ tr/ /+/;
1251        &cmd_set_window("search $data $win_name", $server, $win);
1252    }
1253}
1254
1255sub cmd_del_search {
1256    my ( $data, $server, $win ) = @_;
1257
1258    unless ( $twit and $twit->can('search') ) {
1259        my $ref_type = ref($twit);
1260        &notice( ["search"],
1261                "ERROR: Your version of $ref_type (" . $ref_type->VERSION . ") "
1262              . "doesn't support searches." );
1263        return;
1264    }
1265    $data =~ s/^\s+|\s+$//g;
1266    $data = lc $data;
1267
1268    unless ($data) {
1269        &notice( ["search"], "Usage: /twitter_unsubscribe <topic>" );
1270        return;
1271    }
1272
1273    unless ( exists $state{__last_id}{"$user\@$defservice"}{__search}{$data} ) {
1274        &notice( [ "search", $data ], "No subscription found for '$data'" );
1275        return;
1276    }
1277
1278    delete $state{__last_id}{"$user\@$defservice"}{__search}{$data};
1279    &notice( [ "search", $data ], "Removed subscription for '$data'" );
1280}
1281
1282sub cmd_list_search {
1283    my ( $data, $server, $win ) = @_;
1284
1285    my $found = 0;
1286    foreach my $suser ( sort keys %{ $state{__last_id} } ) {
1287        my $topics = '';
1288        foreach my $topic ( sort keys %{ $state{__last_id}{$suser}{__search} } ) {
1289            $topics .= ($topics ne '' ? ', ' : '') . "'$topic'";
1290        }
1291        if ($topics ne '') {
1292            $found = 1;
1293            &notice( ["search"], "Search subscriptions for $suser: $topics" );
1294        }
1295    }
1296
1297    unless ($found) {
1298        &notice( ["search"], "No search subscriptions set up" );
1299    }
1300}
1301
1302sub cmd_upgrade {
1303    my ( $data, $server, $win ) = @_;
1304
1305    my $loc = $settings{location};
1306    unless ( -w $loc ) {
1307        &error( "$loc isn't writable, can't upgrade."
1308              . "  Perhaps you need to /set twirssi_location?" );
1309        return;
1310    }
1311
1312    my $URL = "https://raw.githubusercontent.com/"
1313                . ( $settings{upgrade_beta}
1314                        ? "$settings{upgrade_dev}/twirssi/$settings{upgrade_branch}"
1315                        : "$settings{upgrade_dev}/twirssi/master"
1316                ) . "/twirssi.pl";
1317    &notice( ["notice"], "Downloading twirssi from $URL" );
1318    my $new_twirssi = get( $URL );
1319
1320    my $new_md5;
1321    unless ( $data or $settings{upgrade_beta} ) {
1322        eval " use Digest::MD5; ";
1323
1324        if ($@) {
1325            &error( "Failed to load Digest::MD5."
1326                  . "  Try '/twirssi_upgrade nomd5' to skip MD5 verification" );
1327            return;
1328        }
1329
1330        $new_md5 = Digest::MD5::md5_hex($new_twirssi);
1331
1332        my $fh;
1333        unless ( open( $fh, '<', $loc ) ) {
1334            &error( "Failed to read $loc."
1335                  . "  Check that /set twirssi_location is set to the correct location."
1336            );
1337            return;
1338        }
1339
1340        my $cur_md5 = Digest::MD5::md5_hex(<$fh>);
1341        close $fh;
1342
1343        if ( $cur_md5 eq $new_md5 ) {
1344            &error( "Current twirssi seems to be up to date." );
1345            return;
1346        }
1347    }
1348
1349    open my $fh, '>', "$loc.upgrade"
1350        or return &error("Failed to write upgrade to $loc.upgrade $!");
1351    print $fh $new_twirssi;
1352    close $fh;
1353
1354    unless ( -s "$loc.upgrade" ) {
1355        &error( "Failed to save $loc.upgrade."
1356              . "  Check that /set twirssi_location is set to the correct location."
1357        );
1358        return;
1359    }
1360
1361    rename $loc, "$loc.backup"
1362      or &error( "Failed to back up $loc: $!.  Aborting" )
1363      and return;
1364    rename "$loc.upgrade", $loc
1365      or &error( "Failed to rename $loc.upgrade: $!.  Aborting" )
1366      and return;
1367
1368    my ( $dir, $file ) = ( $loc =~ m{(.*)/([^/]+)$} );
1369    if ( -e "$dir/autorun/$file" ) {
1370        &notice( ["notice"], "Updating $dir/autorun/$file" );
1371        unlink "$dir/autorun/$file"
1372          or
1373          &error( "Failed to remove old $file from autorun: $!" );
1374        symlink "../$file", "$dir/autorun/$file"
1375          or &error( "Failed to create symlink in autorun directory: $!" );
1376    }
1377
1378    &notice( ["notice"],
1379        "Download complete.  Reload twirssi with /twirssi_reload" );
1380}
1381
1382sub cmd_list_channels {
1383    my ( $data, $server, $win ) = @_;
1384
1385    &notice("Current output channels:");
1386    foreach my $type ( sort keys %{ $state{__channels} } ) {
1387        &notice("$type:");
1388        foreach my $tag ( sort keys %{ $state{__channels}{$type} } ) {
1389            &notice("  $tag:");
1390            foreach my $net_tag ( sort keys %{ $state{__channels}{$type}{$tag} } ) {
1391                &notice("    $net_tag: "
1392                        . join ', ', @{ $state{__channels}{$type}{$tag}{$net_tag} });
1393            }
1394        }
1395    }
1396    &notice("Add new entries using /twirssi_set_channel "
1397          . "[[-]type|*] [account|search_term|*] [net_tag] [channel]" );
1398    &notice("Type can be one of: tweet, reply, dm, search, sender, error.",
1399                "A '*' for type/tag indicates wild"
1400                    . "  (if type is wild, ensure account qualified: [user]\@[service]).",
1401                "Remove settings by negating type, e.g. '-tweet'.");
1402}
1403
1404sub cmd_set_channel {
1405    my ( $data, $server, $win ) = @_;
1406
1407    my @words = split ' ', lc $data;
1408    unless (@words == 4) {
1409        return &cmd_list_channels(@_);
1410    }
1411
1412    my ($type, $tag, $net_tag, $channame) = @words;
1413    my $delete = 1 if $type =~ s/^-//;
1414
1415    unless ( grep { $type eq $_ } @{ $valid_types{'channel'} } ) {
1416        &error( "Invalid message type '$type'.",
1417                'Valid types: ' . join(', ', @{ $valid_types{'channel'} }));
1418        return;
1419    }
1420
1421    $tag = &normalize_username($tag) unless grep { $type eq $_ } qw/ search sender * /
1422                or $tag eq '*';
1423
1424    if ($delete) {
1425        if (not defined $state{__channels}{$type}
1426                or not defined $state{__channels}{$type}{$tag}
1427                or not defined $state{__channels}{$type}{$tag}{$net_tag}
1428                or not grep { $_ eq $channame } @{ $state{__channels}{$type}{$tag}{$net_tag} }) {
1429            &notice("No such channel setting for $type/$tag on $net_tag.");
1430            return;
1431        }
1432        &notice("$type/$tag messages will no longer be sent"
1433              . " to the '$channame' channel on $net_tag" );
1434        @{ $state{__channels}{$type}{$tag}{$net_tag} } =
1435            grep { $_ ne $channame } @{ $state{__channels}{$type}{$tag}{$net_tag} };
1436        delete $state{__channels}{$type}{$tag}{$net_tag}
1437          unless @{ $state{__channels}{$type}{$tag}{$net_tag} };
1438        delete $state{__channels}{$type}{$tag}
1439          unless keys %{ $state{__channels}{$type}{$tag} };
1440        delete $state{__channels}{$type}
1441          unless keys %{ $state{__channels}{$type} };
1442
1443    } elsif (defined $state{__channels}{$type}{$tag}{$net_tag}
1444                and grep { $_ eq $channame }
1445                      @{ $state{__channels}{$type}{$tag}{$net_tag} }) {
1446        &notice("There is already such a channel setting.");
1447        return;
1448
1449    } else {
1450        &notice("$type/$tag messages will now be sent"
1451              . " to the '$channame' channel on $net_tag" );
1452        push @{ $state{__channels}{$type}{$tag}{$net_tag} }, $channame;
1453    }
1454
1455    &save_state();
1456    return;
1457}
1458
1459sub cmd_list_windows {
1460    my ( $data, $server, $win ) = @_;
1461
1462    &notice("Current output windows:");
1463    foreach my $type ( sort keys %{ $state{__windows} } ) {
1464        &notice("$type:");
1465        foreach my $tag ( sort keys %{ $state{__windows}{$type} } ) {
1466            &notice("  $tag: $state{__windows}{$type}{$tag}");
1467        }
1468    }
1469    &notice( "Default window for all other messages: " . $settings{window} );
1470
1471    &notice("Add new entries with the /twirssi_set_window "
1472          . "[type] [tag] [window] command." );
1473    &notice("Remove a setting by setting window name to '-'.");
1474}
1475
1476sub cmd_set_window {
1477    my ( $data, $server, $win ) = @_;
1478
1479    my @words = split ' ', $data;
1480
1481    unless (@words) {
1482        &cmd_list_windows(@_);
1483        return;
1484    }
1485
1486    my $winname = pop @words;       # the last argument is the window name
1487    my $delete = $winname eq '-';
1488
1489    if ( @words == 0 ) {            # just a window name
1490        $winname = 'twitter' if $delete;
1491        &notice("Changing the default twirssi window to $winname");
1492        Irssi::settings_set_str( "twitter_window", $winname );
1493        &ensure_logfile($settings{window} = $winname);
1494     } elsif ( @words > 2 and $words[0] ne 'search' ) {
1495        &notice(
1496                "Too many arguments to /twirssi_set_window. '@words'",
1497                "Usage: /twirssi_set_window [type] [account|search_term] [window].",
1498                'Valid types: ' . join(', ', @{ $valid_types{'window'} })
1499        );
1500        return;
1501    } elsif ( @words >= 1 ) {
1502        my $type = lc $words[0];
1503        unless ( grep { $_ eq $type } @{ $valid_types{'window'} } ) {
1504            &error("Invalid message type '$type'.",
1505                'Valid types: ' . join(', ', @{ $valid_types{'window'} }));
1506            return;
1507        }
1508
1509        my $tag = "default";
1510        if ( @words >= 2 ) {
1511           $tag = lc $words[1];
1512           if ($type eq 'sender') {
1513              $tag =~ s/^\@//;
1514              $tag =~ s/\@.+//;
1515           } elsif ($type ne 'search'
1516                   and ($type ne 'default' or index($tag, '@') >= 0)
1517                   and $tag ne 'default') {
1518              $tag = &normalize_username($tag);
1519           } elsif ($type eq 'search' and @words > 2) {
1520              $tag = lc join(' ', @words[1..$#words]);
1521           }
1522           if (substr($tag, -1, 1) eq '@') {
1523              &error("Invalid tag '$tag'.");
1524              return;
1525           }
1526        }
1527
1528        if ($delete) {
1529            if (not defined $state{__windows}{$type}
1530                     or not defined $state{__windows}{$type}{$tag}) {
1531               &notice("No such window setting for $type/$tag.");
1532               return;
1533            }
1534            &notice("$type/$tag messages will no longer be sent to the '"
1535                       . $state{__windows}{$type}{$tag} . "' window" );
1536            delete $state{__windows}{$type}{$tag};
1537            delete $state{__windows}{$type}
1538              unless keys %{ $state{__windows}{$type} };
1539        } else {
1540            &notice("$type/$tag messages will now"
1541                  . " be sent to the '$winname' window" );
1542            $state{__windows}{$type}{$tag} = $winname;
1543        }
1544
1545        &save_state();
1546    }
1547
1548    &ensure_window($winname) if $winname ne '-';
1549
1550    return;
1551}
1552
1553sub get_friends {
1554    my $u_twit    = shift;
1555    my $username  = shift;
1556    my $fh        = shift;
1557    my $is_update = shift;
1558
1559    my $new_friends = &scan_cursor('friends', $u_twit, $username, $fh,
1560				{ fn=>'friends', cp=>(index($username, '@Twitter') != -1 ? 'c' : 'p'),
1561					set_key=>'users', item_key=>'screen_name', });
1562    return if not defined $new_friends;
1563
1564    return $new_friends if not $is_update;
1565
1566    my ( $added, $removed ) = ( 0, 0 );
1567    # &debug($fh, "%G$username%n Scanning for new friends...");
1568    foreach ( keys %$new_friends ) {
1569        next if exists $friends{$username}{$_};
1570        $friends{$username}{$_} = $new_friends->{$_};
1571        $added++;
1572    }
1573
1574    # &debug($fh, "%G$username%n Scanning for removed friends...");
1575    foreach ( keys %{ $friends{$username} } ) {
1576        next if exists $new_friends->{$_};
1577        delete $friends{$username}{$_};
1578        &debug($fh, "%G$username%n removing friend: $_");
1579        $removed++;
1580    }
1581
1582    return ( $added, $removed );
1583}
1584
1585sub scan_cursor {
1586    my $type_str  = shift;
1587    my $u_twit    = shift;
1588    my $username  = shift;
1589    my $fh        = shift;
1590    my $fn_info   = shift;
1591
1592    my $whole_set = ($fn_info->{want_array} ? [] : {});
1593    my $fn_args = { (defined $fn_info->{args} ? %{ $fn_info->{args} } : ()) };
1594    my $fn_name = $fn_info->{fn};
1595    my $pg_type = index($fn_info->{cp}, 'c') >= 0 ? 'cursor' : ($fn_info->{cp} =~ /p(\d*)/ ? 'page' : '');
1596    my $max_page = 10;
1597    $max_page = $1 if $pg_type eq 'page' and length($1) > 0;
1598    eval {
1599        for (my($cursor, $page) = (-1, 1); $cursor and $page <= $max_page; $page++) {
1600            if ($pg_type eq 'cursor') {
1601                $fn_args->{cursor} = $cursor if $cursor > 0;
1602            } elsif ($pg_type eq 'page') {
1603                $fn_args->{page} = $page;
1604            }
1605            &debug($fh, "%G$username%n Loading $type_str $pg_type " . ($pg_type eq 'cursor' ? $cursor : $page));
1606            my $collection;
1607            if ($fn_name =~ /^(get|post|put|delete)$/ and defined $fn_info->{endpoint}) {
1608              $collection = $u_twit->$fn_name($fn_info->{endpoint}, $fn_args);
1609            } else {
1610              $collection = $u_twit->$fn_name($fn_args);
1611            }
1612            last if not $collection;
1613            if ($pg_type eq 'cursor') {
1614                $cursor = $collection->{next_cursor};
1615                $collection = $collection->{$fn_info->{set_key}} if defined $fn_info->{set_key};
1616            }
1617            last if 0 == @$collection;
1618            if ($fn_info->{want_array}) {
1619              push @$whole_set, @$collection;
1620              next;
1621            }
1622            foreach my $coll_item (@$collection) {
1623                if ($pg_type eq 'page'
1624                       and defined $whole_set->{$coll_item->{$fn_info->{item_key}}}) {
1625                    &debug($fh, "%G$username%n repeated page $page key " . $fn_info->{item_key} .
1626                       ' val ' . $coll_item->{$fn_info->{item_key}} .
1627                       ''); #' pre ' . Dumper($whole_set->{$coll_item->{$fn_info->{item_key}}}));
1628                    next;
1629                }
1630                $whole_set->{$coll_item->{$fn_info->{item_key}}} = (
1631                    defined $fn_info->{item_val}
1632                        ? $coll_item->{$fn_info->{item_val}}
1633                        : (defined $fn_info->{item_keys}
1634                              ? (ref($fn_info->{item_keys}) eq 'ARRAY'
1635                                    ? { map { $_ => $coll_item->{$_} } @{ $fn_info->{item_keys} } }
1636                                    : { %$coll_item })
1637                              : time)
1638                );
1639                $fn_args->{max_id} = $coll_item->{id_str} if defined $fn_args->{since_id};
1640            }
1641        }
1642        if ($settings{debug}) {
1643            foreach my $item (split "\n", Dumper($whole_set)) { &debug($fh, "$pg_type: $item"); } # TODO remove
1644        }
1645    };
1646
1647    if ($@) {
1648        &error([$username, $fh], "Error updating $type_str.  Aborted.");
1649        &debug($fh, "%G$username%n Error updating $type_str: $@");
1650        return;
1651    }
1652
1653   return $whole_set;
1654}
1655
1656sub get_lists {
1657    my $u_twit    = shift;
1658    my $username  = shift;
1659    my $fh        = shift;
1660    my $is_update = shift;
1661    my $userid    = shift;
1662    my $list_name = shift;
1663
1664    my $list_account = $username;
1665    if ($is_update and not defined $userid and $username =~ /(.+)\@/) {
1666      $userid = $1;
1667    } else {
1668      $list_account = &normalize_username($userid, 1);
1669    }
1670
1671    my %stats = (added => 0, deleted => 0);
1672
1673    # ensure $new_lists->{$list_name} = $id
1674    my %more_args = ();
1675    my $new_lists = &scan_cursor('lists', $u_twit, $username, $fh,
1676				{ fn=>'list_ownerships', cp=>'c', set_key=>'lists',
1677					args=>{ user=>$userid, %more_args }, item_key=>'name', item_val=>'id', });
1678    return if not defined $new_lists;
1679
1680    # reduce $new_lists if $list_name specified (not $is_update)
1681    if (defined $list_name) {
1682        if (not defined $new_lists->{$list_name}) {
1683            return {};  # not is_update, so return empty
1684        }
1685        $new_lists = { $list_name => $new_lists->{$list_name} };
1686    }
1687
1688    foreach my $list (keys %$new_lists) {
1689        $stats{added}++ if not exists $state{__lists}{$list_account}{$list};
1690        $state{__lists}{$list_account}{$list} = { id=>$new_lists->{$list}, members=>[], };
1691    }
1692
1693    if ($is_update) {
1694        # remove any newly-missing lists
1695        foreach my $old_list (keys %{ $state{__lists}{$list_account} }) {
1696            if (not defined $new_lists->{$old_list}) {
1697                delete $state{__lists}{$list_account}{$old_list};
1698                &debug($fh, "%G$username%n removing list: $list_account / $old_list");
1699                $stats{deleted}++;
1700            }
1701        }
1702    }
1703
1704    foreach my $reget_list (keys %$new_lists) {
1705        &debug($fh, "%G$username%n updating list: $list_account / $reget_list id=" .
1706                        $state{__lists}{$list_account}{$reget_list}{id});
1707        my $members = &scan_cursor('list member', $u_twit, $username, $fh,
1708			{ fn=>'list_members', cp=>'c', set_key=>'users', item_key=>'screen_name', item_val=>'id',
1709				args=>{ user=>$userid, list_id=>$state{__lists}{$list_account}{$reget_list}{id} }, });
1710        return if not defined $members;
1711        $state{__lists}{$list_account}{$reget_list}{members} = [ keys %$members ];
1712    }
1713
1714    return ($stats{added}, $stats{deleted});
1715}
1716
1717sub get_blocks {
1718    my $u_twit    = shift;
1719    my $username  = shift;
1720    my $fh        = shift;
1721    my $is_update = shift;
1722
1723    my $new_blocks = &scan_cursor('blocks', $u_twit, $username, $fh,
1724				{ fn=>'blocking', cp=>'c', set_key=>'users', item_key=>'screen_name', });
1725    return if not defined $new_blocks;
1726
1727    return $new_blocks if not $is_update;
1728
1729    my ( $added, $removed ) = ( 0, 0 );
1730    # &debug($fh, "%G$username%n Scanning for new blocks...");
1731    foreach ( keys %$new_blocks ) {
1732        next if exists $blocks{$username}{$_};
1733        $blocks{$username}{$_} = time;
1734        $added++;
1735    }
1736
1737    # &debug($fh, "%G$username%n Scanning for removed blocks...");
1738    foreach ( keys %{ $blocks{$username} } ) {
1739        next if exists $new_blocks->{$_};
1740        delete $blocks{$username}{$_};
1741        &debug($fh, "%G$username%n removing block: $_");
1742        $removed++;
1743    }
1744
1745    return ( $added, $removed );
1746}
1747
1748sub get_reply_to {
1749    # extract reply-to-information from tweets
1750    my $t = shift;
1751
1752    if ($t->{in_reply_to_screen_name}
1753       and $t->{in_reply_to_status_id}) {
1754       return sprintf 'reply_to_user:%s reply_to_id:%s ',
1755           $t->{in_reply_to_screen_name},
1756           $t->{in_reply_to_status_id};
1757    } else {
1758       return '';
1759    }
1760}
1761
1762sub cmd_wipe {
1763    my ( $data, $server, $win ) = @_;
1764    my @cache_keys = qw/ __tweets __indexes __ids
1765			__usernames __reply_to_ids __reply_to_users __created_ats /;
1766    my @surplus_nicks = ();
1767    if ($data eq '') {
1768        for my $nick (keys %{ $state{__tweets} }) {
1769            my $followed = 0;
1770            for my $acct (keys %twits) {
1771                if (grep { lc($_) eq $nick } keys %{ $friends{$acct} }) {
1772                    $followed = 1;
1773                    last;
1774                }
1775            }
1776            push @surplus_nicks, $nick if not $followed;
1777        }
1778    } else {
1779        for my $to_wipe (split(/\s+/, $data)) {
1780            if (exists $state{$to_wipe}) {
1781                &notice("Wiping '$to_wipe' state.");
1782                $state{$to_wipe} = {};
1783            } elsif ($to_wipe eq '-f') {
1784                push @surplus_nicks, keys %{ $state{__tweets} };
1785            } elsif ($to_wipe eq '-A') {
1786                &notice('Wiping all info/settings.');
1787                %state = ();
1788            } else {
1789                &error("No such twirssi_wipe argument '$to_wipe'.");
1790            }
1791        }
1792    }
1793    if (@surplus_nicks) {
1794        for my $surplus_nick (@surplus_nicks) {
1795            for my $cache_key (@cache_keys) {
1796                delete $state{$cache_key}{$surplus_nick};
1797            }
1798        }
1799        &debug('Wiped data for ' . join(',', @surplus_nicks));
1800        &notice('Wiped data for ' . (0+@surplus_nicks) . ' nicks.');
1801    }
1802}
1803
1804sub cmd_user {
1805    my $target = shift;
1806    my $server = shift;
1807    my $win = shift;
1808    $target =~ s/(?::\d+)?\s*$//;
1809    &cmd_set_window("sender $target $target", $server, $win)
1810                        if $target =~ s/^\s*-w\s+// and $target ne '';
1811    &get_updates([ 0, [
1812                            [ "$user\@$defservice", { up_user => $target } ],
1813                      ],
1814    ]);
1815}
1816
1817sub tweet_to_meta {
1818    my $obj      = shift;
1819    my $t        = shift;
1820    my $username = shift;
1821    my $type     = shift;
1822    my $topic    = shift;
1823    my %meta     = (
1824        username => $username,
1825        type     => $type,
1826        nick     => ($type eq 'dm' ? $t->{sender_screen_name}
1827                                    : $t->{user}{screen_name}),
1828    );
1829    ($meta{account}, $meta{service}) = split('@', $username, 2);
1830    foreach my $meta_key (keys %meta_to_twit) {
1831        $meta{$meta_key} = $t->{$meta_to_twit{$meta_key}} if defined $t->{$meta_to_twit{$meta_key}};
1832    }
1833    $meta{created_at} = $meta{ts} // &date_to_epoch($meta{created_at});
1834    $meta{topic} = $topic if defined $topic;
1835    $meta{text} = &get_text($t, $obj);
1836    return \%meta;
1837}
1838
1839sub tweet_or_reply {
1840    my $obj      = shift;
1841    my $t        = shift;
1842    my $username = shift;
1843    my $cache    = shift;
1844    my $fh       = shift;
1845
1846    my $type = 'tweet';
1847    if ( $t->{in_reply_to_screen_name}
1848        and $username !~ /^\Q$t->{in_reply_to_screen_name}\E\@/i
1849        and not exists $friends{$username}{ $t->{in_reply_to_screen_name} } ) {
1850        $nicks{ $t->{in_reply_to_screen_name} } = time;
1851        unless ( $cache->{ $t->{in_reply_to_status_id} } ) {
1852            eval {
1853                $cache->{ $t->{in_reply_to_status_id} } =
1854                  $obj->show_status( $t->{in_reply_to_status_id} );
1855            };
1856        }
1857&debug($fh, "REPLY $username rep2 $@ " . Dumper($cache->{ $t->{in_reply_to_status_id} }));
1858        if (my $t_reply = $cache->{ $t->{in_reply_to_status_id} }) {
1859            if (defined $fh) {
1860                my $ctext = &get_text( $t_reply, $obj );
1861                printf $fh "t:tweet id:%s ac:%s %snick:%s ts:%s %s\n",
1862                  $t_reply->{id}, $username, &get_reply_to($t_reply),
1863                  $t_reply->{user}{screen_name}, &get_ts($t_reply), $ctext;
1864                &get_unshorten_urls($ctext, $fh);
1865            }
1866            $type = 'reply';
1867        }
1868    }
1869    return $type;
1870}
1871
1872sub background_setup {
1873    my $pause_monitor = shift || 5000;
1874    my $max_pauses    = shift || 24;
1875    my $is_update     = shift;
1876    my $fn_to_call    = shift;
1877    my $fn_args_ref   = shift;
1878
1879    &debug("bg_setup starting upd=$is_update");
1880
1881    return unless &logged_in($twit);
1882
1883    my ( $fh, $filename ) = File::Temp::tempfile('tw_'.$$.'_XXXX', TMPDIR => 1);
1884    my $done_filename = "$filename.done";
1885    unlink($done_filename) if -f $done_filename;
1886    binmode( $fh, ":" . &get_charset() );
1887    $child_pid = fork();
1888
1889    if ($child_pid) {                   # parent
1890        Irssi::timeout_add_once( $pause_monitor, 'monitor_child',
1891            [ $done_filename, $max_pauses, $pause_monitor, $is_update, $filename . '.' . $child_pid, 0 ] );
1892        Irssi::pidwait_add($child_pid);
1893    } elsif ( defined $child_pid ) {    # child
1894        my $pid_filename = $filename . '.' . $$;
1895        rename $filename, $pid_filename;
1896        close STDIN;
1897        close STDOUT;
1898        close STDERR;
1899
1900        {
1901            no strict 'refs';
1902            &$fn_to_call($fh, @$fn_args_ref);
1903        }
1904
1905        close $fh;
1906        rename $pid_filename, $done_filename;
1907        exit;
1908    } else {
1909        &error("Failed to fork for background call: $!");
1910    }
1911}
1912
1913sub ensure_updates {
1914    my $adhoc_interval = shift;
1915    my $poll_interval = (defined $adhoc_interval ? $adhoc_interval : &get_poll_time) * 1000;
1916    if ($poll_interval != $last_poll{__interval} or not $poll_event) {
1917        &debug("get_updates every " . int($poll_interval/1000));
1918        Irssi::timeout_remove($poll_event) if $poll_event;
1919        $poll_event = Irssi::timeout_add( $poll_interval, \&get_updates, [ 1 ] );
1920        $last_poll{__interval} = $poll_interval;
1921    }
1922}
1923
1924sub get_updates {
1925    my $args = shift;
1926
1927    my $is_regular = 0;
1928    my $to_be_updated;
1929    if (not ref $args) {	# command-line request, so do regular
1930        $is_regular = 1;
1931    } else {
1932        $is_regular    = $args->[0];
1933        $to_be_updated = $args->[1];
1934    }
1935
1936    &debug("get_updates starting upd=$is_regular");
1937
1938    return unless &logged_in($twit);
1939
1940    if ($is_regular) {
1941        if ($update_is_running) {
1942            &debug("get_updates aborted: already running");
1943            return;
1944        }
1945        $update_is_running = 1;
1946    }
1947
1948    if (not defined $to_be_updated) {
1949        $to_be_updated = [];
1950        foreach my $pref_user (@{ $settings{update_usernames} }) {
1951            next unless $pref_user = &valid_username($pref_user);
1952            next if grep { $_ eq $pref_user } @{ $settings{ignored_accounts} };
1953            push @$to_be_updated, [ $pref_user, {} ];
1954        }
1955        foreach my $other_user (keys %twits) {
1956            next if grep { $_ eq $other_user } @{ $settings{ignored_accounts} };
1957            push @$to_be_updated, [ $other_user, {} ]
1958                 if not grep { $other_user eq $_->[0] } @$to_be_updated;
1959        }
1960    }
1961    &background_setup(5000, (24*@$to_be_updated), $is_regular, 'get_updates_child', [ $is_regular, $to_be_updated ]);
1962
1963    if ($is_regular) {
1964        &ensure_updates();
1965    }
1966}
1967
1968sub get_updates_child {
1969    my $fh            = shift;
1970    my $is_regular    = shift;
1971    my $to_be_updated = shift;
1972
1973    my $time_before_update = time;
1974
1975    my $error = 0;
1976    my @error_types = ();
1977    my %context_cache;
1978
1979    foreach my $update_tuple ( @$to_be_updated ) {
1980        my $username       = shift @$update_tuple;
1981        my $what_to_update = shift @$update_tuple;
1982        my $errors_beforehand = $error;
1983
1984        if (0 == keys(%$what_to_update)
1985                or defined $what_to_update->{up_tweets}) {
1986            unless (&get_tweets( $fh, $username, $twits{$username}, \%context_cache )) {
1987                $error++;
1988                push @error_types, 'tweets';
1989            }
1990
1991            if ( exists $state{__last_id}{$username}{__extras}
1992                    and keys %{ $state{__last_id}{$username}{__extras} } ) {
1993                my @frusers = sort keys %{ $state{__last_id}{$username}{__extras} };
1994
1995                unless (&get_timeline( $fh, $frusers[ $fix_replies_index{$username} ],
1996                                               $username, $twits{$username}, \%context_cache, $is_regular )) {
1997                    $error++;
1998                    push @error_types, 'replies';
1999                }
2000
2001                $fix_replies_index{$username}++;
2002                $fix_replies_index{$username} = 0
2003                      if $fix_replies_index{$username} >= @frusers;
2004                print $fh "t:fix_replies_index idx:$fix_replies_index{$username} ",
2005                      "ac:$username\n";
2006            }
2007        }
2008        next if $error > $errors_beforehand;
2009
2010        if (defined $what_to_update->{up_user}) {
2011            unless (&get_timeline( $fh, $what_to_update->{up_user},
2012                                               $username, $twits{$username}, \%context_cache, $is_regular )) {
2013                $error++;
2014                push @error_types, 'tweets';
2015            }
2016
2017        }
2018        next if $error > $errors_beforehand;
2019
2020        if (0 == keys(%$what_to_update)
2021                    or defined $what_to_update->{up_dms}) {
2022            unless (&do_dms( $fh, $username, $twits{$username}, $is_regular )) {
2023                $error++;
2024                push @error_types, 'dms';
2025            }
2026        }
2027        next if $error > $errors_beforehand;
2028
2029        if (0 == keys(%$what_to_update)
2030                    or defined $what_to_update->{up_subs}) {
2031            unless (&do_subscriptions( $fh, $username, $twits{$username}, $what_to_update->{up_subs} )) {
2032                $error++;
2033                push @error_types, 'subs';
2034            }
2035        }
2036        next if $error > $errors_beforehand;
2037
2038        if (0 == keys(%$what_to_update)
2039                    or defined $what_to_update->{up_searches}) {
2040            unless (&do_searches( $fh, $username, $twits{$username}, $what_to_update->{up_searches} )) {
2041                $error++;
2042                push @error_types, 'searches';
2043            }
2044        }
2045        next if $error > $errors_beforehand;
2046
2047        if ( (0 == keys(%$what_to_update)
2048                  and time - $last_poll{$username}{friends} > $settings{friends_poll})
2049                or defined $what_to_update->{up_friends} ) {
2050            my $show_friends;
2051            if ($is_regular) {
2052                my $time_before = time;
2053                my ( $added, $removed ) = &get_friends($twits{$username}, $username, $fh, 1);
2054                print $fh "t:debug %G$username%n Friends list updated: ",
2055                        "$added added, $removed removed\n" if $added + $removed;
2056                print $fh "t:last_poll ac:$username poll_type:friends epoch:$time_before\n";
2057                $show_friends = $friends{$username};
2058            } else {
2059                $show_friends = &get_friends($twits{$username}, $username, $fh, 0);
2060            }
2061            foreach ( sort keys %$show_friends ) {
2062                print $fh "t:friend ac:$username nick:$_ epoch:$show_friends->{$_}\n";
2063            }
2064        }
2065        next if $error > $errors_beforehand;
2066
2067        if ( (0 == keys(%$what_to_update)
2068                  and time - $last_poll{$username}{blocks} > $settings{blocks_poll} )
2069                or defined $what_to_update->{up_blocks}) {
2070            my $show_blocks;
2071            if ($is_regular) {
2072                my $time_before = time;
2073                my ( $added, $removed ) = &get_blocks($twits{$username}, $username, $fh, 1);
2074                print $fh "t:debug %G$username%n Blocks list updated: ",
2075                        "$added added, $removed removed\n" if $added + $removed;
2076                print $fh "t:last_poll ac:$username poll_type:blocks epoch:$time_before\n";
2077                $show_blocks = $blocks{$username};
2078            } else {
2079                $show_blocks = &get_blocks($twits{$username}, $username, $fh, 0);
2080            }
2081            foreach ( sort keys %$show_blocks ) {
2082                print $fh "t:block ac:$username nick:$_ epoch:$show_blocks->{$_}\n";
2083            }
2084        }
2085        next if $error > $errors_beforehand;
2086
2087        if ( (0 == keys(%$what_to_update)
2088                  and time - $last_poll{$username}{lists} > $settings{lists_poll} )
2089                or defined $what_to_update->{up_lists}) {
2090            my $list_account = $username;
2091            my $list_name_limit;
2092            if ($is_regular) {
2093                my $time_before = time;
2094                my ( $added, $removed ) = &get_lists($twits{$username}, $username, $fh, 1);
2095                print $fh "t:debug %G$username%n Lists list updated: ",
2096                        "$added added, $removed removed\n" if $added or $removed;
2097                print $fh "t:last_poll ac:$username poll_type:lists epoch:$time_before\n";
2098            } else {
2099                if (defined $what_to_update->{up_lists} and ref $what_to_update->{up_lists}
2100                        and defined $what_to_update->{up_lists}->[0]) {
2101                    $list_account = &normalize_username($what_to_update->{up_lists}->[0], 1);
2102                    if (defined $what_to_update->{up_lists}->[1]) {
2103                        $list_name_limit = $what_to_update->{up_lists}->[1];
2104                    }
2105                }
2106                if (not defined &get_lists($twits{$username}, $username, $fh, 0, @{ $what_to_update->{up_lists} })) {
2107                    &debug($fh, "%G$username%n Polling for lists failed.");
2108                    $error++;
2109                    push @error_types, 'lists';
2110                }
2111            }
2112            if (not defined $state{__lists}{$list_account}) {
2113                &notice(['info', undef, $fh], "List owner $list_account does not exist or has no lists.")
2114                    if not $is_regular;
2115            } elsif (defined $list_name_limit and not defined $state{__lists}{$list_account}{$list_name_limit}) {
2116                &notice(['info', undef, $fh], "List $list_account/$list_name_limit does not exist.")
2117                    if not $is_regular;
2118            } else {
2119                foreach my $list_name (sort keys %{ $state{__lists}{$list_account} }) {
2120                    next if defined $list_name_limit and $list_name ne $list_name_limit;
2121                    my $list_id = $state{__lists}{$list_account}{$list_name}{id};
2122                    foreach my $member ( @{ $state{__lists}{$list_account}{$list_name}{members} } ) {
2123                        print $fh "t:list ac:$username list:$list_account/$list_name id:$list_id nick:$member\n";
2124                    }
2125                }
2126            }
2127        }
2128        next if $error > $errors_beforehand;
2129    }
2130
2131    &put_unshorten_urls($fh, $time_before_update);
2132
2133    if ($error) {
2134        &error([$fh], "Update encountered errors (@error_types).  Aborted");
2135        # &error( [$fh], "For recurring DMs errors, please re-auth (delete $settings{oauth_store})") if grep { $_ eq 'dms' } @error_types;
2136    } elsif ($is_regular) {
2137        print $fh "t:last_poll poll_type:__poll epoch:$time_before_update\n";
2138    }
2139}
2140
2141sub is_ignored {
2142    my $text = shift;
2143    my $twit = shift;
2144
2145    my $text_no_colors = &remove_colors($text);
2146    foreach my $tag (@{ $settings{ignored_tags} }) {
2147        return $tag if $text_no_colors =~ /(?:^|\b|\s)\Q$tag\E(?:\b|\s|$)/i;
2148    }
2149    if (defined $twit and grep { $_ eq lc $twit } @{ $settings{ignored_twits} }) {
2150        return $twit;
2151    }
2152    return undef;
2153}
2154
2155sub remove_tags {
2156    my $text = shift;
2157
2158    foreach my $tag (@{ $settings{stripped_tags} }) {
2159        $text =~ s/\cC\d{2}\Q$tag\E\cO//gi;   # with then without colors
2160        $text =~ s/(^|\b|\s)\Q$tag\E(\b|\s|$)/$1$2/gi;
2161    }
2162    return $text;
2163}
2164
2165sub get_ts {
2166    my $t = shift;
2167    return $t->{created_timestamp} / 1000 if defined $t->{created_timestamp};
2168    return &date_to_epoch($t->{created_at});
2169}
2170
2171sub get_tweets {
2172    my ( $fh, $username, $obj, $cache ) = @_;
2173
2174    return if &rate_limited($obj, $username, $fh);
2175
2176    my %call_attribs = (
2177            tweet_mode => 'extended',
2178            count      => 200,
2179    );
2180    $call_attribs{since_id} = $state{__last_id}{$username}{timeline}
2181                           if defined $state{__last_id}{$username}{timeline};
2182
2183    my $tweets = &scan_cursor('home_timeline', $obj, $username, $fh, {
2184		fn => 'home_timeline', cp => 'p', args => \%call_attribs,
2185		item_key => 'id_str', item_keys => 1,
2186    });
2187
2188    if (not defined $tweets) {
2189        print $fh "t:error $username Error during home_timeline call: Aborted.\n";
2190        return;
2191    }
2192    $tweets = [ map { $tweets->{$_} } sort { cmp_id($b, $a) } keys %$tweets ];
2193
2194    print $fh "t:debug %G$username%n got ", scalar(@$tweets), ' tweets',
2195		(@$tweets	? ', first/last: ' . join('/',
2196						(sort {$a->{id} <=> $b->{id}} @$tweets)[0]->{id},
2197						(sort {$a->{id} <=> $b->{id}} @$tweets)[$#{$tweets}]->{id}
2198					)
2199				: ''),
2200		"\n";
2201
2202    my $new_poll_id = 0;
2203    my @own_ids = ();
2204    foreach my $t ( reverse @$tweets ) {
2205        my $text = &get_text( $t, $obj );
2206        $text = &remove_tags($text);
2207        my $ign = &is_ignored($text, $t->{user}{screen_name});
2208        $ign = (defined $ign ? 'ign:' . &encode_for_file($ign) . ' ' : '');
2209        my $reply = &tweet_or_reply($obj, $t, $username, $cache, $fh);
2210        if ($t->{user}{screen_name} eq $username and not $settings{own_tweets}) {
2211            push @own_ids, $t->{id};
2212            next;
2213        }
2214        printf $fh "t:%s id:%s ac:%s %s%snick:%s ts:%s %s\n",
2215            $reply, $t->{id}, $username, $ign, &get_reply_to($t), $t->{user}{screen_name},
2216            &get_ts($t), $text;
2217        &get_unshorten_urls($text, $fh);
2218
2219        $new_poll_id = $t->{id} if $new_poll_id < $t->{id};
2220    }
2221    &debug($fh, "%G$username%n skip own " . join(', ', @own_ids) . "\n") if @own_ids;
2222    printf $fh "t:last_id id:%s ac:%s id_type:timeline\n", $new_poll_id, $username if $new_poll_id;
2223
2224    &debug($fh, "%G$username%n Polling for replies since " . $state{__last_id}{$username}{reply});
2225    my $arg_ref = { tweet_mode => 'extended' };
2226    if ( $state{__last_id}{$username}{reply} ) {
2227        $arg_ref->{since_id} = $state{__last_id}{$username}{reply};
2228    }
2229    eval {
2230        $tweets = $obj->replies( $arg_ref ) || [];
2231    };
2232
2233    if ($@) {
2234        print $fh "t:debug %G$username%n Error during replies call.  Aborted.\n";
2235        &debug($fh, "%G$username%n Error: " . $@);
2236        return;
2237    }
2238
2239    $new_poll_id = 0;
2240    foreach my $t ( reverse @$tweets ) {
2241        next if exists $friends{$username}{ $t->{user}{screen_name} };
2242
2243        my $text = &get_text( $t, $obj );
2244        $new_poll_id = $t->{id} if $new_poll_id < $t->{id};
2245        $text = &remove_tags($text);
2246        &get_unshorten_urls($text, $fh);
2247        my $ign = &is_ignored($text);
2248        $ign = (defined $ign ? 'ign:' . &encode_for_file($ign) . ' ' : '');
2249        printf $fh "t:tweet id:%s ac:%s %s%snick:%s ts:%s %s\n",
2250          $t->{id}, $username, $ign, &get_reply_to($t), $t->{user}{screen_name},
2251          &get_ts($t), $text;
2252    }
2253    printf $fh "t:last_id id:%s ac:%s id_type:reply\n", $new_poll_id, $username if $new_poll_id;
2254    return 1;
2255}
2256
2257
2258sub do_dms {
2259    my ( $fh, $username, $obj, $is_regular ) = @_;
2260
2261    my $new_poll_id = 0;
2262
2263    my $dm_args = { tweet_mode => 'extended' };
2264    if ( $is_regular and $state{__last_id}{$username}{dm} ) {
2265        $dm_args->{since_id} = $state{__last_id}{$username}{dm};
2266        &debug($fh, "%G$username%n Polling for DMs since_id " .
2267                         $state{__last_id}{$username}{dm});
2268    } else {
2269        &debug($fh, "%G$username%n Polling for DMs");
2270    }
2271
2272    my $dms;
2273    eval {
2274      $dms = &scan_cursor('DMs', $obj, $username, $fh, {
2275		fn=>'get', endpoint=>'direct_messages/events/list', cp=>'c', args=>{},
2276		set_key=>'events', want_array=>1,
2277      });
2278      return if not defined $dms;
2279
2280      #$dms = $obj->post('direct_messages/events/list', $dm_args) || {};
2281    };
2282    if ($@) {
2283        &debug($fh, "%G$username%n Error during direct_messages call.  Aborted.");
2284        &debug($fh, "%G$username%n Error: " . $@);
2285        return;
2286    }
2287    &debug($fh, "%G$username%n got DMs: " . (0+@$dms));
2288    return 1 unless 0+@$dms;
2289    if ($settings{debug}) {
2290        foreach my $item (split "\n", Dumper($dms)) { &debug($fh, "dm: $item"); } # TODO remove
2291    }
2292
2293    foreach my $t ( reverse @$dms ) {
2294        # XXX last if $t->{id_str} eq $state{__last_id}{$username}{dm};
2295        my $text = decode_entities( get_full_text($t->{message_create}->{message_data}) );
2296        $text =~ s/[\n\r]/ /g;
2297
2298        my $sender_id   = $t->{message_create}->{sender_id};
2299        my $sender_nick = &id_to_user($obj, $sender_id, "dms", $fh);
2300        if (not defined $sender_nick) {
2301            &error(['dms', $fh], "update encountered error. Skipping DM for " . $sender_id);
2302            next;
2303        }
2304        next if &normalize_username($sender_nick) eq $username;
2305
2306        printf $fh "t:dm id:%s ac:%s %snick:%s ts:%s %s\n",
2307          $t->{id}, $username, &get_reply_to($t), $sender_nick, &get_ts($t), $text;
2308        $new_poll_id = $t->{id} if $new_poll_id < $t->{id};
2309    }
2310    printf $fh "t:last_id id:%s ac:%s id_type:dm\n", $new_poll_id, $username if $new_poll_id;
2311    return 1;
2312}
2313
2314sub do_subscriptions {
2315    my ( $fh, $username, $obj, $search_limit ) = @_;
2316
2317    &debug($fh, "%G$username%n Polling for subscriptions");
2318    if ( $obj->can('search') and $state{__last_id}{$username}{__search} ) {
2319        my $search;
2320        foreach my $topic ( sort keys %{ $state{__last_id}{$username}{__search} } ) {
2321            next if defined $search_limit and @$search_limit and not grep { $topic eq $_ } @$search_limit;
2322            print $fh "t:debug %G$username%n Search '$topic' id was ",
2323              "$state{__last_id}{$username}{__search}{$topic}\n";
2324            eval {
2325                $search = $obj->search(
2326                    {
2327                        tweet_mode => 'extended',
2328                        q          => $topic,
2329                        since_id   => $state{__last_id}{$username}{__search}{$topic} eq '9223372036854775807'
2330                                       ? 0
2331                                       : $state{__last_id}{$username}{__search}{$topic},
2332                    }
2333                );
2334            };
2335
2336            if ($@) {
2337                print $fh
2338                  "t:debug %G$username%n Error during search($topic) call.  Aborted.\n";
2339                &debug($fh, "%G$username%n Error: " . $@);
2340                return;
2341            }
2342
2343            unless ( $search->{search_metadata}->{max_id} ) {
2344                print $fh "t:debug %G$username%n Invalid search results when searching",
2345                  " for '$topic'. Aborted.\n";
2346                return;
2347            } elsif ( $search->{search_metadata}->{max_id} eq '9223372036854775807' ) {
2348                &debug($fh, "%G$username%n Error: search max_id = MAX_INT64");
2349                $state{__last_id}{$username}{__search}{$topic} = 0;
2350                foreach my $t ( reverse @{ $search->{statuses} } ) {
2351                    $state{__last_id}{$username}{__search}{$topic} = $t->{id}
2352                      if cmp_id($t->{id}, $state{__last_id}{$username}{__search}{$topic}) > 0;
2353                }
2354            } else {
2355                $state{__last_id}{$username}{__search}{$topic} = $search->{search_metadata}->{max_id};
2356            }
2357
2358            printf $fh "t:searchid id:%s ac:%s topic:%s\n",
2359              $state{__last_id}{$username}{__search}{$topic}, $username, &encode_for_file($topic);
2360
2361            foreach my $t ( reverse @{ $search->{statuses} } ) {
2362                next if exists $blocks{$username}{ $t->{user}->{screen_name} };
2363                my $text = &get_text( $t, $obj );
2364                $text = &remove_tags($text);
2365                my $ign = &is_ignored($text, $t->{user}->{screen_name});
2366                &get_unshorten_urls($text, $fh);
2367                $ign = (defined $ign ? 'ign:' . &encode_for_file($ign) . ' ' : '');
2368                printf $fh "t:search id:%s ac:%s %snick:%s topic:%s ts:%s %s\n",
2369                  $t->{id}, $username, $ign, $t->{user}->{screen_name}, &encode_for_file($topic),
2370                  &get_ts($t), $text;
2371            }
2372        }
2373    }
2374    return 1;
2375}
2376
2377sub do_searches {
2378    my ( $fh, $username, $obj, $search_limit ) = @_;
2379
2380    &debug($fh, "%G$username%n Polling for one-time searches");
2381    if ( $obj->can('search') and exists $search_once{$username} ) {
2382        my $search;
2383        foreach my $topic ( sort keys %{ $search_once{$username} } ) {
2384            next if defined $search_limit and @$search_limit and not grep { $topic eq $_ } @$search_limit;
2385            my $max_results = $search_once{$username}->{$topic};
2386
2387            $topic = &make_utf8($topic);
2388
2389            print $fh
2390              "t:debug %G$username%n search $topic once (max $max_results)\n";
2391            eval {
2392                    $search = $obj->search( {
2393                            q          => $topic,
2394                            tweet_mode => 'extended',
2395                    } );
2396            };
2397
2398            if (my $err = $@) {
2399                $err = $err->error . ' (' . $err->code . ' ' . $err->message . ')' if ref($err) =~ /(?:Net::Twitter|Twitter::API)::Error/;
2400                print $fh "t:debug %G$username%n Error during search_once($topic) call.  Aborted.\n";
2401                &debug($fh, "%G$username%n Error: $err");
2402                return;
2403            }
2404
2405            unless ( $search->{search_metadata}->{max_id} ) {
2406                print $fh "t:debug %G$username%n Invalid search results when searching once",
2407                  " for $topic. Aborted.\n";
2408                return;
2409            }
2410
2411            # TODO: consider applying ignore-settings to search results
2412            my @results = ();
2413            foreach my $res (@{ $search->{statuses} }) {
2414                if (exists $blocks{$username}{ $res->{user}->{screen_name} }) {
2415                    print $fh "t:debug %G$username%n blocked $topic: $res->{user}->{screen_name}\n";
2416                    next;
2417                }
2418                push @results, $res;
2419            }
2420            if ( $max_results > 0 ) {
2421                splice @results, $max_results;
2422            }
2423            foreach my $t ( reverse @results ) {
2424                my $text = &get_text( $t, $obj );
2425                $text = &remove_tags($text);
2426                &get_unshorten_urls($text, $fh);
2427                my $ign = &is_ignored($text, $t->{user}->{screen_name});
2428                $ign = (defined $ign ? 'ign:' . &encode_for_file($ign) . ' ' : '');
2429                printf $fh "t:search_once id:%s ac:%s %s%snick:%s topic:%s ts:%s %s\n",
2430                  $t->{id}, $username, $ign, &get_reply_to($t), $t->{user}->{screen_name}, &encode_for_file($topic),
2431                  &get_ts($t), $text;
2432            }
2433        }
2434    }
2435
2436    return 1;
2437}
2438
2439sub get_timeline {
2440    my ( $fh, $target, $username, $obj, $cache, $is_update ) = @_;
2441    my $tweets;
2442    my $last_id = $state{__last_id}{$username}{__extras}{$target} if $is_update;
2443
2444    &debug($fh, "%G$username%n get_timeline $target"
2445      . ($is_update ? "($fix_replies_index{$username} > $last_id)" : ''));
2446    my $arg_ref = {
2447            id         => $target,
2448            tweet_mode => 'extended',
2449    };
2450    if ($is_update) {
2451        $arg_ref->{since_id} = $last_id if $last_id;
2452        $arg_ref->{include_rts} = 1 if $settings{retweet_show};
2453    } elsif ($settings{limit_user_tweets} and $settings{limit_user_tweets} =~ /\b(\d+)\b/) {
2454        $arg_ref->{count} = $1;
2455    }
2456    eval {
2457        $tweets = $obj->user_timeline($arg_ref);
2458    };
2459
2460    if ($@) {
2461        print $fh "t:error $username user_timeline($target) call: Aborted.\n";
2462        print $fh "t:debug : $_\n" foreach split /\n/, Dumper($@);
2463        return;
2464    }
2465
2466    unless ($tweets) {
2467        print $fh "t:error $username user_timeline($target) call returned undef!  Aborted\n";
2468        return 1;
2469    }
2470
2471    my $not_before = time - $1*86400 if not $is_update and $settings{limit_user_tweets} and $settings{limit_user_tweets} =~ /\b(\d+)d\b/;
2472    foreach my $t ( reverse @$tweets ) {
2473        my $ts = &get_ts($t);
2474        next if defined $not_before and $ts < $not_before;
2475        my $text = &get_text( $t, $obj );
2476        my $reply = &tweet_or_reply($obj, $t, $username, $cache, $fh);
2477        printf $fh "t:%s id:%s ac:%s %snick:%s ts:%s %s\n",
2478          $reply, $t->{id}, $username, &get_reply_to($t), $t->{user}{screen_name}, $ts, $text;
2479        $last_id = $t->{id} if $last_id < $t->{id};
2480        &get_unshorten_urls($text, $fh);
2481    }
2482    if ($is_update) {
2483        printf $fh "t:last_id_fixreplies id:%s ac:%s id_type:%s\n",
2484          $last_id, $username, $target;
2485    }
2486
2487    return 1;
2488}
2489
2490sub encode_for_file {
2491    my $datum = shift;
2492    $datum =~ s/\t/%09/g;
2493    $datum =~ s/ /%20/g;
2494    return $datum;
2495}
2496
2497sub decode_from_file {
2498    my $datum = shift;
2499    $datum =~ s/%20/ /g;
2500    $datum =~ s/%09/\t/g;
2501    return $datum;
2502}
2503
2504sub date_to_epoch {
2505    # parse created_at style date to epoch time
2506    my $date = shift;
2507    if (not @datetime_parser) {
2508        foreach my $date_fmt (
2509                        '%a %b %d %T %z %Y',	# Fri Nov 05 10:14:05 +0000 2010
2510                        '%a, %d %b %Y %T %z',	# Fri, 05 Nov 2010 16:59:40 +0000
2511                ) {
2512            my $parser = DateTime::Format::Strptime->new(pattern => $date_fmt);
2513            if (not defined $parser) {
2514                @datetime_parser = ();
2515                return;
2516            }
2517            push @datetime_parser, $parser;
2518        }
2519    }
2520    # my $orig_date = $date;
2521    $date = $datetime_parser[index($date, ',') == -1 ? 0 : 1]->parse_datetime($date);
2522    # &debug("date '$orig_date': " . ref($date));
2523    return if not defined $date;
2524    return $date->epoch();
2525}
2526
2527sub meta_to_line {
2528    my $meta = shift;
2529    my %line_attribs = (
2530            username => $meta->{username}, epoch   => $meta->{created_at},
2531            type     => $meta->{type},     account => $meta->{account},
2532            service  => $meta->{service},  nick    => $meta->{nick},
2533            hilight  => 0,                 hi_nick => $meta->{nick},
2534            text     => $meta->{text},     topic   => $meta->{topic},
2535            level    => MSGLEVEL_PUBLIC,
2536    );
2537
2538    if ($meta->{type} eq 'dm' or $meta->{type} eq 'error' or $meta->{type} eq 'deerror') {
2539        $line_attribs{level} = MSGLEVEL_MSGS;
2540    }
2541
2542    my $nick = "\@$meta->{account}";
2543    if ( $meta->{text} =~ /\Q$nick\E(?:\W|$)/i ) {
2544        my $hilight_color        = $irssi_to_mirc_colors{ $settings{hilight_color} };
2545        $line_attribs{level}  |= MSGLEVEL_HILIGHT;
2546        $line_attribs{hi_nick} = "\cC$hilight_color$meta->{nick}\cO";
2547    }
2548    elsif ($settings{nick_color} eq 'rotate') {
2549        my $c = get_nick_color($meta->{nick});
2550        $line_attribs{hi_nick} = "\cC$c$meta->{nick}\cO";
2551    }
2552
2553    if (defined $meta->{ign}) {
2554        $line_attribs{ignoring} = 1;
2555        $line_attribs{marker} = '-' . $meta->{ign};  # must have a marker for tweet theme
2556
2557    } elsif ( $meta->{type} ne 'dm' and $meta->{nick} and $meta->{id} and not $meta->{ign} ) {
2558        ### not ignored, so we probably want it cached and create a :marker...
2559        my $marker;
2560        my $lc_nick = lc $meta->{nick};
2561        for (my $mark_idx = 0;
2562                defined $state{__ids}{ $lc_nick } and $mark_idx < @{ $state{__ids}{ $lc_nick } };
2563                $mark_idx++) {
2564            if ($state{__ids}{ $lc_nick }[$mark_idx] eq $meta->{id}) {
2565                $marker = $mark_idx;
2566                last;
2567            }
2568        }
2569        if (not defined $marker) {
2570            $marker = ( $state{__indexes}{ $lc_nick } + 1 ) % $settings{track_replies};
2571            $state{__ids}    { $lc_nick }[$marker] = $meta->{id};
2572            $state{__indexes}{ $lc_nick }          = $marker;
2573            $state{__tweets} { $lc_nick }[$marker] = $meta->{text};
2574            foreach my $key (qw/username reply_to_id reply_to_user created_at/) {
2575                # __usernames __reply_to_ids __reply_to_users __created_ats
2576                $state{"__${key}s"}{ $lc_nick }[$marker] = $meta->{$key} if defined $meta->{$key};
2577            }
2578        }
2579        $line_attribs{marker} = ":$marker";
2580    }
2581    return %line_attribs;
2582}
2583
2584sub cache_to_meta {
2585    my $line = shift;
2586    my $type = shift;
2587    my %meta = ( type => $type );
2588    foreach my $key (@{ $_[0] }) {
2589        if ($line =~ s/^$key:(\S+)\s*//) {
2590            $key = 'account' if $key eq 'ac';
2591            $meta{$key} = $1;
2592            $meta{$key} = &decode_from_file($meta{$key});
2593            if ($key eq 'account') {
2594                $meta{username} = &normalize_username($meta{account});	# username is account@Service
2595                $meta{account} =~ s/\@(\w+)$//;
2596                $meta{service} = $1;
2597            } elsif ($key eq 'ts') {
2598                $meta{created_at} = $meta{ts};
2599            } elsif ($key eq 'created_at') {
2600                $meta{created_at} = &date_to_epoch($meta{created_at});
2601            }
2602        }
2603    }
2604    $meta{text} = $line;
2605    return %meta;
2606}
2607
2608sub monitor_child {
2609    my $args = shift;
2610
2611    my $filename       = $args->[0];
2612    my $attempts_to_go = $args->[1];
2613    my $wait_time      = $args->[2];
2614    my $is_update      = $args->[3];
2615    my $filename_tmp   = $args->[4];
2616    my $prev_mtime     = $args->[5];
2617
2618    my $file_progress = 'no ' . $filename_tmp;
2619    my $this_mtime = $prev_mtime;
2620    if (-f $filename_tmp) {
2621        $this_mtime = (stat(_))[9];
2622        $file_progress = 'mtime=' . $this_mtime;
2623    }
2624    &debug("checking child log at $filename [$file_progress v $prev_mtime] ($attempts_to_go)");
2625
2626    # reap any random leftover processes - work around a bug in irssi on gentoo
2627    waitpid( -1, WNOHANG );
2628
2629    # first time we run we don't want to print out *everything*, so we just
2630    # pretend
2631
2632    my @lines = ();
2633    my %new_cache = ();
2634    my %types_per_user = ();
2635    my $got_errors = 0;
2636    my %show_now = ();       # for non-update info
2637
2638    my $fh;
2639    if ( -e $filename and open $fh, '<', $filename ) {
2640        binmode $fh, ":" . &get_charset();
2641    } else {
2642        # file not ready yet
2643
2644        if ( $attempts_to_go > 0 ) {
2645            Irssi::timeout_add_once( $wait_time, 'monitor_child',
2646                [ $filename, $attempts_to_go - 1, $wait_time, $is_update, $filename_tmp, $this_mtime ] );
2647        } else {
2648            &debug("Giving up on polling $filename");
2649            Irssi::pidwait_remove($child_pid);
2650            waitpid( -1, WNOHANG );
2651            unlink $filename unless &debug();
2652
2653            if (not $is_update) {
2654                &error("Failed to get response.  Giving up.");
2655                return;
2656            }
2657
2658            $update_is_running = 0 if $is_update;
2659
2660            return unless $settings{notify_timeouts};
2661
2662            my $since;
2663            if ( time - $last_poll{__poll} < 24 * 60 * 60 ) {
2664                my @time = localtime($last_poll{__poll});
2665                $since = sprintf( "%d:%02d", @time[ 2, 1 ] );
2666            } else {
2667                $since = scalar localtime($last_poll{__poll});
2668            }
2669
2670            if ( $failstatus < 2 and time - $last_poll{__poll} > 60 * 60 ) {
2671                &error( $settings{mini_whale}
2672                  ? 'FAIL WHALE'
2673                  : q{     v  v        v},
2674                    q{     |  |  v     |  v},
2675                    q{     | .-, |     |  |},
2676                    q{  .--./ /  |  _.---.| },
2677                    q{   '-. (__..-"       \\},
2678                    q{      \\          a    |},
2679                    q{       ',.__.   ,__.-'/},
2680                    q{         '--/_.'----'`}
2681                );
2682                $failstatus = 2;
2683            }
2684
2685            if ( $failstatus == 0 and time - $last_poll{__poll} < 600 ) {
2686                &error("Haven't been able to get updated tweets since $since");
2687                $failstatus = 1;
2688            }
2689        }
2690
2691        return;
2692    }
2693
2694    # make sure we're not in slurp mode
2695    local $/ = "\n";
2696    while (<$fh>) {
2697        unless (/\n$/) {    # skip partial lines
2698            &debug($fh, "Skipping partial line: $_");
2699            next;
2700        }
2701        chomp;
2702
2703        my $type;
2704        if (s/^t:(\w+)\s+//) {
2705            $type = $1;
2706        } else {
2707            &error("invalid: $_");
2708            next;
2709        }
2710
2711        if ($type eq 'debug') {
2712            &debug($_);
2713
2714        } elsif ($type =~ /^(error|info|deerror)$/) {
2715            $got_errors++ if $type eq 'error';
2716            &notice([$type], $_);
2717
2718        } elsif ($type eq 'uid') {
2719            my %meta = &cache_to_meta($_, $type, [ qw/ nick id / ]);
2720            $state{__i}{$meta{id}}       = $meta{nick};
2721            $state{__u}{$meta{nick}}{id} = $meta{id};
2722
2723        } elsif ($type eq 'url') {
2724            my %meta = &cache_to_meta($_, $type, [ qw/epoch https site uri/ ]);
2725            $expanded_url{$meta{site}}{$meta{https} ? 1 : 0}{$meta{uri}} = {
2726                url => $meta{text},
2727                epoch => $meta{epoch},
2728            };
2729
2730        } elsif ($type eq 'last_poll') {
2731            my %meta = &cache_to_meta($_, $type, [ qw/ac poll_type epoch/ ]);
2732
2733            if ( not defined $meta{ac} and $meta{poll_type} eq '__poll' ) {
2734                $last_poll{$meta{poll_type}} = $meta{epoch};
2735            } elsif ( $meta{epoch} >= $last_poll{$meta{username}}{$meta{poll_type}} ) {
2736                $last_poll{$meta{username}}{$meta{poll_type}} = $meta{epoch};
2737                &debug("%G$meta{username}%n $meta{poll_type} updated to $meta{epoch}");
2738            } else {
2739               &debug("%G$meta{username}%n Impossible! $meta{poll_type}: "
2740                  . "new poll=$meta{epoch} < prev=$last_poll{$meta{username}}{$meta{poll_type}}!");
2741               $got_errors++;
2742            }
2743
2744        } elsif ($type eq 'fix_replies_index') {
2745            my %meta = &cache_to_meta($_, $type, [ qw/idx ac topic id_type/ ]);
2746            $fix_replies_index{ $meta{username} } = $meta{idx};
2747            &debug("%G$meta{username}%n fix_replies_index set to $meta{idx}");
2748
2749        } elsif ($type eq 'searchid' or $type eq 'last_id_fixreplies' or $type eq 'last_id') {
2750            my %meta = &cache_to_meta($_, $type, [ qw/id ac topic id_type/ ]);
2751            if ( $meta{type} eq 'searchid' ) {
2752                &debug("%G$meta{username}%n Search '$meta{topic}' got id $meta{id}");
2753                if (not exists $state{__last_id}{ $meta{username} }{__search}{ $meta{topic} }
2754                        or $state{__last_id}{ $meta{username} }{__search}{ $meta{topic} } eq '9223372036854775807'
2755                        or cmp_id($meta{id}, $state{__last_id}{ $meta{username} }{__search}{ $meta{topic} }) > 0) {
2756                    $state{__last_id}{ $meta{username} }{__search}{ $meta{topic} } = $meta{id};
2757                } else {
2758                    &debug("%G$meta{username}%n Search '$meta{topic}' bad id $meta{id}");
2759                    $got_errors++;
2760                }
2761            } elsif ( $meta{type} eq 'last_id') {
2762                $state{__last_id}{ $meta{username} }{ $meta{id_type} } = $meta{id}
2763                  if cmp_id($meta{id}, $state{__last_id}{ $meta{username} }{ $meta{id_type} }) > 0;
2764            } elsif ( $meta{type} eq 'last_id_fixreplies' ) {
2765                $state{__last_id}{ $meta{username} }{__extras}{ $meta{id_type} } = $meta{id}
2766                  if cmp_id($meta{id}, $state{__last_id}{ $meta{username} }{__extras}{ $meta{id_type} }) > 0;
2767            }
2768
2769        } elsif ($type eq 'tweet' or $type eq 'dm' or $type eq 'reply' or $type eq 'search' or $type eq 'search_once') {	# cf theme_register
2770            my %meta = &cache_to_meta($_, $type, [ qw/id ac ign reply_to_user reply_to_id nick topic created_at ts / ]);
2771
2772            if (exists $new_cache{ $meta{id} }) {
2773                &debug("SKIP newly-cached $meta{id}");
2774                next;
2775            }
2776            $new_cache{ $meta{id} } = time;
2777            if (exists $tweet_cache{ $meta{id} }) {
2778                       # and (not $retweeted_id{$username} or not $retweeted_id{$username}{ $meta{id} });
2779                &debug("SKIP cached $meta{id}");
2780                next;
2781            }
2782
2783            my %line_attribs = &meta_to_line(\%meta);
2784            push @lines, { %line_attribs };
2785
2786            if ( $meta{type} eq 'search' ) {
2787                if ( exists $state{__last_id}{ $meta{username} }{__search}{ $meta{topic} }
2788                        and cmp_id($meta{id}, $state{__last_id}{ $meta{username} }{__search}{ $meta{topic} }) > 0) {
2789                    $state{__last_id}{ $meta{username} }{__search}{ $meta{topic} } = $meta{id};
2790                }
2791            } elsif ( $meta{type} eq 'search_once' ) {
2792                delete $search_once{ $meta{username} }->{ $meta{topic} };
2793            }
2794
2795        } elsif ($type eq 'friend' or $type eq 'block' or $type eq 'list') {
2796            my %meta = &cache_to_meta($_, $type, [ qw/ac list id nick epoch/ ]);
2797            if ($is_update and not defined $types_per_user{$meta{username}}{$meta{type}}) {
2798                if ($meta{type} eq 'friend') {
2799                    $friends{$meta{username}} = ();
2800                } elsif ($meta{type} eq 'block') {
2801                    $blocks{$meta{username}} = ();
2802                } elsif ($meta{type} eq 'list') {
2803                    my ($list_account, $list_name) = split '/', $meta{list};
2804                    $state{__lists}{$list_account} = {};
2805                }
2806                $types_per_user{$meta{username}}{$meta{type}} = 1;
2807            }
2808            if ($meta{type} eq 'friend') {
2809                $nicks{$meta{nick}} = $friends{$meta{username}}{$meta{nick}} = $meta{epoch};
2810            } elsif ($meta{type} eq 'block') {
2811                $blocks{$meta{username}}{$meta{nick}} = $meta{epoch};
2812            } elsif ($meta{type} eq 'list') {
2813                my ($list_account, $list_name) = split '/', $meta{list};
2814                if (not exists $state{__lists}{$list_account}{$list_name}) {
2815                    $state{__lists}{$list_account}{$list_name} = { id=>$meta{id}, members=>[] };
2816                }
2817                $show_now{lists}{$list_account}{$list_name} = $meta{id} if not $is_update;
2818                push @{ $state{__lists}{$list_account}{$list_name}{members} }, $meta{nick};
2819            }
2820
2821        } else {
2822            &error("invalid type ($type): $_");
2823        }
2824    }
2825
2826    # file was opened, so we tried to parse...
2827    close $fh;
2828
2829    # make sure the pid is removed from the waitpid list
2830    Irssi::pidwait_remove($child_pid);
2831
2832    # and that we don't leave any zombies behind, somehow
2833    waitpid( -1, WNOHANG );
2834
2835    &debug("new last_poll    = $last_poll{__poll}",
2836           "new last_poll_id = " . Dumper( $state{__last_id} )) if $is_update;
2837    if ($is_update and $first_call and not $settings{force_first}) {
2838        &debug("First call, not printing updates");
2839    } else {
2840
2841        if (exists $show_now{lists}) {
2842            for my $list_account (keys %{ $show_now{lists} }) {
2843                my $list_ac = ($list_account eq "$user\@$defservice" ? '' : "$list_account/");
2844                for my $list_name (keys %{ $show_now{lists}{$list_account} }) {
2845                    if (0 == @{ $state{__lists}{$list_account}{$list_name}{members} }) {
2846                        &notice(['info'], "List $list_ac$list_name is empty.");
2847                    } else {
2848                        &notice("List $list_ac$list_name members: " .
2849                                join(', ', @{ $state{__lists}{$list_account}{$list_name}{members} }));
2850                    }
2851                }
2852            }
2853        }
2854
2855        &write_lines(\@lines, $is_update);
2856    }
2857
2858    unlink $filename or warn "Failed to remove $filename: $!" unless &debug();
2859
2860    # commit the pending cache lines to the actual cache, now that
2861    # we've printed our output
2862    for my $updated_id (keys %new_cache) {
2863        $tweet_cache{$updated_id} = $new_cache{$updated_id};
2864    }
2865
2866    # keep enough cached tweets, to make sure we don't show duplicates
2867    for my $loop_id ( keys %tweet_cache ) {
2868        next if $tweet_cache{$loop_id} >= $last_poll{__poll} - 3600;
2869        delete $tweet_cache{$loop_id};
2870    }
2871
2872    if (not $got_errors) {
2873        &save_state();
2874    }
2875
2876    if ($is_update) {
2877        if ($failstatus and not $got_errors) {
2878            &notice([ 'deerror' ], "Update succeeded.");
2879            $failstatus    = 0;
2880        }
2881        $first_call        = 0;
2882        $update_is_running = 0;
2883    }
2884}
2885
2886sub cmp_id {
2887    my $id1 = shift;
2888    my $id2 = shift;
2889    return -1 if length $id1 < length $id2;
2890    return  1 if length $id1 > length $id2;
2891    return $id1 cmp $id2;
2892}
2893
2894sub write_lines {
2895    my $lines_ref       = shift;
2896    my $is_update       = shift;
2897    my $ymd_color = $irssi_to_mirc_colors{ $settings{ymd_color} };
2898    my @date_now = localtime();
2899    my $ymd_now = sprintf('%04d-%02d-%02d', $date_now[5]+1900, $date_now[4]+1, $date_now[3]);
2900    my $old_tf;
2901    #	&debug("line: " . Dumper $lines_ref);
2902    foreach my $line (@$lines_ref) {
2903        my $line_want_extras = $is_update;
2904        my $win_name = &window( $line->{type}, $line->{username}, $line->{nick}, $line->{topic} );
2905        my $ac_tag = '';
2906        if ( lc $line->{service} ne lc $settings{default_service} ) {
2907            $ac_tag = "$line->{username}: ";
2908        } elsif ( $line->{username} ne "$user\@$defservice"
2909                and lc $line->{account} ne lc $win_name ) {
2910            $ac_tag = $line->{account} . ': ';
2911        }
2912
2913        my @print_opts = (
2914            $line->{level},
2915            "twirssi_" . $line->{type},   # theme
2916            $ac_tag,
2917        );
2918        push @print_opts, (lc $line->{topic} ne lc $win_name ? $line->{topic} . ':' : '')
2919          if $line->{type} =~ /search/;
2920        push @print_opts, $line->{hi_nick} if $line->{type} ne 'error' and $line->{type} ne 'deerror';
2921        push @print_opts, $line->{marker} if defined $line->{marker};
2922
2923        # set timestamp
2924        if (not defined $line->{epoch}) {
2925            Irssi::window_find_name($settings{debug_win_name})->printformat(
2926                @print_opts, &hilight( $line->{text} ) . " \cC${ymd_color}BAD DATE\cO"
2927            );
2928            next;
2929        }
2930        my @date = localtime($line->{epoch});
2931        my $ymd  = sprintf('%04d-%02d-%02d', $date[5]+1900, $date[4]+1, $date[3]);
2932        my $ymd_suffix = '';
2933        if (defined $line->{ignoring}) {
2934            next if not $settings{debug};
2935            $line->{text} = "\cC$irssi_to_mirc_colors{'%b'}IGNORED\cO " . $line->{text};
2936            if ($settings{debug_win_name} ne '' ) {
2937                $win_name = $settings{debug_win_name};
2938            } else {
2939                $win_name = '(status)';
2940                $line->{text} = "%g[$IRSSI{name}] %n " . $line->{text};
2941            }
2942            $line_want_extras = 0;
2943        } elsif (not $is_update) {
2944            $ymd_suffix = " \cC$ymd_color$ymd\cO" if $ymd_now ne $ymd;
2945        } elsif (not defined $last_ymd{wins}{$win_name}
2946                  or $last_ymd{wins}{$win_name}->{ymd} ne $ymd) {
2947            Irssi::window_find_name($win_name)->printformat(MSGLEVEL_PUBLIC, 'twirssi_new_day', $ymd, '');
2948            $last_ymd{wins}{$win_name}->{ymd} = $ymd;
2949        }
2950        my $ts = DateTime->from_epoch( epoch => $line->{epoch}, time_zone => $local_tz
2951                                                    )->strftime($settings{timestamp_format});
2952        if (not defined $old_tf) {
2953            $old_tf = Irssi::settings_get_str('timestamp_format');
2954        }
2955        $line->{text} = &post_process_tweet($line->{text});
2956        Irssi::command("^set timestamp_format $ts");
2957        Irssi::window_find_name($win_name)->printformat(
2958            @print_opts, &hilight( $line->{text} ) . $ymd_suffix
2959        );
2960        if ($line_want_extras) {
2961            &write_log($line, $win_name, \@date);
2962            &write_channels($line, \@date);
2963        }
2964    }
2965    # recall timestamp format
2966    if (defined $old_tf) {
2967        Irssi::command("^set timestamp_format $old_tf");
2968    }
2969}
2970
2971sub write_channels {
2972    my $line = shift;
2973    my $date_ref = shift;
2974    my %msg_seen;
2975    for my $type ($line->{type}, 'sender', '*') {
2976        next unless defined $state{__channels}{$type};
2977        for my $tag (($type eq 'sender' ? $line->{nick}
2978                                        : ($line->{type} =~ /search/ ? $line->{topic}
2979                                                                     : $line->{username})),
2980                          '*') {
2981            next unless defined $state{__channels}{$type}{$tag};
2982            for my $net_tag (keys %{ $state{__channels}{$type}{$tag} }) {
2983                for my $channame (@{ $state{__channels}{$type}{$tag}{$net_tag} }) {
2984                    next if defined $msg_seen{$net_tag}{$channame};
2985                    my $server = Irssi::server_find_tag($net_tag);
2986                    $last_ymd{chans}{$channame} = {} if not defined $last_ymd{chans}{$channame};
2987                    for my $log_line (&log_format($line, $channame, $last_ymd{chans}{$channame}, $date_ref)) {
2988                        if (defined $server) {
2989                            $server->command("msg -$net_tag $channame $log_line");
2990                            $msg_seen{$net_tag}{$channame} = 1;
2991                        } else {
2992                            &notice("no server for $net_tag/$channame: $log_line");
2993                        }
2994                    }
2995                }
2996            }
2997        }
2998    }
2999}
3000
3001sub write_log {
3002    my $line = shift;
3003    my $win_name = shift;
3004    my $date_ref = shift;
3005    return unless my $logfile_obj = &ensure_logfile($win_name);
3006    my $fh = $logfile_obj->{fh};
3007    for my $log_line (&log_format($line, $logfile_obj->{filename}, $logfile_obj, $date_ref, 1)) {
3008        print $fh $log_line, "\n";
3009    }
3010}
3011
3012sub log_format {
3013    my $line = shift;
3014    my $target_name = shift;
3015    my $ymd_obj = shift;        # can be $last_ymd{chans}{$chan} or $logfile_obj (both need to have ->{ymd})
3016    my $date_ref = shift;
3017    my $to_file = shift;
3018
3019    my @logs = ();
3020
3021    my $ymd = sprintf('%04d-%02d-%02d', $date_ref->[5]+1900, $date_ref->[4]+1, $date_ref->[3]);
3022    if ($ymd_obj->{ymd} ne $ymd) {
3023        push @logs, "Day changed to $ymd (was ".$ymd_obj->{ymd}.")" if $ymd ne '';
3024        $ymd_obj->{ymd} = $ymd;
3025    }
3026
3027    my $out = '';
3028    $out .= sprintf('%02d:%02d:%02d ', $date_ref->[2], $date_ref->[1], $date_ref->[0]) if $to_file;
3029    if ( $line->{type} eq 'dm' ) {
3030        $out .= 'DM @' . $line->{hi_nick} . ':';
3031    } elsif ( $line->{type} eq 'search' or $line->{type} eq 'search_once' ) {
3032        $out .= '[' . ($target_name =~ /$line->{topic}/ ? '' : "$line->{topic}:")
3033                . '@' . $line->{hi_nick} . ']';
3034    } elsif ( $line->{type} eq 'tweet' or $line->{type} eq 'reply' ) {
3035        $out .= '<' . ($target_name =~ /$line->{account}/ ? '' : "$line->{account}:")
3036                . '@' . $line->{hi_nick} . '>';
3037    } else {
3038        $out .= 'ERR:';
3039    }
3040    push @logs, $out . ' ' . ($to_file ? &remove_colors($line->{text}) : $line->{text});
3041    return @logs;
3042}
3043
3044sub remove_colors {
3045    my $txt = shift;
3046    $txt =~ s/\cC\d{2}(.*?)\cO/$1/g;
3047    return $txt;
3048}
3049
3050sub save_state {
3051    # save state hash
3052    if ( keys %state and my $file = $settings{replies_store} ) {
3053        if ( open my $fh, '>', $file ) {
3054            print $fh encode_json( \%state );
3055            close $fh;
3056        } else {
3057            &error("Failed to write state to $file: $!");
3058        }
3059    }
3060    # save id hash
3061    if ( my $file = $settings{id_store} ) {
3062        if ( open my $fh, '>', $file ) {
3063            print $fh encode_json( \%tweet_cache );
3064            close $fh;
3065        } else {
3066            &error("Failed to write IDs to $file: $!");
3067        }
3068    }
3069}
3070
3071sub save_polls {
3072    # save last_poll hash
3073    if ( keys %last_poll and my $file = $settings{poll_store} ) {
3074        if ( open my $fh, '>', $file ) {
3075            print $fh encode_json( \%last_poll );
3076            close $fh;
3077        } else {
3078            &error("Failed to write polls to $file: $!");
3079        }
3080    }
3081}
3082
3083sub debug {
3084    return if not $settings{debug};
3085    my $fh;
3086    $fh = shift if ref($_[0]) eq 'GLOB';
3087    while (@_) {
3088        my $line = shift;
3089        next if not defined $line;
3090        chomp $line;
3091        for my $sub_line (split("\n", $line)) {
3092            next if $sub_line eq '';
3093            if ($fh) {
3094                print $fh 't:debug +', substr(time, -3), ' ', $sub_line, "\n";
3095            } elsif ($settings{debug_win_name} ne '') {
3096                my $dbg_win = $settings{debug_win_name};
3097                $dbg_win = $settings{window} if not &ensure_window($dbg_win);
3098                Irssi::window_find_name($dbg_win)->print(
3099                    $sub_line, MSGLEVEL_PUBLIC );
3100            } else {
3101                print "[$IRSSI{name}] ", $sub_line;
3102            }
3103        }
3104    }
3105    return 1;
3106}
3107
3108sub error {
3109    my $ref = $_[0];
3110    if (ref $ref) {
3111        shift;
3112        unshift @$ref, undef if 1 == @$ref and ref($ref->[0]) eq 'GLOB'; # [$fh] so add null tag
3113    } else {
3114        $ref = [];
3115    }
3116    &notice([ 'error', @$ref ], @_);
3117}
3118
3119sub notice {
3120    my ( $type, $tag, $fh, $theme );
3121    if ( ref $_[0] ) {
3122        ( $type, $tag, $fh ) = @{ shift @_ };
3123        $theme = 'twirssi_' . $type;
3124    }
3125    foreach my $msg (@_) {
3126        if (defined $fh) {
3127            for my $sub_line (split("\n", $msg)) {
3128                print $fh "t:$type ", ($tag ? "$tag " : '') . $sub_line, "\n" if $sub_line ne '';
3129            }
3130        } else {
3131            my $col = '%G';
3132            my $win_level = MSGLEVEL_PUBLIC;
3133            my $win;
3134            if ($tag eq '_tw_in_Win') {
3135                $win = Irssi::active_win();
3136            } elsif ($type eq 'crap') {
3137                $win = Irssi::window_find_name(&window());
3138                $col = '%R';
3139                $win_level = MSGLEVEL_CLIENTCRAP;
3140            } else {
3141                $win = Irssi::window_find_name(&window( $type, $tag ));
3142            }
3143
3144            if ($type =~ /^(error|info|deerror)$/) {
3145                $win->printformat(MSGLEVEL_PUBLIC, $theme, $msg); # theme
3146            } else {
3147                $win->print("${col}***%n $msg", $win_level );
3148            }
3149        }
3150    }
3151}
3152
3153sub update_away {
3154    my $data = shift;
3155
3156    if ( $data !~ /\@\w/ and $data !~ /^[dD] / ) {
3157        my $server = Irssi::server_find_tag( $settings{bitlbee_server} );
3158        if ($server) {
3159            $server->send_raw("away :$data");
3160            return 1;
3161        } else {
3162            &error("Can't find bitlbee server.",
3163                "Update bitlbee_server or disable tweet_to_away" );
3164            return 0;
3165        }
3166    }
3167
3168    return 0;
3169}
3170
3171sub too_long {
3172    my $data     = shift;
3173    my $alert_to = shift;
3174
3175    my $doing   = 'Tweet';
3176    my $max_len = $settings{tweet_max_chars};
3177    if ($alert_to and $alert_to->[0] eq 'dm') {
3178        # Twitter removed (more or less) the DM limit:
3179        # https://blog.twitter.com/official/en_us/a/2015/removing-the-140-character-limit-from-direct-messages.html
3180        $max_len = $settings{dm_max_chars};
3181        $doing   = 'DM';
3182    }
3183
3184    if ( length $data > $max_len ) {
3185        &notice( $alert_to,
3186            "$doing is " . ( length $data - $max_len ) .
3187                   " characters too long (max is " . $max_len .
3188                   " chars, attempt was " . length($data) . " chars) - aborted" )
3189          if defined $alert_to;
3190        return 1;
3191    }
3192
3193    return 0;
3194}
3195
3196sub make_utf8 {
3197    my $data = shift;
3198    if ( !utf8::is_utf8($data) ) {
3199        return decode &get_charset(), $data;
3200    } else {
3201        return $data;
3202    }
3203}
3204
3205sub valid_username {
3206    my $username = shift;
3207    my $orig_username = $username;
3208
3209    $username = &normalize_username($username);
3210
3211    unless ( exists $twits{$username} ) {
3212        &error( [$username], "Unknown username '$username' from '$orig_username'" );
3213        return;
3214    }
3215
3216    return $username;
3217}
3218
3219sub logged_in {
3220    my $obj = shift;
3221    unless ($obj) {
3222        &error( "Not logged in!  Use /twitter_login username" );
3223        return 0;
3224    }
3225
3226    return 1;
3227}
3228
3229sub sig_complete {
3230    my ( $complist, $window, $word, $linestart, $want_space ) = @_;
3231
3232    my $cmdchars = quotemeta Irssi::settings_get_str('cmdchars');
3233    my $comp_type = '';
3234    my $keep_at = 0;
3235    my $lc_stag = '';
3236
3237    my $cmd = '';
3238    my @args = ();
3239    my $want_account = 0;
3240    if ($linestart =~ m@^ [$cmdchars] (\S+?)(_as)? ((?: \s+ \S+ )*) \s* $@xi) {
3241        $cmd = lc $1;
3242        my $cmd_as = $2;
3243        my $args = $3;
3244        $args =~ s/^\s+//;
3245        @args = split(/\s+/, $args);
3246        if ($cmd_as) {
3247            if (@args) {
3248                # act as if "_as ac" is not there
3249                shift @args;
3250            } elsif ($cmd =~ /^(?:twitter|twirssi|tweet|dm|retweet)/) {
3251                $want_account = 1;
3252            }
3253        }
3254    }
3255
3256    if (not @args) {
3257        if ($want_account or grep { $cmd eq $_ } @{ $completion_types{'account'} }) {
3258            # '*_as' and 'account' types expect account as first arg
3259            $word =~ s/^@//;
3260            @$complist = grep /^\Q$word/i, map { s/\@.*// and $_ } keys %twits;
3261            return;
3262        }
3263        if (grep { $cmd eq $_ } @{ $completion_types{'tweet'} }) {
3264            # 'tweet' expects nick:num (we offer last num for each nick)
3265            $word =~ s/^@//;
3266            @$complist = map { "$_:$state{__indexes}{lc $_}" }
3267              sort { $nicks{$b} <=> $nicks{$a} }
3268                grep /^\Q$word/i, keys %{ $state{__indexes} };
3269            return;
3270        }
3271        if (grep { $cmd eq $_ } @{ $completion_types{'nick'} }) {
3272            # 'nick' expects a nick
3273            $comp_type = 'nick';
3274        }
3275    }
3276
3277    # retweet_to non-first args
3278    if ($cmd eq 'retweet_to') {
3279        if (@args == 1) {
3280            @$complist = grep /^\Q$word/i, map { "-$_->{tag}" } Irssi::servers();
3281            return;
3282        } elsif (@args == 2) {
3283            @$complist = grep /^\Q$word/i, qw/ -channel -nick /;
3284            return;
3285        } elsif (@args == 3 and $args[2] =~ m{^ -(channel|nick) $}x) {
3286            $lc_stag = lc $args[1];
3287            $lc_stag = substr($lc_stag, 1) if substr($lc_stag, 0, 1) eq '-';
3288            $comp_type = $1;
3289        }
3290    }
3291
3292    # twirssi_set_window twirssi_set_channel
3293    if ($cmd eq 'twirssi_set_window' or $cmd eq 'twirssi_set_channel') {
3294        my $set_type = substr($cmd, 12);
3295        if (@args == 0) {
3296            @$complist = grep /^\Q$word/i, @{ $valid_types{$set_type} };
3297            return;
3298        } elsif (@args == 1) {
3299            $comp_type = 'nick';
3300        } elsif (@args == 2) {
3301            if ($set_type eq 'window') {
3302                @$complist = map { $_->{name} || $_->{active}->{name} }
3303                             grep { my $n = $_->{name} || $_->{active}->{name}; $n =~ /^\Q$word\E/i } Irssi::windows();
3304                return;
3305            } elsif ($set_type eq 'channel') {
3306                $comp_type = $set_type;
3307            }
3308        }
3309    }
3310
3311    # anywhere in line...
3312    if (not $comp_type and grep { $cmd eq $_ } @{ $completion_types{'re_nick'} }) {
3313        # 're_nick' can have @nick anywhere
3314        $comp_type = 'nick';
3315        $keep_at = 1;
3316    }
3317
3318    if ($comp_type eq 'channel') {
3319        @$complist = map { $_->{name} }
3320                       grep { $_->{name} =~ /^\Q$word\E/i and ($lc_stag eq '' or lc($_->{server}->{tag}) eq $lc_stag) }
3321                         Irssi::channels();
3322        return;
3323    } elsif ($comp_type eq 'nick') {
3324        my $prefix = $1 if $word =~ s/^(@)//;
3325        @$complist = map { ($prefix and $keep_at) ? "$prefix$_" : $_ }
3326                       grep /^\Q$word/i, sort { $nicks{$b} <=> $nicks{$a} } keys %nicks;
3327        return;
3328    }
3329}
3330
3331sub event_send_text {
3332    my ( $line, $server, $win ) = @_;
3333    my $awin = Irssi::active_win();
3334
3335    # if the window where we got our text was the twitter window, and the user
3336    # wants to be lazy, tweet away!
3337    my $acc = &window_to_account( $awin->get_active_name() );
3338    if ( $acc and $settings{window_input} ) {
3339        &cmd_tweet_as( "$acc $line", $server, $win );
3340    }
3341}
3342
3343sub event_setup_changed {
3344    my $do_add = shift;	# first run, want to add, too
3345    my @changed_stgs = ();
3346
3347    foreach my $setting (@settings_defn) {
3348        my $setting_changed = 0;
3349        my $stg_type .= '_' . ($setting->[2] eq 'b' ? 'bool'
3350                                        : $setting->[2] eq 'i' ? 'int'
3351                                                : $setting->[2] eq 's' ? 'str' : '');
3352        if ($stg_type eq '_') {
3353            if ($do_add) {
3354                print        "ERROR: Bad opt '$setting->[2]' for $setting->[0]";
3355            } else {
3356                &error( "Bad opt '$setting->[2]' for $setting->[0]" );
3357            }
3358            next;
3359        }
3360
3361        my $stg_type_fn;
3362        if ($do_add) {
3363            $stg_type_fn = 'Irssi::settings_add' . $stg_type;	# settings_add_str, settings_add_int, settings_add_bool
3364            no strict 'refs';
3365            $settings{ $setting->[0] } = &$stg_type_fn( $IRSSI{name}, $setting->[1], $setting->[3] );
3366        }
3367
3368        my $prev_stg;
3369        {
3370            $prev_stg = $settings{ $setting->[0] };
3371            $stg_type_fn = 'Irssi::settings_get' . $stg_type;	# settings_get_str, settings_get_int, settings_get_bool
3372            no strict 'refs';
3373            $settings{ $setting->[0] } = &$stg_type_fn( $setting->[1] );
3374        }
3375        if ($setting->[2] eq 's') {
3376            my $pre_proc = $setting->[4];
3377            my $trim = 1;
3378            my $norm_user = 0;
3379            my $is_list = 0;
3380            while (defined $pre_proc and $pre_proc ne '') {
3381                if ($pre_proc =~ s/^lc(?:,|$)//) {
3382                    $settings{$setting->[0]} = lc $settings{$setting->[0]};
3383                } elsif ($pre_proc =~ s/^list\{(.)}(?:,|$)//) {
3384                    my $re = $1;
3385                    $re = qr/\s*$re\s*/ if $trim;
3386                    if ($settings{$setting->[0]} eq '') {
3387                        $settings{$setting->[0]} = [ ];
3388                    } else {
3389                        $settings{$setting->[0]} = [ split($re, $settings{$setting->[0]}) ];
3390                        if (grep { $_ eq $setting->[0] } ('passwords')) {
3391                            # ends '\', unescape separator:  concatenate with next
3392                            for (my $i = 0;  $i+1 < @{ $settings{$setting->[0]} };  $i++) {
3393                                while ( $settings{$setting->[0]}->[$i] =~ /\\$/ ) {
3394                                    $settings{$setting->[0]}->[$i] .= "," . delete $settings{$setting->[0]}->[$i+1];
3395                                }
3396                            }
3397                        }
3398                    }
3399                    $is_list = 1;
3400                } elsif ($pre_proc =~ s/^norm_user(?:,|$)//) {
3401                    $norm_user = 1;
3402                } elsif ($do_add) {
3403                    print        "ERROR: Bad opt pre-proc '$pre_proc' for $setting->[0]";
3404                } else {
3405                    &error( "Bad opt pre-proc '$pre_proc' for $setting->[0]" );
3406                }
3407                if ($norm_user) {
3408                    my @normed = ();
3409                    for my $to_norm ($is_list ? @{ $settings{$setting->[0]} } : $settings{$setting->[0]} ) {
3410                        next if $to_norm eq '';
3411                        &debug($setting->[0] . ' to_norm {' . $to_norm . '}');
3412                        push @normed, &normalize_username($to_norm, 1);
3413                    }
3414                    $is_list = 1;
3415                    $settings{$setting->[0]} = ($is_list ? \@normed : $normed[0]);
3416                }
3417            }
3418            if (Dumper($prev_stg) ne Dumper($settings{ $setting->[0] })) {
3419                $setting_changed = 1;
3420            }
3421        } elsif ($prev_stg != $settings{ $setting->[0] }) {
3422            $setting_changed = 1;
3423        }
3424        push @changed_stgs, $setting->[0] if $setting_changed and not $do_add;
3425        if ($setting_changed or $do_add) {
3426            if ($setting->[0] eq 'poll_interval'
3427                    or $setting->[0] eq 'poll_schedule' ) {
3428                &ensure_updates();
3429            }
3430        }
3431    }
3432    &debug('changed settings: ' . join(', ', @changed_stgs)) if @changed_stgs;
3433
3434    &ensure_logfile($settings{window});
3435
3436    if ($do_add or grep 'url_unshorten', @changed_stgs) {
3437        # want to load this in the parent to allow child to use it expediently
3438        &load_ua();
3439    }
3440    &debug("Settings changed ($do_add):" . Dumper \%settings);
3441}
3442
3443sub ensure_logfile() {
3444    my $win_name = shift;
3445    return unless $settings{logging};
3446    my $new_logfile = Irssi::settings_get_str('autolog_path');
3447    return if $new_logfile eq '';
3448    $new_logfile =~ s/^~/$ENV{HOME}/;
3449    $new_logfile = strftime($new_logfile, localtime());
3450    $new_logfile =~ s/\$(tag\b|\{tag\})/$IRSSI{name}/g;
3451    if ($new_logfile !~ s/\$(0\b|\{0\})/$win_name/g) {
3452        # not per-window logging, so use default window name as key
3453        $win_name = $settings{window};
3454    }
3455    return $logfile{$win_name} if defined $logfile{$win_name} and $new_logfile eq $logfile{$win_name}->{filename};
3456    return if not &ensure_dir_for($new_logfile);
3457    my $old_umask = umask(0177);
3458    &debug("Logging to $new_logfile");
3459    my $res;
3460    if ( my $fh = FileHandle->new( $new_logfile, '>>' ) ) {
3461        umask($old_umask);
3462        binmode $fh, ':utf8';
3463        $fh->autoflush(1);
3464        $res = $logfile{$win_name} = {
3465                'fh' => $fh,
3466                'filename' => $new_logfile,
3467                'ymd' => '',
3468        };
3469    } else {
3470        &error( "Failed to append to $new_logfile: $!" );
3471    }
3472    umask($old_umask);
3473    return $res;
3474}
3475
3476sub ensure_dir_for {
3477    my $path = shift;
3478    if (not $path =~ s@/[^/]+$@@) {
3479        &debug("Cannot cd up $path");
3480        return;
3481    }
3482    return 1 if $path eq '' or -d $path or $path eq '/';
3483    return if not &ensure_dir_for($path);
3484    if (not mkdir($path, 0700)) {
3485        &debug("Cannot make $path: $!");
3486        return;
3487    }
3488    return 1;
3489}
3490
3491sub get_poll_time {
3492    my $poll = $settings{poll_interval};
3493
3494    my $hhmm;
3495    foreach my $tuple ( @{ $settings{poll_schedule} } ) {
3496        if ( $tuple =~ /^(\d{4})-(\d{4}):(\d+)$/ ) {
3497            $hhmm = sprintf('%02d%02d', (localtime())[2,1]) if not defined $hhmm;
3498            my($range_from, $range_to, $poll_val) = ($1, $2, $3);
3499            if ( ( $hhmm ge $range_from and $hhmm lt $range_to )
3500                or ( $range_from gt $range_to
3501                    and ( $hhmm ge $range_from or $hhmm lt $range_to ) )
3502               ) {
3503                $poll = $poll_val;
3504            }
3505        }
3506    }
3507    return $poll if $poll >= 60;
3508    return 60;
3509}
3510
3511sub get_charset {
3512    my $charset = $settings{charset};
3513    return "utf8" if $charset =~ /^\s*$/;
3514    return $charset;
3515}
3516
3517my @available_nick_colors =(
3518    0, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13,
3519    '0,2', '0,3', '0,5', '0,6',
3520    '1,0', '1,3', '1,5', '1,6', '1,7', '1,10', '1,15',
3521    '2,3', '2,7', '2,10', '2,15',
3522    '3,2', '3,5', '3,10',
3523    '4,2', '4,7',
3524    '5,2', '5,3', '5,7', '5,10', '5,15',
3525    '6,2', '6,7', '6,10', '6,15',
3526    '8,2', '8,5', '8,6',
3527    '9,2', '9,5', '9,6',
3528    '10,2', '10,5', '10,6',
3529    '11,2', '11,5', '11,6',
3530    '12,2', '12,5',
3531    '13,2', '13,15',
3532    '14,2', '14,5', '14,6',
3533    '15,2', '15,5', '15,6'
3534);
3535my %nick_colors;
3536
3537sub get_nick_color {
3538    if ($settings{nick_color} eq 'rotate') {
3539        my $nick = shift;
3540
3541        if (!defined $nick_colors{$nick}) {
3542            my @chars = split //, lc $nick;
3543            my $value = 0;
3544            foreach my $char (@chars) {
3545                $value += ord $char;
3546            }
3547            $nick_colors{$nick} = $available_nick_colors[$value % @available_nick_colors];
3548        }
3549        return $nick_colors{$nick};
3550    } else {
3551        return $irssi_to_mirc_colors{$settings{nick_color}};
3552    }
3553}
3554
3555sub hilight {
3556    my $text = shift;
3557
3558    if ( $settings{nick_color} ) {
3559        $text =~ s[(^|\W)\@(\w+)] {
3560            my $c = get_nick_color($2);
3561            qq[$1\cC$c\@$2\cO];
3562        }eg;
3563    }
3564    if ( $settings{topic_color} ) {
3565        my $c = $settings{topic_color};
3566        $c = $irssi_to_mirc_colors{$c};
3567        $text =~ s/(^|\W)(\#|\!)([-\w]+)/$1\cC$c$2$3\cO/g if $c;
3568    }
3569    $text =~ s/[\n\r]/ /g;
3570
3571    return $text;
3572}
3573
3574sub shorten {
3575    my $data = shift;
3576
3577    my $provider = $settings{url_provider};
3578    if ( ( $settings{always_shorten} or &too_long($data) ) and $provider ) {
3579        my @args;
3580        if ( $provider eq 'Bitly' ) {
3581            @args[ 1, 2 ] = split ',', $settings{url_args}, 2;
3582            unless ( @args == 3 ) {
3583                &notice([ 'crap' ],
3584                    "WWW::Shorten::Bitly requires a username and API key.",
3585                    "Set short_url_args to username,API_key or change your",
3586                    "short_url_provider."
3587                );
3588                return &make_utf8($data);
3589            }
3590        }
3591
3592        foreach my $url ( $data =~ /(https?:\/\/\S+[\w\/])/g ) {
3593            eval {
3594                $args[0] = $url;
3595                my $short = makeashorterlink(@args);
3596                if ($short) {
3597                    $data =~ s/\Q$url/$short/g;
3598                } else {
3599                    &error( "Failed to shorten $url!" );
3600                }
3601            };
3602        }
3603    }
3604
3605    return &make_utf8($data);
3606}
3607
3608
3609sub load_ua {
3610    return if defined $ua or not @{ $settings{url_unshorten} };
3611    &notice("Loading LWP and ua...");
3612    eval "use LWP;";
3613    $ua = LWP::UserAgent->new(
3614        env_proxy => 1,
3615        timeout => 10,
3616        agent => "$IRSSI{name}/$VERSION",
3617        requests_redirectable => [],
3618    );
3619}
3620
3621
3622sub is_url_from_shortener {
3623    my $url = shift;
3624    return unless @{ $settings{url_unshorten} }
3625           and $url =~ s@^https?://([\w.]+)/.*@lc $1@e;
3626    return grep { $url eq $_ } @{ $settings{url_unshorten} };
3627}
3628
3629
3630sub get_url_parts {
3631    my $url = shift;
3632    my @parts = ($url =~ m@^(https?)://([^/]+)/(.+)@i);
3633    $parts[0] = lc $parts[0];
3634    $parts[1] = lc $parts[1];
3635    return @parts;
3636}
3637
3638
3639sub get_unshorten_urls {
3640    my $text = shift;
3641    my $fh   = shift;
3642    return unless @{ $settings{url_unshorten} };
3643    foreach my $url ( $text =~ m@\b(https?://\S+[\w/])@g ) {
3644        my @orig_url_parts;
3645        my @url_parts;
3646        my $new_url = $url;
3647        my $max_redir = 4;
3648        my $resp;
3649        while ($max_redir-- > 0
3650                and @url_parts = &get_url_parts($new_url)
3651                and grep { $url_parts[1] eq $_ } @{ $settings{url_unshorten} }
3652                and not defined $expanded_url{$url_parts[1]}{$url_parts[0] eq 'https' ? 1 : 0}{$url_parts[2]}
3653                and $resp = $ua->head($new_url)
3654                and (defined $resp->header('Location')
3655                     or (&debug($fh, "cut_short $new_url => " . $resp->header('Host')) and 0)
3656                    )) {
3657            &debug($fh, "deshort $new_url => " . $resp->header('Location'));
3658            @orig_url_parts = @url_parts if not @orig_url_parts;
3659            $new_url = $resp->header('Location');
3660        }
3661        if (@orig_url_parts) {
3662            $expanded_url{$orig_url_parts[1]}{$orig_url_parts[0] eq 'https' ? 1 : 0}{$orig_url_parts[2]} = {
3663                url => $new_url,
3664                epoch => time,
3665            };
3666        }
3667    }
3668}
3669
3670
3671sub put_unshorten_urls {
3672    my $fh    = shift;
3673    my $epoch = shift;
3674    for my $site (keys %expanded_url) {
3675        for my $https (keys %{ $expanded_url{$site} }) {
3676            for my $uri (keys %{ $expanded_url{$site}{$https} }) {
3677                next if $expanded_url{$site}{$https}{$uri}{epoch} < $epoch;
3678                print $fh "t:url epoch:$expanded_url{$site}{$https}{$uri}{epoch} ",
3679                      ($https ? 'https:1 ' : ''),
3680                      "site:$site uri:$uri $expanded_url{$site}{$https}{$uri}{url}\n";
3681            }
3682        }
3683    }
3684}
3685
3686
3687sub post_process_tweet {
3688    my $data = shift;
3689    my $skip_unshorten = shift;
3690    if (@{ $settings{url_unshorten} } and not $skip_unshorten) {
3691        for my $site (keys %expanded_url) {
3692            for my $https (keys %{ $expanded_url{$site} }) {
3693                my $url = ($https ? 'https' : 'http') . '://' . $site . '/';
3694                next if -1 == index($data, $url);
3695                for my $uri (keys %{ $expanded_url{$site}{$https} }) {
3696                    $data =~ s/\Q$url$uri\E/$& \cC$irssi_to_mirc_colors{$settings{unshorten_color}}<$expanded_url{$site}{$https}{$uri}{url}>\cO/g;
3697                }
3698            }
3699        }
3700    }
3701    return &make_utf8($data);
3702}
3703
3704
3705sub normalize_username {
3706    my $user      = shift;
3707    my $non_login = shift;
3708    return '' if $user eq '';
3709
3710    my ( $username, $service ) = split /\@/, lc($user), 2;
3711    if ($service) {
3712        $service = ucfirst $service;
3713    } else {
3714        $service = ucfirst lc $settings{default_service};
3715        unless ( $non_login or exists $twits{"$username\@$service"} ) {
3716            $service = undef;
3717            foreach my $t ( sort keys %twits ) {
3718                next unless $t =~ /^\Q$username\E\@(Twitter|Identica)/;
3719                $service = $1;
3720                last;
3721            }
3722
3723            unless ($service) {
3724                &error( "Can't find a logged in user '$user'" );
3725                return "$username\@$settings{default_service}";
3726            }
3727        }
3728    }
3729
3730    return "$username\@$service";
3731}
3732
3733sub get_text {
3734    my $tweet  = shift;
3735    my $object = shift;
3736    my $text   = decode_entities( get_full_text($tweet) );
3737    if ( exists $tweet->{retweeted_status} ) {
3738        $text = &format_expand(
3739                fmt   => $settings{retweeted_format} || $settings{retweet_format},
3740                nick  => $tweet->{retweeted_status}{user}{screen_name}, data => '',
3741                tweet => decode_entities( get_full_text($tweet->{retweeted_status}) ),
3742        );
3743    } elsif ( $tweet->{truncated} and ( $object->isa('Net::Twitter') or $object->isa('Twitter::API') ) ) {
3744        $text .= " -- http://twitter.com/$tweet->{user}{screen_name}"
3745          . "/status/$tweet->{id}";
3746    }
3747
3748    $text =~ s/[\n\r]/ /g;
3749
3750    return $text;
3751}
3752
3753sub get_full_text {
3754    my $t  = shift;
3755    return defined($t->{full_text}) ? $t->{full_text} : $t->{text};
3756}
3757
3758sub window {
3759    my $type  = shift || "default";
3760    my $uname = shift || "default";
3761    my $sname = lc(shift);
3762    my $topic = lc(shift || '');
3763
3764    $type = "search" if $type eq 'search_once';
3765    $type = "error" if $type eq 'deerror';
3766
3767    my $win;
3768    my @all_priorities = qw/ account sender list /;
3769    my @win_priorities = split ',', $settings{window_priority};
3770    my $done_rest = 0;
3771    while (@win_priorities and not defined $win) {
3772        my $win_priority = shift @win_priorities;
3773        if ($win_priority eq 'account') {
3774            for my $type_iter ($type, 'default') {
3775                next unless exists $state{__windows}{$type_iter};
3776                $win =
3777                     $state{__windows}{$type_iter}{$uname}
3778                  || $state{__windows}{$type_iter}{$topic}
3779                  || $state{__windows}{$type_iter}{$user}
3780                  || $state{__windows}{$type_iter}{default};
3781                last if defined $win or $type_iter eq 'default';
3782            }
3783        } elsif ($win_priority eq 'sender') {
3784            if (defined $sname
3785                    and defined $state{__windows}{$win_priority}{$sname}) {
3786                $win = $state{__windows}{$win_priority}{$sname};
3787            }
3788        } elsif ($win_priority eq 'list') {
3789            if (defined $sname
3790                    and defined $state{__windows}{$win_priority}{$sname}) {
3791                $win = $state{__windows}{$win_priority}{$sname};
3792            }
3793        }
3794        if (not defined $win and not @win_priorities and not $done_rest) {
3795            $done_rest = 1;
3796            for my $check_priority (@all_priorities) {
3797                if (not grep { $check_priority eq $_ } split ',', $settings{window_priority}) {
3798                    push @win_priorities, $check_priority;
3799                }
3800            }
3801        }
3802    }
3803    $win = $settings{window} if not defined $win;
3804    if (not &ensure_window($win, '_tw_in_Win')) {
3805        $win = $settings{window};
3806    }
3807
3808    # &debug("window($type, $uname, $sname, $topic) -> $win");
3809    return $win;
3810}
3811
3812sub ensure_window {
3813    my $win = shift;
3814    my $using_win = shift;
3815    return $win if Irssi::window_find_name($win);
3816    &notice([ 'crap', $using_win ], "Creating window '$win'.");
3817    my $newwin = Irssi::Windowitem::window_create( $win, 1 );
3818    if (not $newwin) {
3819        &error([ $using_win ], "Failed to create window $win!");
3820        return;
3821    }
3822    $newwin->set_name($win);
3823    return $win;
3824}
3825
3826sub window_to_account {
3827    my $name = shift;
3828
3829    foreach my $type ( keys %{ $state{__windows} } ) {
3830        foreach my $uname ( keys %{ $state{__windows}{$type} } ) {
3831            if ( lc $state{__windows}{$type}{$uname} eq lc $name ) {
3832                return $uname;
3833            }
3834        }
3835    }
3836
3837    if ( lc $name eq $settings{window} ) {
3838        return $user;
3839    }
3840
3841    return;
3842}
3843
3844sub read_json {
3845    my $file = shift;
3846    my $store = shift;
3847    my $desc = shift;
3848    if ( $file and -r $file ) {
3849        if ( open( my $fh, '<', $file ) ) {
3850            my $json;
3851            do { local $/; $json = <$fh>; };
3852            close $fh;
3853            eval {
3854                my $ref = decode_json($json);
3855                %$store = %$ref;
3856            };
3857        } else {
3858            &error( "Failed to load $desc from $file: $!" );
3859        }
3860    }
3861}
3862
3863Irssi::signal_add( "send text",     "event_send_text" );
3864Irssi::signal_add( "setup changed", "event_setup_changed" );
3865
3866Irssi::theme_register( # theme
3867    [
3868        'twirssi_tweet',       '[$0%B@$1%n$2] $3',
3869        'twirssi_search',      '[$0%r$1%n%B@$2%n$3] $4',
3870        'twirssi_search_once', '[$0%r$1%n%B@$2%n$3] $4',
3871        'twirssi_reply',       '[$0\--> %B@$1%n$2] $3',
3872        'twirssi_dm',          '[$0%r@$1%n (%WDM%n)] $2',
3873        'twirssi_error',       '%RERROR%n: $0',
3874        'twirssi_deerror',     '%RUPDATE%n: $0',
3875        'twirssi_info',        '%CINFO:%N $0',
3876        'twirssi_new_day',     '%CDay changed to $0%N',
3877    ]
3878);
3879
3880$last_poll{__poll} = time - &get_poll_time;
3881
3882&event_setup_changed(1);
3883if ( Irssi::window_find_name(window()) ) {
3884    Irssi::command_bind( "dm",                         "cmd_direct" );
3885    Irssi::command_bind( "dm_as",                      "cmd_direct_as" );
3886    Irssi::command_bind( "tweet",                      "cmd_tweet" );
3887    Irssi::command_bind( "tweet_as",                   "cmd_tweet_as" );
3888    Irssi::command_bind( "retweet",                    "cmd_retweet" );
3889    Irssi::command_bind( "retweet_as",                 "cmd_retweet_as" );
3890    Irssi::command_bind( "retweet_to",                 "cmd_retweet_to_window" );
3891    Irssi::command_bind( "twitter_broadcast",          "cmd_broadcast" );
3892    Irssi::command_bind( "twitter_info",               "cmd_info" );
3893    Irssi::command_bind( "twitter_user",               "cmd_user" );
3894    Irssi::command_bind( "twitter_reply",              "cmd_reply" );
3895    Irssi::command_bind( "twitter_reply_as",           "cmd_reply_as" );
3896    Irssi::command_bind( "twitter_login",              "cmd_login" );
3897    Irssi::command_bind( "twitter_logout",             "cmd_logout" );
3898    Irssi::command_bind( "twitter_search",             "cmd_search" );
3899    Irssi::command_bind( "twitter_listinfo",           "cmd_listinfo" );
3900    Irssi::command_bind( "twitter_dms",                "cmd_dms" );
3901    Irssi::command_bind( "twitter_dms_as",             "cmd_dms_as" );
3902    Irssi::command_bind( "twitter_switch",             "cmd_switch" );
3903    Irssi::command_bind( "twitter_subscribe",          "cmd_add_search" );
3904    Irssi::command_bind( "twitter_unsubscribe",        "cmd_del_search" );
3905    Irssi::command_bind( "twitter_list_subscriptions", "cmd_list_search" );
3906    Irssi::command_bind( "twirssi_upgrade",            "cmd_upgrade" );
3907    Irssi::command_bind( "twirssi_reload",             "cmd_reload" );
3908    Irssi::command_bind( "twirssi_oauth",              "cmd_oauth" );
3909    Irssi::command_bind( "twitter_updates",            "get_updates" );
3910    Irssi::command_bind( "twitter_add_follow_extra",   "cmd_add_follow" );
3911    Irssi::command_bind( "twitter_del_follow_extra",   "cmd_del_follow" );
3912    Irssi::command_bind( "twitter_list_follow_extra",  "cmd_list_follow" );
3913    Irssi::command_bind( "twirssi_set_channel",        "cmd_set_channel" );
3914    Irssi::command_bind( "twirssi_list_channels",      "cmd_list_channels" );
3915    Irssi::command_bind( "twirssi_set_window",         "cmd_set_window" );
3916    Irssi::command_bind( "twirssi_list_windows",       "cmd_list_windows" );
3917    Irssi::command_bind( "twirssi_wipe",               "cmd_wipe" );
3918    Irssi::command_bind( "bitlbee_away",               "update_away" );
3919    if ( $settings{use_reply_aliases} ) {
3920        Irssi::command_bind( "reply",    "cmd_reply" );
3921        Irssi::command_bind( "reply_as", "cmd_reply_as" );
3922    }
3923    Irssi::command_bind(
3924        "twirssi_dump",
3925        sub {
3926            &debug( "twits: ", join ", ",
3927              map { "u: $_\@" . ref($twits{$_}) } keys %twits );
3928            &debug( "selected: $user\@$defservice" );
3929            &debug( "friends: ", Dumper \%friends );
3930            &debug( "blocks: ", Dumper \%blocks );
3931            &debug( "nicks: ",   join ", ", sort keys %nicks );
3932            &debug( "searches: ", join(';  ', map { $state{__last_id}{$_}{__search} and "$_ : " . join(', ', keys %{ $state{__last_id}{$_}{__search} }) } keys %{ $state{__last_id} } ));
3933            &debug( "windows: ",  Dumper \%{ $state{__windows} } );
3934            &debug( "channels: ",  Dumper \%{ $state{__channels} } );
3935            &debug( "u_info ",  Dumper \%{ $state{__u} } );
3936            &debug( "id_info ",  Dumper \%{ $state{__i} } );
3937            &debug( "lists: ", Dumper \%{ $state{__lists} } );
3938            &debug( "settings: ",  Dumper \%settings );
3939            &debug( "last poll: ", Dumper \%last_poll );
3940            if ( open my $fh, '>', "/tmp/$IRSSI{name}.cache.txt" ) {
3941                print $fh Dumper \%tweet_cache;
3942                close $fh;
3943                &notice([ 'crap' ], "cache written out to /tmp/$IRSSI{name}.cache.txt");
3944            }
3945            if ( open my $fh, '>', "$settings{dump_store}" ) {
3946                print $fh Dumper \%state;
3947                close $fh;
3948                &notice([ 'crap' ], "state written out to $settings{dump_store}");
3949            }
3950        }
3951    );
3952    Irssi::command_bind(
3953        "twirssi_version",
3954        sub {
3955            &notice(
3956                "$IRSSI{name} v$VERSION; "
3957                  . (
3958                    $Twitter::API::VERSION
3959                    ? "Twitter::API v$Twitter::API::VERSION. "
3960                    : ""
3961                  )
3962                  . (
3963                    $Net::Twitter::VERSION
3964                    ? "Net::Twitter v$Net::Twitter::VERSION. "
3965                    : ""
3966                  )
3967                  . (
3968                    $Net::Identica::VERSION
3969                    ? "Net::Identica v$Net::Identica::VERSION. "
3970                    : ""
3971                  )
3972                  . "JSON in use: "
3973                  . ref(JSON::MaybeXS->new())
3974                  . ".  See details at http://twirssi.com/"
3975            );
3976        }
3977    );
3978    Irssi::command_bind(
3979        "twitter_delete",
3980        &gen_cmd(
3981            "/twitter_delete <username:id>",
3982            "destroy_status",
3983            sub { &notice( ["tweet"], "Tweet deleted." ); },
3984            sub {
3985                my ( $nick, $num ) = split /:/, lc $_[0], 2;
3986                return $state{__last_id}{ &normalize_username($nick) }{__sent} unless defined $num;
3987                return $state{__ids}{$nick}[$num];
3988            }
3989        )
3990    );
3991    Irssi::command_bind(
3992        "twitter_fav",
3993        &gen_cmd(
3994            "/twitter_fav <username:id>",
3995            "create_favorite",
3996            sub { &notice( ["tweet"], "Tweet favorited." ); },
3997            sub {
3998                my ( $nick, $num ) = split ':', lc $_[0], 2;
3999                return $state{__last_id}{ &normalize_username($nick) }{__sent} unless defined $num;
4000                return $state{__ids}{$nick}[$num];
4001            }
4002        )
4003    );
4004    Irssi::command_bind(
4005        "twitter_unfav",
4006        &gen_cmd(
4007            "/twitter_unfav <username:id>",
4008            "destroy_favorite",
4009            sub { &notice( ["tweet"], "Tweet un-favorited." ); },
4010            sub {
4011                my ( $nick, $num ) = split ':', lc $_[0], 2;
4012                return $state{__last_id}{ &normalize_username($nick) }{__sent} unless defined $num;
4013                return $state{__ids}{$nick}[$num];
4014            }
4015        )
4016    );
4017    Irssi::command_bind(
4018        "twitter_follow",
4019        &gen_cmd(
4020            "/twitter_follow [-w] <username>",
4021            "create_friend",
4022            sub {
4023                &notice( ["tweet", "$user\@$defservice"],
4024                         "Following $_[0]" );
4025                $nicks{ $_[0] } = time;
4026                &cmd_user(@_);
4027            },
4028            sub {
4029                &cmd_set_window("sender $_[0] $_[0]", $_[1], $_[2])
4030                        if $_[0] =~ s/^\s*-w\s+// and $_[0] ne '';
4031                return $_[0];
4032            }
4033        )
4034    );
4035    Irssi::command_bind(
4036        "twitter_unfollow",
4037        &gen_cmd(
4038            "/twitter_unfollow <username>",
4039            "destroy_friend",
4040            sub {
4041                &notice( ["tweet"], "Stopped following $_[0]" );
4042                delete $nicks{ $_[0] };
4043            }
4044        )
4045    );
4046    Irssi::command_bind(
4047        "twitter_device_updates",
4048        &gen_cmd(
4049            "/twitter_device_updates none|im|sms",
4050            "update_delivery_device",
4051            sub { &notice( ["tweet"], "Device updated to $_[0]" ); }
4052        )
4053    );
4054    Irssi::command_bind(
4055        "twitter_block",
4056        &gen_cmd(
4057            "/twitter_block <username>",
4058            "create_block",
4059            sub { &notice( ["tweet"], "Blocked $_[0]" ); }
4060        )
4061    );
4062    Irssi::command_bind(
4063        "twitter_unblock",
4064        &gen_cmd(
4065            "/twitter_unblock <username>",
4066            "destroy_block",
4067            sub { &notice( ["tweet"], "Unblock $_[0]" ); }
4068        )
4069    );
4070    Irssi::command_bind(
4071        "twitter_spam",
4072        &gen_cmd(
4073            "/twitter_spam <username>",
4074            "report_spam",
4075            sub { &notice( ["tweet"], "Reported $_[0] for spam" ); }
4076        )
4077    );
4078
4079    %completion_types = (
4080        'account' => [
4081            'twitter_switch',
4082        ],
4083        'tweet' => [
4084            'retweet',
4085            'retweet_to',
4086            'twitter_delete',
4087            'twitter_fav',
4088            'twitter_info',
4089            'twitter_reply',
4090            'twitter_unfav',
4091        ],
4092        'nick' => [
4093            'dm',
4094            'twitter_block',
4095            'twitter_add_follow_extra',
4096            'twitter_del_follow_extra',
4097            'twitter_follow',
4098            'twitter_spam',
4099            'twitter_unblock',
4100            'twitter_unfollow',
4101            'twitter_user',
4102            'twitter_dms',	# here for twitter_dms_as
4103        ],
4104        're_nick' => [
4105            'dm',
4106            'retweet',
4107            'tweet',
4108        ],
4109    );
4110    push @{ $completion_types{'tweet'} }, 'reply' if $settings{use_reply_aliases};
4111
4112    Irssi::signal_add_last( 'complete word' => \&sig_complete );
4113
4114    &notice(
4115        "  %Y<%C(%B^%C)%N                   TWIRSSI v%R$VERSION%N",
4116        "   %C(_(\\%N           http://twirssi.com/ for full docs",
4117        "    %Y||%C `%N Log in with /twitter_login, send updates with /tweet"
4118    );
4119
4120    my $file = $settings{replies_store};
4121    if ( $file and -r $file ) {
4122        if ( open( my $fh, '<', $file ) ) {
4123            my $json;
4124            do { local $/; $json = <$fh>; };
4125            close $fh;
4126            eval {
4127                my $ref = decode_json($json);
4128                %state = %$ref;
4129                # fix legacy vulnerable ids
4130                for (grep !/^__\w+$/, keys %state) { $state{__ids}{$_} = $state{$_}; delete $state{$_}; }
4131                # # remove legacy broken searches (without service name)
4132                # map { /\@/ or delete $state{__searches}{$_} } keys %{$state{__searches}};
4133                # convert legacy/broken window tags (without @service, or unnormalized)
4134                for my $type (keys %{$state{__windows}}) {
4135                    next if $type eq 'search' or $type eq 'sender';
4136                    for my $tag (keys %{$state{__windows}{$type}}) {
4137                        next if $tag eq 'default';
4138                        my $new_tag = &normalize_username($tag);
4139                        next if -1 == index($new_tag, '@') or $new_tag eq $tag;
4140                        $state{__windows}{$type}{$new_tag} = $state{__windows}{$type}{$tag};
4141                        delete $state{__windows}{$type}{$tag};
4142                    }
4143                }
4144                my $num = keys %{ $state{__indexes} };
4145                &notice( sprintf "Loaded old replies from %d contact%s.",
4146                    $num, ( $num == 1 ? "" : "s" ) );
4147                &cmd_list_search;
4148                &cmd_list_follow;
4149            };
4150        } else {
4151            &error( "Failed to load old replies from $file: $!" );
4152        }
4153    }
4154
4155    &read_json($settings{poll_store}, \%last_poll, "prev. poll times");
4156    &read_json($settings{id_store}, \%tweet_cache, "cached IDs");
4157
4158    if ( my $provider = $settings{url_provider} ) {
4159        &notice("Loading WWW::Shorten::$provider...");
4160        eval "use WWW::Shorten::$provider;";
4161
4162        if ($@) {
4163            &error( "Failed to load WWW::Shorten::$provider - either clear",
4164                "short_url_provider or install the CPAN module");
4165        }
4166    }
4167
4168    if ( @{ $settings{usernames} } ) {
4169        &cmd_login();
4170        &ensure_updates(15) if keys %twits;
4171    }
4172
4173} else {
4174    Irssi::active_win()
4175      ->print( "Create a window named "
4176          . $settings{window}
4177          . " or change the value of twitter_window.  Then, reload $IRSSI{name}." );
4178}
4179
4180# vim: set sts=4 expandtab:
4181