#!/usr/bin/perl -w
#######################################################################
### $Id: bloglines-0.81.txt,v 1.1 2006/06/09 02:34:48 mate Exp $
###

package Bloglines;

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

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

# $BASE_URL = 'http://rpc.bloglines.com';
# $DISPLAY_URL = "$BASE_URL/getitems";
# $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($LOGIN_EMAIL $LOGIN_PASS $DATA_DIR $PLUGINS_DIR
			$BASE_URL $DISPLAY_URL $LOGIN_URL
			$UA $UA_PROXY $UA_PROXY_BYPASS $UA_TIMEOUT $UA_NAME
			$DEBUG $VERSION @OPTIONS %OPTCTL
			$do_display $do_request $do_parsefile);
$VERSION = '0.81';

my ($plugin, $sub);
my @plugins = _load_plugins($PLUGINS_DIR);
exit unless GetOptions(\%OPTCTL,
					   "subid=i", "unread:i", "date:i", "local", "debug!",
					   @OPTIONS);
$BASE_URL ||= 'http://rpc.bloglines.com';
$DISPLAY_URL ||= "$BASE_URL/getitems";
$DEBUG = exists $OPTCTL{debug} ? $OPTCTL{debug} : 0;

$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));
$UA->credentials("rpc.bloglines.com:80", "Bloglines RPC", $LOGIN_EMAIL, $LOGIN_PASS);

# plugin: display
$do_display = \&display;
foreach $plugin (@plugins) { $plugin->can('display') and
		defined ($sub = $plugin->display) and $do_display = $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: 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, $rss) = &$do_display(\%OPTCTL);

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

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

exit;
# End of Main
#######################################################################

# default subroutine
sub display {
	my ($optref) = @_;
	my ($file, $rss, @query);
	if (exists $optref->{subid}) {
		$file = "$DATA_DIR/display".$optref->{subid};
		push @query, 's='.$optref->{subid};
	}
	if (exists $optref->{unread}) {
		push @query, 'n='.$optref->{unread};
	}
	if (exists $optref->{date}) {
		push @query, 'd='.$optref->{date};
	}
	return () unless (@query);
	if (exists $optref->{local}) {
		$rss = &$do_parsefile($file) or return;
		return ($file, $rss);
	}
	my $uri = "$DISPLAY_URL?".join('&', @query);
	&$do_request($uri, $file)
		or warn("Can't retrieve: $uri\n"), return;
	$rss = &$do_parsefile($file);
	return ($file, $rss);
}

# 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;
	return if $res->code == 304; # no updates
	unless ($res->code == 200) {
		warn "$uri: ", $res->message || "", "\n";
		return;
	}
	return $res;
}

# default subroutine
sub parsefile {
	my $file = shift;
	my $context = "";
	open(F, $file) or warn("Can't open $file: $!"), return;
	{
		local $/;
		$context = <F>;
	}
	close(F);
	my (@rss, %site);
	my @chunks = split(m/(?=<\/?[a-zA-Z_:\s"'=]+>)/s, $context);
	while (@chunks) {
		my $chunk = shift(@chunks);
		#
		# <channel>
		# <title></title>
		# <link></link>
		# <description></description>
		# <language></language>
		# <bloglines:siteid>12345</bloglines:siteid>
		#
		# <item>
		#	  <title></title>
		# <guid isPermaLink="true"></guid>
		# <link></link>
		# <description><![CDATA[...]]></description>
		#	  <pubDate>Fri, 2 Jun 2006 00:00:00 GMT</pubDate>
		# <bloglines:itemid>6789</bloglines:itemid>
		# </item>
		#
		# <item>
		#	  <title></title>
		# <guid isPermaLink="true"></guid>
		# <link></link>
		# <description></description>
		#	  <pubDate>Fri, 2 Jun 2006 00:00:00 GMT</pubDate>
		# <bloglines:itemid>6789</bloglines:itemid>
		# </item>
		# </channel>
		#
		if ($chunk =~ /^<channel>/) {
			%site = ();
		}
		elsif ($chunk =~ /^<(title|link|description|language|bloglines:siteid)>
						  (.*)
						  $/sx) {
			$site{$1} = defined $2 ? $2 : '';
		}
		elsif ($chunk =~ /^<item>/) {
			my %item;
			while (@chunks) {
				my $chunk = shift(@chunks);
				if ($chunk =~ /^<(title|link|description|pubDate|dc:creator|bloglines:itemid)>
							   (.*)
							   $/sx) {
					my $tag = $1;
					$item{$tag} = defined $2 ? $2 : '';
					if ($item{$tag} =~ /^<!\[CDATA\[(.*)$/s) {
						$item{$tag} = $1;
						while (@chunks) {
							if ($item{$tag} =~ /\]\]>$/) {
								$item{$tag} =~ s/\]\]>$//;
								last;
							}
							$item{$tag} .= shift(@chunks);
						}
					}
				}
				elsif ($chunk =~ /^<\/item>/) {
					last;
				}
			}
			$site{items} ||= [];
			push @{$site{items}}, { %item };
		}
		elsif ($chunk =~ /^<\/channel>/) {
			push @rss, { %site };
		}
	}
	return \@rss;
}

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
### indent-tabs-mode: t
### End:

=head1 NAME

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

=head1 SYNOPSIS

 ./bloglines.pl --subid=0
 ./bloglines.pl --subid=0 --unread=1
 ./bloglines.pl --subid=0 --unread=0
 ./bloglines.pl --subid=0 --unread=1 --date=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/

=head1 SEE ALSO

http://www.bloglines.com/services/api/getitems

=cut