#!/usr/bin/perl
#mini-cb60-fetch.pl
use strict;
use warnings;
use vars qw/$VERSION/;
use XML::Simple;
use File::Path;
use LWP::UserAgent;
use HTTP::Cookies;
use Getopt::Long;
use HTTP::Request::Common qw(POST);
use Data::Dumper;

# This is free Software.
# Released under the same terms as Perl.
# Copyright Yves (demerphq) 2006

$VERSION=0.02;

my $ua = LWP::UserAgent->new();
$ua->timeout(10);
$ua->agent("Mini-CB60 $VERSION ");
$ua->env_proxy;

$|++;
my ( $verbose, $lastid, $sleeptime )= (1, 0, 0);
my $site_url= 'http://perlmonks.org/index.pl';
my $ticker_url= $site_url.'?node_id=207304;xmlstyle=modern';
(my $dir= $0) =~ s![^\\\/]+$!messages/!;

my ($user,$pass)= ('','');

GetOptions(
    'msgdir=s'    => \$dir,
    'verbose=i'   => \$verbose,
    'sleeptime=i' => \$sleeptime,
    'lastid=i'    => \$lastid,
    'user=s'      => \$user,
    'pass=s'      => \$pass,
) or die <<EOFUSAGE;
mini-cb60-fetch.pl --msgdir=PATH --verbose=INT --sleeptime=SECS
                   --user=USER --pass=PASS
--sleeptime of 0 means a single fetch only. Otherwise never halts.
Defaults to --sleeptime of 0 seconds, and ./messages for --msgdir.
EOFUSAGE

if ($sleeptime && $sleeptime < 60) {
    warn "Theres no need to fetch more often than every 60 seconds!\n";
}

if ( $user && $pass ) {
    my $req = POST $site_url, [
        op     => 'login',
        node_id=> 109, # login
        user   => $user,
        passwd => $pass,
        ticker =>'yes',
        displaytype=>'xml',
        xmlstyle=>'flat',
    ];
    my $jar=HTTP::Cookies->new(file => "$0.cookies", autosave => 1);
    $ua->cookie_jar($jar);
    my $response=$ua->request($req);
    die "Failed to login\n",$response->as_string
        if ! $response->is_success;

    my $xml=XMLin( $response->content );
    if (!$xml->{loggedin} ||
               $xml->{loggedin}{username} ne $user
    ) {
        die "Failed to login."
    }
    print "Logged in as $_->{username} ($_->{user_id})\n"
        for $xml->{loggedin};
} elsif ( $user || $pass ) {
    die "Must have both a username and a password to log in\n";
}

# cleanup the path for win32 users, just for aesthetic reasons
$dir =~ s![\\\/]+!\\!g
    if $^O=~/Win32/;

if ( ! -d $dir ) {
    mkpath $dir
        or die "Failed to create '$dir'";
}

if ($verbose) {
    print "Base Url: '$site_url'\n";
    print "Message directory is: '$dir'\n"
}
chdir $dir
    or die "Failed to chdir to '$dir':$!";

while ( 1 ) {
    # first we delete any old messages
    my $threshold= sprintf "%08x-%08x.msg",time() - 3600, 0;
    print "Threshold file is $threshold\n" if $verbose>1;
    my @files=sort glob "*.msg";
    foreach my $f (@files) {
        print "Found $f\n" if $verbose>1;
        next if $f ge $threshold;
        print "Unlinking $f\n" if $verbose;
        unlink $f or warn "Failed to unlink '$f':$!";
    }
    # and try to autodetect where we left off if this is the first run
    if ( ! $lastid && @files && -e $files[-1] ) {
        my ($t,$id)=split/[-.]/,$files[-1];
        $lastid= hex($id) if $lastid < hex($id);
    }

    # and now we do the fetch
    my $url= $ticker_url;
    $url .= ";fromid=$lastid" if $lastid;

    print "Fetching from id $lastid\n" if $verbose>1;
    my $response= $ua->get($url);
    if (!$response->is_success) {
        print "Fetch '$url' failed!\n";
        next;
    }

    # and now we process the results
    my $xml= XMLin( $response->content,
                    ForceArray=>['message'] );
    print Dumper($xml) if $verbose>2;

    my $msgs= $xml->{message}||[];
    my $count= $xml->{info}{count};
    $lastid= $xml->{info}{lastid}
        if $count;
    print "Got $count messages -- Last id: $lastid\n"
        if $verbose;
    next unless $count && $msgs && @$msgs;

    # each message is written as its own file.
    foreach my $msg (@$msgs) {
        my ($id,$epoch)= @{$msg}{qw(message_id createdepoch)};
        my $authlink= sprintf '<a href="?node_id=%d">%s</a></i>',
            $msg->{author_user},$msg->{author};
        (my $text= $msg->{parsed})=~s{^/me(\s+.+)?$}{<i>$authlink$1</i>};

        my $file= sprintf "%08x-%08x.msg",$epoch,$id;
        next if -e $file;
        open my $fh,">",$file
            or die "Failed to open '$file' for writing:$!";
        print "writing $file\n" if $verbose;
        print $fh "0\n"; # version
        print $fh join "\n",
              "<dt>$authlink&nbsp; &nbsp; <small>$msg->{createdgmtime} GMT</small></dt>",
              "<dd>$text</dd>",
              "";
        close $fh;
    }
} continue {
    exit(0) if $sleeptime <= 0; # exit out if this is a single pass
    print "sleeping for $sleeptime seconds....\n" if $verbose>1;
    sleep $sleeptime;
}