#!/usr/bin/perl -w
#######################################################################
### $Id: bloglines-0.03.txt,v 1.1 2004/02/09 03:02:27 mate Exp $
###

package Bloglines;

#######################################################################
# CONFIGURATION

$LOGIN_EMAIL = '';
$LOGIN_PASS = '';
$DATA_DIR = './data';
$PLUGINS_DIR = './plugins';

# $DISPLAY_URL = 'http://www.bloglines.com/myblogs_display';
# $LOGIN_URL = 'http://www.bloglines.com/login';
# $UA_PROXY = 'http://my.proxy.server.domain.name:port/';
# $UA_PROXY_BYPASS = ['localhost','127.0.0.1'];
# $UA_TIMEOUT = 60;
# $UA_NAME = "";
# $DEBUG = 0;

# CONFIGURATION
#######################################################################
$|=1;

use strict;
use URI;
use LWP::UserAgent;
use HTTP::Request::Common;
use HTTP::Cookies;
use Getopt::Long;
use vars qw($DATA_DIR $PLUGINS_DIR $LOGIN_EMAIL $LOGIN_PASS $DISPLAY_URL
            $LOGIN_URL $UA $UA_PROXY $UA_PROXY_BYPASS $UA_TIMEOUT $UA_NAME
            $DEBUG $VERSION @OPTIONS %OPTCTL
            $do_display $do_request $do_retrieve $do_login $do_parsefile);
$VERSION = '0.03';

my ($plugin, $sub);
my @plugins = _load_plugins($PLUGINS_DIR);
exit unless GetOptions(\%OPTCTL, "folder=i", "all:s", "since=i", "local", @OPTIONS);

$DISPLAY_URL ||= 'http://www.bloglines.com/myblogs_display';
$LOGIN_URL ||= 'http://www.bloglines.com/login';

$UA = LWP::UserAgent->new;
$UA->agent(defined($UA_NAME) ? $UA_NAME : "");
$UA->timeout(defined($UA_TIMEOUT) ? $UA_TIMEOUT : 60);
$UA->proxy(['http'], $UA_PROXY) if (defined $UA_PROXY);
$UA->no_proxy($UA_PROXY_BYPASS) if (defined $UA_PROXY_BYPASS);
$UA->env_proxy unless (defined($UA_PROXY) || defined($UA_PROXY_BYPASS));
$UA->cookie_jar(HTTP::Cookies->new(file => "$DATA_DIR/cookies", autosave => 1));

# plugin: display
$do_display = \&display;
foreach $plugin (@plugins) { $plugin->can('display') and
        defined ($sub = $plugin->display) and $do_display = $sub and last; }

# plugin: retrieve
$do_retrieve = \&retrieve;
foreach $plugin (@plugins) { $plugin->can('retrieve') and
        defined ($sub = $plugin->retrieve) and $do_retrieve = $sub and last; }

# plugin: request
$do_request = \&request;
foreach $plugin (@plugins) { $plugin->can('request') and
        defined ($sub = $plugin->request) and $do_request = $sub and last; }

# plugin: login
$do_login = \&login;
foreach $plugin (@plugins) { $plugin->can('login') and
        defined ($sub = $plugin->login) and $do_login = $sub and last; }

# plugin: parsefile
$do_parsefile = \&parsefile;
foreach $plugin (@plugins) { $plugin->can('parsefile') and
        defined ($sub = $plugin->parsefile) and $do_parsefile = $sub and last; }

# retrieve the entries
my ($file, $list, $site) = &$do_display(\%OPTCTL);

# plugin: filter
foreach $plugin (@plugins)
    { $plugin->can('filter') and $plugin->filter($file, $list, $site); }

# plugin: teardown
foreach $plugin (@plugins)
    { $plugin->can('teardown') and $plugin->teardown; }
exit;
# End of Main
#######################################################################

# default subroutine
sub display {

    my ($optref) = @_;
    my ($file, $list, $site, @query);

    if (exists $optref->{folder}) {
        $file = "$DATA_DIR/display".$optref->{folder};
        push @query, 'folder='.$optref->{folder};
    }
    if (exists $optref->{all}) {
        $file = "$DATA_DIR/displayall";
        push @query, 'all='.$optref->{all};
    }
    if (exists $optref->{since}) {
        push @query, 'since='.$optref->{since};
    }
    return () unless (@query);

    if (exists $optref->{local}) {
        ($list, $site) = &$do_parsefile($file) or return;
        return ($file, $list, $site);
    }

    &$do_retrieve("$DISPLAY_URL?".join('&', @query), $file, 'Title:[\w\s\|]+My Blogs')
        or warn("Can't login"), return;

    ($list, $site) = &$do_parsefile($file);

    return ($file, $list, $site);

}

# default subroutine
sub retrieve {

    my ($uri, $file, $header_re) = @_;
    my ($res);
    my $retry = 4;
    my $succeeded = 0;

    while ($retry-- > 0) {
        $res = &$do_request($uri, $file) or warn("Can't request: $uri"), return;
        if ($res->headers->as_string =~ /$header_re/) {
            $succeeded = 1;
            last;
        }
        &$do_login();
        sleep(1);
    }

    return $succeeded;

}

# default subroutine
sub request {

    my ($uri, $file) = @_;

    my $req = GET($uri);
    my $res = $UA->request($req, $file);

    warn "ua->request: $uri\n".$res->headers->as_string."\n" if $DEBUG;
    unless ($res->is_success) {
        warn $res->message."\n" if $DEBUG;
        return;
    }

    return $res;

}

# default subroutine
sub login {

    my $uri = $LOGIN_URL;
    my $email = $LOGIN_EMAIL;
    my $password = $LOGIN_PASS;
    my $file = "$DATA_DIR/login";

    my $req = POST($uri,
                   [
                    email => $email,
                    password => $password,
                    r => '/myblogs'
                   ],
                   Referer => $uri
                  );
    my $res = $UA->request($req, $file);

    warn "ua->request: $uri\n".$res->headers->as_string."\n" if $DEBUG;

    return $res->header('Set-Cookie') ? 1 : 0;

}

# default subroutine
sub parsefile {

    my ($file) = @_;
    my ($siteList, $list, $site, %sitehead);

    open(F, $file) or warn("Can't open $file: $!"), return;
    while (<F>) {
        s/\r//g if /\r/;
        next if /^$/;
        #
        # <script>...</script>
        #
        if (/^<script>/) {
            my ($itemid, $siteid, %items, @itemText);
            while (<F>) {
                if (/^<\/script>/) {
                    last;
                }
                elsif (/^itemText="(.*)";$/) {
                    @itemText = ($1);
                    next;
                }
                elsif (/^itemText\+="(.*)";$/) {
                    push @itemText, $1;
                    next;
                }
                elsif (/^itemList\[(\d+)\]/) {
                    $itemid = $1;
                    if (@itemText) {
                        $items{$itemid} = _scan_itemtext(@itemText);
                        undef @itemText;
                    }
                    next;
                }
                elsif (/^siteList\[(\d+)\]/) {
                    $siteid = $1;
                    if (%items) {
                        $siteList->{$siteid} = { %items };
                        undef %items;
                    }
                    next;
                }
            }
            next;
        }
        #
        # <table cellspacing=0 cellpadding=0>
        # <tr><td align="left" valign="top">
        # <span class="blogtitle">
        #  <a href="(link)" target=_blank><b>(title)</b></a>
        # </span>
        #  &nbsp;&nbsp;<a href="(feedlink)" target=_blank>[Feed]</a>
        # <br>
        #  (description)
        # <br>
        # Updated: (date)
        # </td></tr>
        # </table>
        #
        if (/^<span.+blogtitle/) {
            while (<F>) {
                if (/(?:td|tr|table)/) {
                    last;
                }
                elsif (/<a[^"]+"(.+?)"[^>]+><b>(.+?)</) {
                    $sitehead{link} = $1;
                    $sitehead{title} = $2;
                    next;
                }
                elsif (/<a[^"]+"(.+?)"[^>]+>\[Feed\]</) {
                    $sitehead{feed} = $1;
                    next;
                }
                elsif (/^Updated:\s+(.+)\s*$/) {
                    $sitehead{updated} = $1;
                    last;
                }
                elsif (/^\s*</) {
                    next;
                }
                elsif (/^\s*(.+)$/) {
                    $sitehead{description} = $1;
                }
            }
            next;
        }
        #
        # <div id='siteItem.(siteid).(itemid)'>
        #
        if (/^<div id='siteItem\.(\d+)\.(\d+)'>/) {
            $list->{$1}->{$2} = $siteList->{$1}->{$2} if $siteList->{$1}->{$2};
            if (%sitehead) {
                $site->{$1} = { %sitehead };
                undef %sitehead;
            }
            next;
        }
    }
    close(F);

    return ($list, $site);

}

sub _scan_itemtext {

    my (@itemtext) = @_;
    my (%items);

    #
    # $itemtext[0]: <table width="100%"><tr><td>
    # $itemtext[1]: <h2><a href="(link)">(title)</a></h2>
    # $itemtext[2]: By (creator)
    # $itemtext[3]:  on (subject)
    # $itemtext[4]: <p>(description)
    # $itemtext[5]: </td></tr><tr><td><p>
    # $itemtext[6]: <table width="100%" cellspacing=0 cellpadding=0>
    # $itemtext[7]: <td align="left" valign="top">
    # $itemtext[8]: </td><td align="right" valign="top">(date)<br>
    #
    while (my $item = shift @itemtext) {
        $item =~ s|\\"|"|g;
        $item =~ s|\\\\|\\|g;
        if ($item =~ /^<h2>.+href="(.+?)".*?>\s*(.+?)\s*<\/a><\/h2>/) {
            $items{link} = $1;
            $items{title} = $2;
            next;
        }
        elsif ($item =~ /\s*By\s+(.+?)\s*$/) {
            $items{creator} = $1;
            next;
        }
        elsif ($item =~ /\s*on\s+(.+?)\s*$/) {
            $items{subject} = $1;
            next;
        }
        elsif ($item =~ /^<p>(.+?)\s*$/) {
            $items{description} = $1;
            next;
        }
        elsif ($item =~ /((?:Sun|Mon|Tue|Wed|Thu|Fri|Sat).+?)<br>/) {
            $items{date} = $1;
            next;
        }
    }

    return \%items;

}

sub _load_plugins {

    my ($scandir) = @_;
    my ($f, $plugin, @plugins);

    if (-d $scandir && opendir(D, $scandir)) {
        foreach $f (sort readdir(D)) {
            ($plugin) = $f =~ /^\d*(\w+)\.pl$/;
            next unless -f "$scandir/$f" && $plugin;
            require "$scandir/$f";
            $plugin->setup and push @plugins, $plugin;
        }
        closedir(D);
    }

    return @plugins;

}

__END__
### Local Variables:
### mode: perl
### End:

=head1 NAME

bloglines.pl - A utility for retrieving the most recent entries from MyBlogs

=head1 SYNOPSIS

 ./bloglines.pl --folder=1234567

=head1 DESCRIPTION

=head1 AUTHOR

Yutaka Kojima E<lt>yutaka@asmate.netE<gt>

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

The updated version is available from
http://www.asmate.net/software/perl/bloglines/

=cut