#! /usr/bin/perl

# twit: script to post to Twitter and identi.ca
# and keep a local miniblog.

# Originally based on "twitish":
# Copyright Toufeeq Hussain <toufeeq_hussain@infosys.com>

# by Don Marti <dmarti@zgp.org>

##   "Why would I want to use *Perl*? This isn't the 90s!"    ##
##          -- spacehobo on identi.ca                         ##

#   * Inspired by TwitterFox, which is better-looking and has
#     more features: http://www.naan.net/trac/wiki/TwitterFox
#
#   * de-dupes entries, so if the same person is posting
#     the same messages to multiple microblog services, you see 
#     each message once no matter how many services are up.
#
#   * Simple kill list by regular expression.
#
#   * Sleeps in order to spare the microblog servers when you're not 
#     at the keyboard.
#
#   * Sleeps when you're actually writing or editing something:
#       http://www.locusmag.com/Features/2009/01/cory-doctorow-writing-in-age-of.html 


##   This file is free software; you can redistribute it    ##
##   and/or modify it under the same terms as Perl itself.  ##

use strict;
use Date::Parse;
use DB_File::Lock;
use Fcntl ':flock';
use File::Spec::Functions;
use Gtk2; # don't init here -- in the child
use LWP::UserAgent;
use Proc::ProcessTable;
use XML::Parser;
use constant TRUE => 1;
use constant FALSE => 0;

my $USERNAME = $ENV{'LOGNAME'};
my $PASSWORD = snarf_file("$ENV{'HOME'}/.twitter-password");
my $MINIBLOG = catfile($ENV{'HOME'}, '.miniblog');

my $twitter_url = 'http://twitter.com/statuses/update.xml';
my $identi_url = 'http://identi.ca/api/statuses/update.xml';
my $Error;

my @feeds = ('http://twitter.com/statuses/friends_timeline.rss',
             "http://identi.ca/$USERNAME/all/rss",
             "http://earthquake.usgs.gov/eqcenter/catalogs/eqs7day-M5.xml"
             );

my @kill = ('iphone', 'apple store');

my $interrupts = '/proc/interrupts';

my $db = "$ENV{'HOME'}/.microblog.db";

# how long to leave messages on screen
use constant SHOW_DELAY => 6;

# how often to hit the web sites if user is active and there
# are no new messages
use constant FETCH_DELAY => 119;

# how long to protect a message from duplication
use constant REPEAT_DELAY => 604800;

Gtk2::Rc->parse_string(q(
    style "normal" {
        font_name = "fixed"
        fg[NORMAL] = "#00FF00"
        bg[NORMAL] = "#000000"
    }
    widget "*" style "normal"
));

$SIG{INT} = \&bye; 

my %Seen;
my %element_text;
my $in_element = '';

my %Message;
my $Message_count = time(); # fake time for missing pubDate in feed

my $locking = {mode            => "write",
               nonblocking     => 1,
               lockfile_mode   => 0600,
              };

chomp $PASSWORD;

if (!$PASSWORD) {
    print STDERR "Put your password in ~/.twitter-password.\n";
    exit(2);
}

-d $MINIBLOG or mkdir($MINIBLOG) or die "Error making $MINIBLOG: $!";
-w $MINIBLOG or die "Can't write to $MINIBLOG ";

my $text = join (' ', @ARGV);
$text =~ s/\s+/ /g;

if (is_repeat($text)) {
    print STDERR "You already said: $text\n";
    exit(1);
} elsif (!$text) {
    start_aggregator();
} else {
    write_miniblog_file($text);
    foreach my $destination($twitter_url, $identi_url) {
        post_to_api($destination, $text);
    }
    if ($Error) {
        exit(3);
    }
    else {
        exit(0);
    }
}



####################################################################

sub start_aggregator {
    tie(%Seen, 'DB_File::Lock', 
        [$db, O_RDWR|O_CREAT, 0660, $DB_HASH], $locking)
        or die "Can't open $db (another copy running?)\n";

    -r $interrupts or die "Can't read $interrupts\n";

    my $parser = new XML::Parser(Handlers => {Start => \&handle_start,
                                              End   => \&handle_end,
                                              Char  => \&handle_char}); 
    my $ua = LWP::UserAgent->new;
    $ua->credentials( 'twitter.com:80', 'Twitter API', $USERNAME => $PASSWORD);

    go_bg();

    my $start_time;
    my $key_count;
    my $sleep_time;
    while(1) {
        $start_time = time();
        foreach my $feed (@feeds) {
            my $res = $ua->get($feed);
            if ($res->is_success) {
                my $feed_text = $res->content;
                $parser->parse($feed_text) if defined($feed_text);
            }
        }
        foreach my $message_time (sort(keys(%Message))) {
            pop_up($Message{$message_time});
        }
        %Message = ();
        $sleep_time =  FETCH_DELAY - 2 * (time() - $start_time);
        sleep($sleep_time) if $sleep_time > 0;
        $key_count = get_kb_interrupts();
        while (get_kb_interrupts() eq $key_count) {
            sleep(SHOW_DELAY);
        }
    }
}

sub bye {
    untie(%Seen);
    exit(0);
}

sub editor_running {
    my $editor;
    if ($ENV{'EDITOR'} =~ /([^\/]+)$/) {
        $editor = $1;
    }
    my $t = new Proc::ProcessTable;
    foreach my $p ( @{$t->table} ){
       return 1 if $p->cmndline =~ /^$editor/;
    }
    return 0;
}

sub go_bg {
    close(STDOUT);
    close(STDERR);
    exit if fork();
    exit if fork();
    sleep 1 until getppid == 1;
}

sub handle_start {
    $in_element = $_[1];
    $element_text{$in_element} = '';
}

sub get_kb_interrupts {
    if (snarf_file($interrupts) =~ /1:([\s\d]+)/) {
        return $1;
    }
}

sub handle_end {
    my $tag = $_[1];
    $in_element = '';
    if ($tag eq 'item') {
        my $date = str2time($element_text{'pubDate'}) or 
                   str2time($element_text{'dc:date'}) or
                   $Message_count++;
        $Message{$date} = $element_text{'title'};
        %element_text = ();
    }
}

sub handle_char {
    if($in_element) {
        $element_text{$in_element} .= $_[1];
    }
}

sub pop_up {
    my $text = shift;
    $text =~ s/\s+/ /g;
    return if length($text) > 140;
    my $index_text = $text;
    $index_text =~ s/[^A-Za-z]//g;
    if (exists($Seen{$index_text}) 
        and $Seen{$index_text} + REPEAT_DELAY > time()) {
        return;
    }
    foreach my $bad(@kill) {
        if ($text =~ /$bad/i) {
            return;
        }
    }
    $Seen{$index_text} = time();

    while(editor_running()) {
        sleep SHOW_DELAY;
    }

    if(my $child = fork()) {
        waitpid($child, 0);
        return;
    }
    Gtk2->init;

    my $window = Gtk2::Window->new ('popup');
    $window->set_decorated(FALSE);
    $window->set_accept_focus(FALSE);

    my $vbox = Gtk2::VBox->new();
    $vbox->set("border_width"=> 3);
    $window->add($vbox);

    my $label = Gtk2::Label->new ($text);
    $vbox->add ($label);

    $window->show_all;

    Glib::Timeout->add(SHOW_DELAY * 1000, sub { exit });
    Gtk2->main;
}

sub snarf_file {
    # returns the empty string if no file.
    my $filename = shift;
    local $/ = undef;
    open (IN, "<$filename") or return '';
    my $result = <IN>;
    close IN or die $!;
    return $result;
}


sub current_miniblog {
    my ($this_month, $this_year) = (gmtime)[4,5];
    $this_year += 1900;
    $this_month = sprintf('%.2x', $this_month + 1);
    my $blogfile = catfile($MINIBLOG, "$this_year$this_month");
    return $blogfile;
}

sub is_repeat {
    my $text = shift;
    my %previous;
    foreach my $line (split(/\n/, snarf_file(current_miniblog()))) {
        if ($line =~ /  (.+)/) {
            $previous{$1} = 1;
        }
    }
    return exists($previous{$text});
}

sub post_to_api {
    my ($destination, $text) = @_;
    my $ua = LWP::UserAgent->new;
    $ua->env_proxy;

    $ua->credentials(
        'twitter.com:80',
        'Twitter API',
        $USERNAME => $PASSWORD,);

    $ua->credentials(
        'identi.ca:80',
        'Laconica API',
        $USERNAME => $PASSWORD,);

    my $response = $ua->post($destination, [status => $text ]);
    if ($response->is_error) {
        $Error = 1;
        print STDERR "Update to $destination failed: ",
            $response->message, "\n";
    }
}

sub write_miniblog_file {
    my $text = shift;
    my $blogfile = current_miniblog();
    open (BLOGFILE, ">>$blogfile")
        or die "Can't open $blogfile for append: $!";
    flock(BLOGFILE,LOCK_EX) or die $!;
    seek(BLOGFILE, 0, 2) or die $!;
    print BLOGFILE gmtime() . "  ";
    print BLOGFILE "$text\n" or die $!;
    flock (BLOGFILE, LOCK_UN) or die $!;
    close BLOGFILE or die $!;
}