1.5.3 - r333 - Update to final URL, pass data from child in a machine readable format
[twirssi-net-twitter-lite.git] / twirssi.pl
1 use strict;
2 use Irssi;
3 use Irssi::Irc;
4 use Net::Twitter;
5 use HTTP::Date;
6 use HTML::Entities;
7 use File::Temp;
8 use LWP::Simple;
9 use Data::Dumper;
10 $Data::Dumper::Indent = 1;
11
12 use vars qw($VERSION %IRSSI);
13
14 $VERSION = "1.5.3";
15 my ($REV) = '$Rev: 333 $' =~ /(\d+)/;
16 %IRSSI = (
17     authors     => 'Dan Boger',
18     contact     => 'zigdon@gmail.com',
19     name        => 'twirssi',
20     description => 'Send twitter updates using /tweet.  '
21       . 'Can optionally set your bitlbee /away message to same',
22     license => 'GNU GPL v2',
23     url     => 'http://tinyurl.com/twirssi',
24     changed => 'Mon Dec  1 15:36:01 PST 2008',
25 );
26
27 my $window;
28 my $twit;
29 my %twits;
30 my $user;
31 my $poll;
32 my %nicks;
33 my %friends;
34 my $last_poll = time - 300;
35 my %tweet_cache;
36 my %id_map;
37
38 sub cmd_direct {
39     my ( $data, $server, $win ) = @_;
40
41     unless ($twit) {
42         &notice("Not logged in!  Use /twitter_login username pass!");
43         return;
44     }
45
46     my ( $target, $text ) = split ' ', $data, 2;
47     unless ( $target and $text ) {
48         &notice("Usage: /dm <nick> <message>");
49         return;
50     }
51
52     &cmd_direct_as( "$user $data", $server, $win );
53 }
54
55 sub cmd_direct_as {
56     my ( $data, $server, $win ) = @_;
57
58     unless ($twit) {
59         &notice("Not logged in!  Use /twitter_login username pass!");
60         return;
61     }
62
63     my ( $username, $target, $text ) = split ' ', $data, 3;
64     unless ( $username and $target and $text ) {
65         &notice("Usage: /dm_as <username> <nick> <message>");
66         return;
67     }
68
69     unless ( exists $twits{$username} ) {
70         &notice("Unknown username $username");
71         return;
72     }
73
74     unless ( $twits{$username}
75         ->new_direct_message( { user => $target, text => $text } ) )
76     {
77         &notice("DM to $target failed");
78         return;
79     }
80
81     &notice("DM sent to $target");
82     $nicks{$target} = time;
83 }
84
85 sub cmd_tweet {
86     my ( $data, $server, $win ) = @_;
87
88     unless ($twit) {
89         &notice("Not logged in!  Use /twitter_login username pass!");
90         return;
91     }
92
93     $data =~ s/^\s+|\s+$//;
94     unless ($data) {
95         &notice("Usage: /tweet <update>");
96         return;
97     }
98
99     &cmd_tweet_as( "$user $data", $server, $win );
100 }
101
102 sub cmd_tweet_as {
103     my ( $data, $server, $win ) = @_;
104
105     unless ($twit) {
106         &notice("Not logged in!  Use /twitter_login username pass!");
107         return;
108     }
109
110     $data =~ s/^\s+|\s+$//;
111     my ( $username, $data ) = split ' ', $data, 2;
112
113     unless ( $username and $data ) {
114         &notice("Usage: /tweet_as <username> <update>");
115         return;
116     }
117
118     unless ( exists $twits{$username} ) {
119         &notice("Unknown username $username");
120         return;
121     }
122
123     if ( Irssi::settings_get_str("short_url_provider") ) {
124         foreach my $url ( $data =~ /(https?:\/\/\S+[\w\/])/g ) {
125             eval {
126                 my $short = makeashorterlink($url);
127                 $data =~ s/\Q$url/$short/g;
128             };
129         }
130     }
131
132     if ( length $data > 140 ) {
133         &notice(
134             "Tweet too long (" . length($data) . " characters) - aborted" );
135         return;
136     }
137
138     unless ( $twits{$username}->update($data) ) {
139         &notice("Update failed");
140         return;
141     }
142
143     foreach ( $data =~ /@([-\w]+)/ ) {
144         $nicks{$1} = time;
145     }
146
147     my $away = 0;
148     if (    Irssi::settings_get_bool("tweet_to_away")
149         and $data !~ /\@\w/
150         and $data !~ /^[dD] / )
151     {
152         my $server =
153           Irssi::server_find_tag( Irssi::settings_get_str("bitlbee_server") );
154         if ($server) {
155             $server->send_raw("away :$data");
156             $away = 1;
157         } else {
158             &notice( "Can't find bitlbee server.",
159                 "Update bitlbee_server or disalbe tweet_to_away" );
160         }
161     }
162
163     &notice( "Update sent" . ( $away ? " (and away msg set)" : "" ) );
164 }
165
166 sub gen_cmd {
167     my ( $usage_str, $api_name, $post_ref ) = @_;
168
169     return sub {
170         my ( $data, $server, $win ) = @_;
171
172         unless ($twit) {
173             &notice("Not logged in!  Use /twitter_login username pass!");
174             return;
175         }
176
177         $data =~ s/^\s+|\s+$//;
178         unless ($data) {
179             &notice("Usage: $usage_str");
180             return;
181         }
182
183         unless ( $twit->$api_name($data) ) {
184             &notice("$api_name failed");
185             return;
186         }
187
188         &$post_ref($data) if $post_ref;
189       }
190 }
191
192 sub cmd_switch {
193     my ( $data, $server, $win ) = @_;
194
195     $data =~ s/^\s+|\s+$//g;
196     if ( exists $twits{$data} ) {
197         &notice("Switching to $data");
198         $twit = $twits{$data};
199         $user = $data;
200     } else {
201         &notice("Unknown user $data");
202     }
203 }
204
205 sub cmd_logout {
206     my ( $data, $server, $win ) = @_;
207
208     $data =~ s/^\s+|\s+$//g;
209     if ( $data and exists $twits{$data} ) {
210         &notice("Logging out $data...");
211         $twits{$data}->end_session();
212         delete $twits{$data};
213     } elsif ($data) {
214         &notice("Unknown username '$data'");
215     } else {
216         &notice("Logging out $user...");
217         $twit->end_session();
218         undef $twit;
219         delete $twits{$user};
220         if ( keys %twits ) {
221             &cmd_switch( ( keys %twits )[0], $server, $win );
222         } else {
223             Irssi::timeout_remove($poll) if $poll;
224             undef $poll;
225         }
226     }
227 }
228
229 sub cmd_login {
230     my ( $data, $server, $win ) = @_;
231     my $pass;
232     if ($data) {
233         ( $user, $pass ) = split ' ', $data, 2;
234     } elsif ( my $autouser = Irssi::settings_get_str("twitter_usernames")
235         and my $autopass = Irssi::settings_get_str("twitter_passwords") )
236     {
237         my @user = split /\s*,\s*/, $autouser;
238         my @pass = split /\s*,\s*/, $autopass;
239         if ( @user != @pass ) {
240             &notice("Number of usernames doesn't match "
241                   . "the number of passwords - auto-login failed" );
242         } else {
243             my ( $u, $p );
244             while ( @user and @pass ) {
245                 $u = shift @user;
246                 $p = shift @pass;
247                 &cmd_login("$u $p");
248             }
249             return;
250         }
251     } else {
252         &notice("/twitter_login requires either a username and password "
253               . "or twitter_usernames and twitter_passwords to be set." );
254         return;
255     }
256
257     %friends = %nicks = ();
258
259     $twit = Net::Twitter->new(
260         username => $user,
261         password => $pass,
262         source   => "twirssi"
263     );
264
265     unless ( $twit->verify_credentials() ) {
266         &notice("Login as $user failed");
267         $twit = undef;
268         if ( keys %twits ) {
269             &cmd_switch( ( keys %twits )[0], $server, $win );
270         }
271         return;
272     }
273
274     if ($twit) {
275         my $rate_limit = $twit->rate_limit_status();
276         if ( $rate_limit and $rate_limit->{remaining_hits} < 1 ) {
277             &notice("Rate limit exceeded, try again later");
278             $twit = undef;
279             return;
280         }
281
282         $twits{$user} = $twit;
283         Irssi::timeout_remove($poll) if $poll;
284         $poll = Irssi::timeout_add( 300 * 1000, \&get_updates, "" );
285         &notice("Logged in as $user, loading friends list...");
286         &load_friends();
287         &notice( "loaded friends: ", scalar keys %friends );
288         if ( Irssi::settings_get_bool("twirssi_first_run") ) {
289             Irssi::settings_set_bool( "twirssi_first_run", 0 );
290             unless ( exists $friends{twirssi} ) {
291                 &notice("Welcome to twirssi!"
292                       . "  Perhaps you should add \@twirssi to your friends list,"
293                       . " so you can be notified when a new version is release?"
294                       . "  Just type /twitter_friend twirssi." );
295             }
296         }
297         %nicks = %friends;
298         $nicks{$user} = 0;
299         &get_updates;
300     } else {
301         &notice("Login failed");
302     }
303 }
304
305 sub cmd_upgrade {
306     my ( $data, $server, $win ) = @_;
307
308     my $loc = Irssi::settings_get_str("twirssi_location");
309     unless ( -w $loc ) {
310         &notice(
311 "$loc isn't writable, can't upgrade.  Perhaps you need to /set twirssi_location?"
312         );
313         return;
314     }
315
316     if ( not -x "/usr/bin/md5sum" and not $data ) {
317         &notice(
318 "/usr/bin/md5sum can't be found - try '/twirssi_upgrade nomd5' to skip MD5 verification"
319         );
320         return;
321     }
322
323     my $md5;
324     unless ($data) {
325         eval { use Digest::MD5; };
326
327         if ($@) {
328             &notice(
329 "Failed to load Digest::MD5.  Try '/twirssi_upgrade nomd5' to skip MD5 verification"
330             );
331             return;
332         }
333
334         $md5 = get("http://twirssi.com/md5sum");
335         chomp $md5;
336         $md5 =~ s/ .*//;
337         unless ($md5) {
338             &notice("Failed to download md5sum from peeron!  Aborting.");
339             return;
340         }
341
342         unless ( open( CUR, $loc ) ) {
343             &notice(
344 "Failed to read $loc.  Check that /set twirssi_location is set to the correct location."
345             );
346             return;
347         }
348
349         my $cur_md5 = Digest::MD5::md5_hex(<CUR>);
350         close CUR;
351
352         if ( $cur_md5 eq $md5 ) {
353             &notice("Current twirssi seems to be up to date.");
354             return;
355         }
356     }
357
358     my $URL = "http://twirssi.com/twirssi.pl";
359     &notice("Downloading twirssi from $URL");
360     LWP::Simple::getstore( $URL, "$loc.upgrade" );
361
362     unless ($data) {
363         unless ( open( NEW, "$loc.upgrade" ) ) {
364             &notice(
365 "Failed to read $loc.upgrade.  Check that /set twirssi_location is set to the correct location."
366             );
367             return;
368         }
369
370         my $new_md5 = Digest::MD5::md5_hex(<NEW>);
371         close NEW;
372
373         if ( $new_md5 ne $md5 ) {
374             &notice("MD5 verification failed. expected $md5, got $new_md5");
375             return;
376         }
377     }
378
379     rename $loc, "$loc.backup"
380       or &notice("Failed to back up $loc: $!.  Aborting")
381       and return;
382     rename "$loc.upgrade", $loc
383       or &notice("Failed to rename $loc.upgrade: $!.  Aborting")
384       and return;
385
386     my ( $dir, $file ) = ( $loc =~ m{(.*)/([^/]+)$} );
387     if ( -e "$dir/autorun/$file" ) {
388         &notice("Updating $dir/autorun/$file");
389         unlink "$dir/autorun/$file"
390           or &notice("Failed to remove old $file from autorun: $!");
391         symlink "../$file", "$dir/autorun/$file"
392           or &notice("Failed to create symlink in autorun directory: $!");
393     }
394
395     &notice("Download complete.  Reload twirssi with /script load $file");
396 }
397
398 sub load_friends {
399     my $fh = shift;
400     my $page = 1;
401     my %new_friends;
402     while (1) {
403         print $fh "Loading friends page $page...\n" if ($fh and &debug);
404         my $friends = $twit->friends( { page => $page } );
405         last unless $friends;
406         $new_friends{ $_->{screen_name} } = time foreach @$friends;
407         $page++;
408         last if @$friends == 0 or $page == 10;
409     }
410
411     my ($added, $removed) = (0, 0);
412     print $fh "Scanning for new friends...\n" if ($fh and &debug);
413     foreach ( keys %new_friends ) {
414         next if exists $friends{$_};
415         $friends{$_} = time;
416         $added++;
417     }
418
419     print $fh "Scanning for removed friends...\n" if ($fh and &debug);
420     foreach ( keys %friends ) {
421         next if exists $new_friends{$_};
422         delete $friends{$_}; 
423         $removed++;
424     }
425
426     return ($added, $removed);
427 }
428
429 sub get_updates {
430     print scalar localtime, " - get_updates starting" if &debug;
431
432     $window =
433       Irssi::window_find_name( Irssi::settings_get_str('twitter_window') );
434     unless ($window) {
435         Irssi::active_win()
436           ->print( "Can't find a window named '"
437               . Irssi::settings_get_str('twitter_window')
438               . "'.  Create it or change the value of twitter_window" );
439     }
440     unless ($twit) {
441         &notice("Not logged in!  Use /twitter_login username pass!");
442         return;
443     }
444
445     my ( $fh, $filename ) = File::Temp::tempfile();
446     my $pid = fork();
447
448     if ($pid) {    # parent
449         Irssi::timeout_add_once( 5000, 'monitor_child', [$filename] );
450         Irssi::pidwait_add($pid);
451     } elsif ( defined $pid ) {    # child
452         close STDIN;
453         close STDOUT;
454         close STDERR;
455
456         my $new_poll = time;
457
458         &do_updates( $fh, $user, $twit );
459         foreach ( keys %twits ) {
460             next if $_ eq $user;
461             &do_updates( $fh, $_, $twits{$_} );
462         }
463
464         my ($added, $removed) = &load_friends($fh);
465         if ($added + $removed) {
466           print $fh "%R***%n Friends list updated: ",
467                     join(", ", sprintf("%d added", $added),
468                                sprintf("%d removed", $removed)), "\n";
469         }
470         print $fh "__friends__\n";
471         foreach ( sort keys %friends ) {
472             print $fh "$_ $friends{$_}\n";
473         }
474         print $fh $new_poll;
475         close $fh;
476         exit;
477     }
478     print scalar localtime, " - get_updates ends" if &debug;
479 }
480
481 sub do_updates {
482     my ( $fh, $username, $obj ) = @_;
483
484     print scalar localtime, " - Polling for updates for $username" if &debug;
485     my $tweets =
486       $obj->friends_timeline( { since => HTTP::Date::time2str($last_poll) } )
487       || [];
488     foreach my $t ( reverse @$tweets ) {
489         my $text = decode_entities( $t->{text} );
490         $text =~ s/%/%%/g;
491         $text =~ s/(^|\W)\@([-\w]+)/$1%B\@$2%n/g;
492         my $reply = "tweet";
493         if (    Irssi::settings_get_bool("show_reply_context")
494             and $t->{in_reply_to_screen_name} ne $username
495             and $t->{in_reply_to_screen_name}
496             and not exists $friends{ $t->{in_reply_to_screen_name} } )
497         {
498             $nicks{ $t->{in_reply_to_screen_name} } = time;
499             my $context = $obj->show_status( $t->{in_reply_to_status_id} );
500             if ($context) {
501                 my $ctext = decode_entities( $context->{text} );
502                 $ctext =~ s/%/%%/g;
503                 $ctext =~ s/(^|\W)\@([-\w]+)/$1%B\@$2%n/g;
504                 printf $fh "id:%d account:%s nick:%s type:tweet %s\n",
505                   $context->{id}, $username,
506                   $context->{user}{screen_name}, $ctext;
507                 $reply = "reply";
508             } else {
509                 print "Failed to get context from $t->{in_reply_to_screen_name}"
510                   if &debug;
511             }
512         }
513         next
514           if $t->{user}{screen_name} eq $username
515               and not Irssi::settings_get_bool("show_own_tweets");
516         printf $fh "id:%d account:%s nick:%s type:%s %s\n",
517           $t->{id}, $username, $t->{user}{screen_name}, $reply, $text;
518     }
519
520     print scalar localtime, " - Polling for replies" if &debug;
521     $tweets = $obj->replies( { since => HTTP::Date::time2str($last_poll) } )
522       || [];
523     foreach my $t ( reverse @$tweets ) {
524         next
525           if exists $friends{ $t->{user}{screen_name} };
526
527         my $text = decode_entities( $t->{text} );
528         $text =~ s/%/%%/g;
529         $text =~ s/(^|\W)\@([-\w]+)/$1%B\@$2%n/g;
530         printf $fh "id:%d account:%s nick:%s type:tweet %s\n",
531           $t->{id}, $username, $t->{user}{screen_name}, $text;
532     }
533
534     print scalar localtime, " - Polling for DMs" if &debug;
535     $tweets =
536       $obj->direct_messages( { since => HTTP::Date::time2str($last_poll) } )
537       || [];
538     foreach my $t ( reverse @$tweets ) {
539         my $text = decode_entities( $t->{text} );
540         $text =~ s/%/%%/g;
541         $text =~ s/(^|\W)\@([-\w]+)/$1%B\@$2%n/g;
542         printf $fh "id:%d account:%s nick:%s type:dm %s\n",
543           $t->{id}, $username, $t->{sender_screen_name}, $text;
544     }
545     print scalar localtime, " - Done" if &debug;
546 }
547
548 sub monitor_child {
549     my $data     = shift;
550     my $filename = $data->[0];
551
552     print scalar localtime, " - checking child log at $filename" if &debug;
553     my $old_last_poll = $last_poll;
554     if ( open FILE, $filename ) {
555         my @lines;
556         while (<FILE>) {
557             chomp;
558             last if /^__friends__/;
559             my %meta;
560             foreach my $key (qw/id account nick type/) {
561               s/^$key:(\S+)\s*//;
562               $meta{$key} = $1;
563             }
564
565             next if exists $tweet_cache{$meta{id}};
566             $tweet_cache{$meta{id}} = time;
567             my $account = "";
568             if ($meta{account} ne $user) {
569               $account = "$meta{account}: ";
570             }
571             if ($meta{type} eq 'tweet') {
572               push @lines, "[$account%B\@$meta{nick}%n] $_\n",
573             } elsif ($meta{type} eq 'reply') {
574               push @lines, "[$account\\--> %B\@$meta{nick}%n] $_\n",
575             } elsif ($meta{type} eq 'dm') {
576               push @lines, "[$account%B\@$meta{nick}%n (%%WDM%%n)] $_\n",
577             } elsif ($meta{type} eq 'debug') {
578               push @lines, "debug: $_\n" if &debug,
579             }
580         }
581
582         %friends = ();
583         while (<FILE>) {
584             if (/^\d+$/) {
585                 $last_poll = $_;
586                 last;
587             }
588             my ( $f, $t ) = split ' ', $_;
589             $nicks{$f} = $friends{$f} = $t;
590         }
591
592         if ( $last_poll != $old_last_poll ) {
593             print "new last_poll = $last_poll" if &debug;
594             foreach my $line (@lines) {
595                 chomp $line;
596                 $window->print( $line, MSGLEVEL_PUBLIC );
597                 foreach ( $line =~ /\@([-\w]+)/ ) {
598                     $nicks{$1} = time;
599                 }
600             }
601
602             close FILE;
603             unlink $filename
604               or warn "Failed to remove $filename: $!"
605               unless &debug;
606
607       # keep 10 minutes of cached tweets, to make sure we don't show duplicates.
608             foreach ( keys %tweet_cache ) {
609                 next if $tweet_cache{$_} > time - 600;
610                 delete $tweet_cache{$_};
611             }
612             return;
613         }
614     }
615
616     close FILE;
617     Irssi::timeout_add_once( 5000, 'monitor_child', [$filename] );
618 }
619
620 sub debug {
621     return Irssi::settings_get_bool("twirssi_debug");
622 }
623
624 sub notice {
625     $window->print( "%R***%n @_", MSGLEVEL_PUBLIC );
626 }
627
628 sub sig_complete {
629     my ( $complist, $window, $word, $linestart, $want_space ) = @_;
630
631     return unless $linestart =~ /^\/(?:tweet|dm)/;
632     my $prefix = $word =~ s/^@//;
633     $prefix = 0 if $linestart eq '/dm' or $linestart eq '/dm_as';
634     push @$complist, grep /^\Q$word/i,
635       sort { $nicks{$b} <=> $nicks{$a} } keys %nicks;
636     @$complist = map { "\@$_" } @$complist if $prefix;
637 }
638
639 Irssi::settings_add_str( "twirssi", "twitter_window",     "twitter" );
640 Irssi::settings_add_str( "twirssi", "bitlbee_server",     "bitlbee" );
641 Irssi::settings_add_str( "twirssi", "short_url_provider", "TinyURL" );
642 Irssi::settings_add_str( "twirssi", "twirssi_location",
643     ".irssi/scripts/twirssi.pl" );
644 Irssi::settings_add_str( "twirssi", "twitter_usernames", undef );
645 Irssi::settings_add_str( "twirssi", "twitter_passwords", undef );
646 Irssi::settings_add_bool( "twirssi", "tweet_to_away",      0 );
647 Irssi::settings_add_bool( "twirssi", "show_reply_context", 0 );
648 Irssi::settings_add_bool( "twirssi", "show_own_tweets",    1 );
649 Irssi::settings_add_bool( "twirssi", "twirssi_debug",      0 );
650 Irssi::settings_add_bool( "twirssi", "twirssi_first_run",  1 );
651 $window = Irssi::window_find_name( Irssi::settings_get_str('twitter_window') );
652
653 if ($window) {
654     Irssi::command_bind( "dm",              "cmd_direct" );
655     Irssi::command_bind( "tweet",           "cmd_tweet" );
656     Irssi::command_bind( "dm_as",           "cmd_direct_as" );
657     Irssi::command_bind( "tweet_as",        "cmd_tweet_as" );
658     Irssi::command_bind( "twitter_login",   "cmd_login" );
659     Irssi::command_bind( "twitter_logout",  "cmd_logout" );
660     Irssi::command_bind( "twitter_switch",  "cmd_switch" );
661     Irssi::command_bind( "twirssi_upgrade", "cmd_upgrade" );
662     Irssi::command_bind(
663         "twitter_dump",
664         sub {
665             print "twits: ",   Dumper \%twits;
666             print "friends: ", join ", ", sort keys %friends;
667             print "nicks: ",   join ", ", sort keys %nicks;
668             print "last poll: $last_poll";
669         }
670     );
671     Irssi::command_bind(
672         "twirssi_version",
673         sub {
674             &notice(
675 "Twirssi v$VERSION (r$REV);  Net::Twitter v$Net::Twitter::VERSION. "
676                   . "See details at http://tinyurl.com/twirssi" );
677         }
678     );
679     Irssi::command_bind(
680         "twitter_friend",
681         &gen_cmd(
682             "/twitter_friend <username>",
683             "create_friend",
684             sub { &notice("Following $_[0]"); $nicks{ $_[0] } = time; }
685         )
686     );
687     Irssi::command_bind(
688         "twitter_unfriend",
689         &gen_cmd(
690             "/twitter_unfriend <username>",
691             "destroy_friend",
692             sub { &notice("Stopped following $_[0]"); delete $nicks{ $_[0] }; }
693         )
694     );
695     Irssi::command_bind( "twitter_updates", "get_updates" );
696     Irssi::signal_add_last( 'complete word' => \&sig_complete );
697
698     &notice("  %Y<%C(%B^%C)%N                   TWIRSSI v%R$VERSION%N (r$REV)");
699     &notice("   %C(_(\\%N        http://twirssi.com/ for full docs");
700     &notice(
701         "    %Y||%C `%N Log in with /twitter_login, send updates with /tweet");
702
703     if ( my $provider = Irssi::settings_get_str("short_url_provider") ) {
704         eval "use WWW::Shorten::$provider;";
705
706         if ($@) {
707             &notice(
708 "Failed to load WWW::Shorten::$provider - either clear short_url_provider or install the CPAN module"
709             );
710         }
711     }
712
713     if (    my $autouser = Irssi::settings_get_str("twitter_usernames")
714         and my $autopass = Irssi::settings_get_str("twitter_passwords") )
715     {
716         &cmd_login();
717     }
718
719 } else {
720     Irssi::active_win()
721       ->print( "Create a window named "
722           . Irssi::settings_get_str('twitter_window')
723           . " or change the value of twitter_window.  Then, reload twirssi." );
724 }
725