#!/usr/bin/perl -w
#######################################################################
### $Id: bloglines-0.01.txt,v 1.1 2004/02/04 09:28:25 mate Exp $
###

package Bloglines;

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

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

# $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 @OPTIONS %OPTCTL);
my $VERSION = '0.01';

my ($plugin, $sub, %saw);
my @plugins = _load_plugins($PLUGINS_DIR);
exit unless GetOptions(\%OPTCTL, "folder=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
my $display = \&display;
foreach $plugin (@plugins) { $plugin->can('display') and
        defined ($sub = $plugin->display) and $display = $sub and last; }

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

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

# plugin: folder
my (@folder_plugins);
foreach $plugin (@plugins) { $plugin->can('folder') and push @folder_plugins, $plugin; }

# retrieve the entries
foreach my $folder (grep(!$saw{$_}++, @{$OPTCTL{folder}})) {
    my ($file, $list, $site) = &$display($folder) or next;
    foreach $plugin (@folder_plugins) { $plugin->folder($file, $list, $site); }
}

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

sub display {

    my ($folder) = @_;
    my ($list, $site);
    my $file = "$DATA_DIR/display$folder";

    if (exists $OPTCTL{local}) {
        ($list, $site) = &$parse_file($file) or return;
        return ($file, $list, $site);
    }

    my ($res, $title);
    my $retry = 4;
    my $uri = "$DISPLAY_URL?folder=$folder";
    my $login_succeeded = 0;

    while ($retry-- > 0) {
        $res = request($uri, $file) or warn("Can't request: $uri"), return;
        $title = $res->header('Title') || "";
        if ($title =~ /My Blogs/) {
            $login_succeeded = 1;
            last;
        }
        &$login();
        sleep(1);
    }
    $login_succeeded or warn("Can't login: $uri"), return;

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

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

}

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;

}

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;

}

sub parse_file {

    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\+="(.*)";$/) {
                    my $str = $1;
                    $str =~ s|\\"|"|g;
                    push @itemText, $str;
                    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) {
        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