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 ¬ice( ["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 ¬ice( ["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 ¬ice( [ "dm", $target_norm ], "DM to $target failed" ); 288 return; 289 } 290 ¬ice( [ "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 ¬ice( [ "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 ¬ice( ["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 ¬ice( [ "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 ¬ice( [ "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 ¬ice( [ "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 ¬ice( [ "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 ¬ice( [ "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 ¬ice( [ "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 ¬ice( [ "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 ¬ice( [ "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 ¬ice( [ "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 ¬ice( ["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 ¬ice( ["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 ¬ice( [ "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 ¬ice( [ "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 ¬ice( ["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 ¬ice( [ "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 ¬ice( [ "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 ¬ice( [ "info" ], ",--------- $nick:$id" ); 615 ¬ice( [ "info" ], "| nick: $nick_orig <http://twitter.com/$nick_orig>" ); 616 ¬ice( [ "info" ], "| id: $statusid" . ($url ? " <$url>" : '')); 617 ¬ice( [ "info" ], "| time: " . ($timestamp 618 ? DateTime->from_epoch( epoch => $timestamp, time_zone => $local_tz) 619 : '<unknown>') ); 620 ¬ice( [ "info" ], "| account: " . ($username ? $username : '<unknown>' ) ); 621 ¬ice( [ "info" ], "| text: " . ($tweet ? $tweet : '<unknown>' ) ); 622 ¬ice( [ "info" ], "| +url: " . $exp_tweet ) if $exp_tweet ne $tweet; 623 624 if ($reply_to_id and $reply_to_user) { 625 ¬ice( [ "info" ], "| ReplyTo: $reply_to_user:$reply_to_id" ); 626 ¬ice( [ "info" ], "| thread: http://twitter.theinfo.org/$statusid"); 627 } 628 ¬ice( [ "info" ], "`---------" ); 629} 630 631sub cmd_reply { 632 my ( $data, $server, $win ) = @_; 633 634 $data =~ s/^\s+|\s+$//; 635 unless ($data) { 636 ¬ice( ["reply"], "Usage: /reply <nick[:num]> <update>" ); 637 return; 638 } 639 640 ( my $id, $data ) = split ' ', $data, 2; 641 unless ( $id and $data ) { 642 ¬ice( ["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 ¬ice( ["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 ¬ice( [ "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 ¬ice( [ "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 ¬ice( [ "reply", $username ], "Update failed" ); 697 $success = 0; 698 } 699 }; 700 return unless $success; 701 702 if ($@) { 703 ¬ice( [ "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 ¬ice( [ "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 ¬ice("Usage: $usage_str"); 733 return; 734 } 735 736 my $success = 1; 737 eval { 738 unless ( $twit->$api_name($data) ) { 739 ¬ice("$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 ¬ice("Getting list: '$list_ac$list_name'"); 764 } else { 765 ¬ice("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 ¬ice( [ "search", $data ], "Search is already queued" ); 785 return; 786 } 787 $search_once{$username}->{$data} = $settings{search_results}; 788 ¬ice( [ "search", $data ], "Searching for '$data'" ); 789 &get_updates([ 0, [ 790 [ $username, { up_searches => [ $data ] } ], 791 ], 792 ]); 793 } else { 794 ¬ice( ["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 ¬ice( ['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 ¬ice( [ '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 ¬ice( [ "tweet", $data ], "Switching to $data" ); 836 $twit = $twits{$data}; 837 if ( $data =~ /(.*)\@(.*)/ ) { 838 $user = $1; 839 $defservice = $2; 840 } else { 841 ¬ice( [ "tweet", $data ], 842 "Couldn't figure out what service '$data' is on" ); 843 } 844 } else { 845 ¬ice( ["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 ¬ice( [ "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 ¬ice( ["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 ¬ice( ["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 ¬ice( 1120 [ "tweet", "$user\@$service" ], 1121 "Login as $user\@$service failed: $msg" 1122 ); 1123 1124 if ( not $settings{avoid_ssl} ) { 1125 ¬ice( 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 ¬ice( ["tweet"], "Already following all replies by \@$data" ); 1173 return; 1174 } 1175 1176 $state{__last_id}{"$user\@$defservice"}{__extras}{$data} = 1; 1177 ¬ice( ["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 ¬ice( ["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 ¬ice( ["tweet"], "Following all replies as $suser: $frusers" ); 1211 } 1212 } 1213 1214 unless ($found) { 1215 ¬ice( ["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 ¬ice( ["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 ¬ice( ["search"], "Usage: /twitter_subscribe [-w] <topic>" ); 1237 return; 1238 } 1239 1240 if ( exists $state{__last_id}{"$user\@$defservice"}{__search}{$data} ) { 1241 ¬ice( [ "search", $data ], 1242 "Already had a subscription for '$data'" ); 1243 return; 1244 } 1245 1246 $state{__last_id}{"$user\@$defservice"}{__search}{$data} = 1; 1247 ¬ice( [ "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 ¬ice( ["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 ¬ice( ["search"], "Usage: /twitter_unsubscribe <topic>" ); 1270 return; 1271 } 1272 1273 unless ( exists $state{__last_id}{"$user\@$defservice"}{__search}{$data} ) { 1274 ¬ice( [ "search", $data ], "No subscription found for '$data'" ); 1275 return; 1276 } 1277 1278 delete $state{__last_id}{"$user\@$defservice"}{__search}{$data}; 1279 ¬ice( [ "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 ¬ice( ["search"], "Search subscriptions for $suser: $topics" ); 1294 } 1295 } 1296 1297 unless ($found) { 1298 ¬ice( ["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 ¬ice( ["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 ¬ice( ["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 ¬ice( ["notice"], 1379 "Download complete. Reload twirssi with /twirssi_reload" ); 1380} 1381 1382sub cmd_list_channels { 1383 my ( $data, $server, $win ) = @_; 1384 1385 ¬ice("Current output channels:"); 1386 foreach my $type ( sort keys %{ $state{__channels} } ) { 1387 ¬ice("$type:"); 1388 foreach my $tag ( sort keys %{ $state{__channels}{$type} } ) { 1389 ¬ice(" $tag:"); 1390 foreach my $net_tag ( sort keys %{ $state{__channels}{$type}{$tag} } ) { 1391 ¬ice(" $net_tag: " 1392 . join ', ', @{ $state{__channels}{$type}{$tag}{$net_tag} }); 1393 } 1394 } 1395 } 1396 ¬ice("Add new entries using /twirssi_set_channel " 1397 . "[[-]type|*] [account|search_term|*] [net_tag] [channel]" ); 1398 ¬ice("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 ¬ice("No such channel setting for $type/$tag on $net_tag."); 1430 return; 1431 } 1432 ¬ice("$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 ¬ice("There is already such a channel setting."); 1447 return; 1448 1449 } else { 1450 ¬ice("$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 ¬ice("Current output windows:"); 1463 foreach my $type ( sort keys %{ $state{__windows} } ) { 1464 ¬ice("$type:"); 1465 foreach my $tag ( sort keys %{ $state{__windows}{$type} } ) { 1466 ¬ice(" $tag: $state{__windows}{$type}{$tag}"); 1467 } 1468 } 1469 ¬ice( "Default window for all other messages: " . $settings{window} ); 1470 1471 ¬ice("Add new entries with the /twirssi_set_window " 1472 . "[type] [tag] [window] command." ); 1473 ¬ice("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 ¬ice("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 ¬ice( 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 ¬ice("No such window setting for $type/$tag."); 1532 return; 1533 } 1534 ¬ice("$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 ¬ice("$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 ¬ice("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 ¬ice('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 ¬ice('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 ¬ice(['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 ¬ice(['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 ¬ice([$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 ¬ice(['info'], "List $list_ac$list_name is empty."); 2847 } else { 2848 ¬ice("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 ¬ice([ '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 ¬ice("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 ¬ice([ '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 ¬ice( $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 ¬ice([ '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 ¬ice("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 ¬ice([ '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 ¬ice([ '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 ¬ice([ 'crap' ], "state written out to $settings{dump_store}"); 3949 } 3950 } 3951 ); 3952 Irssi::command_bind( 3953 "twirssi_version", 3954 sub { 3955 ¬ice( 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 { ¬ice( ["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 { ¬ice( ["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 { ¬ice( ["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 ¬ice( ["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 ¬ice( ["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 { ¬ice( ["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 { ¬ice( ["tweet"], "Blocked $_[0]" ); } 4060 ) 4061 ); 4062 Irssi::command_bind( 4063 "twitter_unblock", 4064 &gen_cmd( 4065 "/twitter_unblock <username>", 4066 "destroy_block", 4067 sub { ¬ice( ["tweet"], "Unblock $_[0]" ); } 4068 ) 4069 ); 4070 Irssi::command_bind( 4071 "twitter_spam", 4072 &gen_cmd( 4073 "/twitter_spam <username>", 4074 "report_spam", 4075 sub { ¬ice( ["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 ¬ice( 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 ¬ice( 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 ¬ice("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