use XML::Simple;
use HTTP::Request::Common qw(POST);
use LWP::UserAgent;
use HTTP::Cookies;
use Storable;
use DB_File;
use MLDBM qw(DB_File Storable);
use strict;
use warnings;

my $CLEAR_ON_FIRST_FETCH = 0; # enable for debugging

sub get_pm_xml {
    my $ua      = shift;
    my $node_id = shift;

    my $req = POST 'http://www.perlmonks.org',
                [
                  node_id => $node_id,
                  @_,
                  xmlstyle   => 'stream,flat',
                ];

    my $resp=XMLin($ua->request($req)->content);

    # cleanup older tickers that dont return
    # result sets consistant with the newer ones.
    my @keys=keys %$resp;
    foreach my $key (@keys) {
        if (lc($key) ne $key and !$resp->{lc($key)}) {
            $resp->{lc($key)}=delete $resp->{$key};
        }
    }

    return $resp;
}

sub login {
    my ($user,$pass,$cookie_jar)=@_;

    die "Must have User and Pass arguments"
        if !$user or !$pass;

    $cookie_jar||="$0.cookie";

    my $ua = LWP::UserAgent->new;
    $ua->cookie_jar(
        HTTP::Cookies->new(
             file => "$0.cookie",
             autosave => 1
        )
    );

    my $resp = get_pm_xml($ua,109,
        op         => 'login',
        user       => $user,
        passwd     => $pass,
        expires    => '+10y',
        sexisgood  => 'submit',
        ticker     => 'yes',
        displaytype => 'xml',
    );

    return $resp && $resp->{loggedin} ? $ua : undef;
}

sub fetch_nodes {
    my ($ua,$db,$file)=@_;

    $file ||= "$0.dbf";
    if (!$db) {
        my %db;
        tie %db, 'MLDBM', $file, O_CREAT|O_RDWR, 0640 or die $!;
        # Ask for portable binary
        (tied %db)->DumpMeth('portable');
        $db=\%db;
    }

    my $lastid=$db->{lastid};
    $lastid||=0;
    my $count=0;
    my $sleep=0;
    do {
        if ($sleep) {
            print "(sleeping for $sleep seconds)\n";
            sleep $sleep;
        }
        print "Fetching records since '$lastid'\n";
        my $resp=get_pm_xml($ua,32704,
            fromid => $lastid,
        );
        $resp->{node} ||= {}; # simulate an empty list.
        $resp->{node} = { $resp->{node}{node_id} => $resp->{node} }
            if ref $resp->{node} ne "HASH";
        $sleep = $resp->{info}{min_poll_seconds};
        foreach my $id (keys %{ $resp->{node} }) {
            $db->{$id} = $resp->{node}{$id};
            $lastid=$id if $lastid<$id;
        }
        $count=keys %{$resp->{node}};
        $db->{lastid}= $lastid;
        (tied %$db)->UseDB()->sync(); # flush our data so far.
        print "Got $count records\n";
    } until $count<100;
    $db->{lastid}=$lastid;
    return $db;
}

sub poll_rep {
    my ($ua,$db)=@_;
    my $sleep=0;
    do {
        if ($sleep) {
            print "(sleeping for $sleep seconds)\n";
            sleep $sleep;
        }
        print "Checking for noderep changes\n";
        my $resp=get_pm_xml($ua , 507310,
          $CLEAR_ON_FIRST_FETCH && !$sleep
           ? (clear=>1)
           : ()
        );
        $sleep=$resp->{info}{min_poll_seconds};
        $resp->{node}||=[]; # simulate an empty list.
        $resp->{node}=[$resp->{node}] if ref $resp->{node} ne "ARRAY";
        my $count=@{ $resp->{node} };
        print "Got $count records\n";
        foreach my $msg ( @{ $resp->{node} } ) {
            if (!exists $db->{$msg->{node_id}}) {
                print "Looks like you made a new post. Updating DB.\n";
                fetch_nodes($ua,$db);
                last; #
            }
        }
        foreach my $msg ( @{ $resp->{node} } ) {
            printf "%3d #%-8s %s\n",
               $msg->{delta},
               $msg->{node_id},
               $msg->{content};
            my $dbrec=$db->{$msg->{node_id}};
            $dbrec->{$_}=$msg->{$_}
                for qw(content reputation node_id);
            $db->{$msg->{node_id}}=$dbrec;
        }
        (tied %$db)->UseDB()->sync(); # flush our data so far.
    } while 1;
}

$|++;

my ($user,$pass,$reset)=@ARGV;

if ($reset) {
    unlink "$0.cookie","$0.dbf","$0.db";
}
my $ua= login( $user, $pass ) or die "Failed login\n";
my $db= fetch_nodes($ua) or die "Weird!";
poll_rep($ua,$db);