package WebService::Bloglines::Blogroll;
use 5.008006;
use strict;
use warnings;
use fields qw(
user_name
folder
url
uri
html
blogroll_hash
blogroll_html
page
http_proxy
ftp_proxy
);
use vars qw($VERSION %FIELDS $AUTOLOAD);
BEGIN {
$VERSION = '0.02';
}
use LWP::Simple qw($ua get);
use Carp;
use Data::Dumper;
{
my $_def_values = {
url => 'rpc.bloglines.com',
uri => 'blogroll',
html => 1,
http_proxy => $ENV{http_proxy},
ftp_proxy => $ENV{ftp_proxy},
};
sub _get_defaults { %$_def_values }
}
sub new {
my $class = shift;
my $self = {};
bless $self, $class;
$self->_init(@_);
return $self;
}
sub _init {
my $self = shift;
my %pars = @_;
my %_defaults = $self->_get_defaults;
for(keys %FIELDS) {
$self->{$_} = exists $pars{$_} ? $pars{$_} : $_defaults{$_};
}
}
sub retrieve_blogroll {
my $self = shift;
$ua->proxy('http', $self->http_proxy);
$ua->proxy('ftp', $self->ftp_proxy);
$self->page(get($self->_get_url));
$self->_parse_blogroll();
}
sub get_blogroll_as_html {
my $self = shift;
my $blogroll_hash = $self->blogroll_hash;
my $blogroll_html;
for(keys %{$blogroll_hash}) {
$blogroll_html .= "<h2>$_</h2>\n";
$blogroll_html .= "<ul>\n";
for my $item (@{$blogroll_hash->{$_}}) {
$blogroll_html .= "<li><a href='$item->{item_url}'>$item->{item_title}</a></li>\n"
if $item->{item_url} && $item->{item_title};
}
$blogroll_html .= '</ul>'
}
$self->blogroll_html($blogroll_html);
}
sub page {
my $self = shift;
if(@_) {
my $page = shift;
if(!$page) {
croak "Cannot retireve a blogroll: \n\tproxy url is
[$ENV{http_proxy}]\n\turl is [".$self->get_url."]";
} elsif($page =~ /The user name you are using to access this blogroll is incorrect/i) {
croak "User name [".$self->user_name."] is not correct!";
}
$self->{page} = $page;
}
return $self->{page};
}
sub _parse_blogroll {
my $self = shift;
my($folder, $item_title, $item_url, %list);
for(split/\n/, $self->page) {
if(/blogrollfolder/) {
($folder) = m#(?:.+)>(.+?)<#;
} elsif(/blogrollitem/) {
($item_url, $item_title) = m#href="(.+?)">(.+?)<#;
push @{ $list{$folder} }, {item_title => $item_title, item_url => $item_url};
}
}
$self->blogroll_hash(\%list);
}
sub _get_url {
my $self = shift;
croak "User name is not specified!" unless $self->user_name;
my $url = 'http://'.$self->url.'/'.$self->uri.'?id='.$self->user_name;
$url .= '&folder='.$self->folder if $self->folder;
$url .= '&html='.$self->html;
return $url;
}
sub get_blogroll_hash {
my $self = shift;
my $folder = shift;
return $self->{blogroll_hash}{$folder} if $self->{blogroll_hash} && $folder;
return $self->{blogroll_hash}
}
sub get_list_folders {
my $self = shift;
if($self->{blogroll_hash}) {
return [ keys %{ $self->{blogroll_hash} } ]
}
}
sub AUTOLOAD {
my $self = shift;
my($class, $attr) = $AUTOLOAD =~ /(.+)::(.+)/;
if(exists $FIELDS{$attr}) {
$self->{$attr} = shift() if @_;
return $self->{$attr};
} else {
croak "Method [$attr] is not found in the class [$class]!";
}
}
sub DESTROY {
my $self = shift;
}
1;
__END__
=head1 NAME
WebService::Bloglines::Blogroll - Perl extension to get a blogroll from
Bloglines.com.
=head1 SYNOPSIS
use WebService::Bloglines::Blogroll;
my $bloglines = new WebService::Bloglines::Blogroll(user_name => 'some valid name');
$bloglines->retrieve_blogroll();
#
# Get blogroll as hash reference which contains a following data structure:
#
# {
# folder_name => [ { item_title => 'title', item_url => 'url' }, ... ],
# . . .
# }
my $blogroll_hash = $bloglines->blogroll_hashref;
#
# Also, you can retrieve a list of item for specific folder
#
my $blogroll_hash = $bloglines->blogroll_hashref('folder_name');
#
# Get blogroll as string contained html code where each folder name surrounded
# by <h2> tags and list of folder's items put into unordered list (<ul>).
# You can easy to embed the blogroll into your design using CSS.
my $blogroll_html = $blog->blogroll_html;
=head1 DESCRIPTION
Bloglines is the most of famous and handy online tool for agregate and read RSS
feeds. WebService::Bloglines::Blogroll is a simple Perl class which can be used
to retrieve your blogroll from Bloglines, process it and display it on your
personal page.
=head2 CONSTRUCTOR
=over 4
=item new()
To retrieve a blogroll from Bloglines it's necessarily to specify an user name of owner of blogroll:
new WebService::Bloglines::Blogroll(user_name => 'some_name');
or
new WebService::Bloglines::Blogroll(user_name => 'some_name', folder => 'some folder');
=back
=head2 OBJECT'S PROPERTIES
=over 4
=item user_name
User name for Bloglines
new WebService::Bloglines::Blogroll(user_name => 'some_name');
or
$bloglines->user_name('some name');
=item folder
A specific folder from Bloglines
new WebService::Bloglines::Blogroll(user_name => 'some_name', folder => 'some folder');
or
$bloglines->user_name('some name');
=item page
Contains an original page received from Bloglines
=item http_proxy
Contains a proxy http proxy. (By default, it's got from environment)
=back
=head2 OBJECT'S METHODS
=over 4
=item retrieve_blogroll()
Get a blogroll from Bloglines according to specified parametes:
my $bloglines = new WebService::Bloglines::Blogroll(user_name => 'name1');
$bloglines->retrieve_blogroll();
my $list = $bloglines->get_blogroll_hash();
. . .
$bloglines->user_name('name2');
$bloglines->retrieve_blogroll();
my $list2 = $bloglines->get_blogroll_hash();
=item get_blogroll_as_html()
Returns a blogroll as HTML:
my $html = $bloglines->get_blogroll_as_html();
=item get_blogroll_hash()
Returns a blogroll as hash:
my $all_items = $bloglines->get_blogroll_hash();
or for specified folder
my $folder_items = $bloglines->get_blogroll_hash('some folder');
=item get_list_folders()
Returns a list of all folders in the Bloglines blogroll
my $folders = $bloglines->get_list_folders();
=back
=head2 EXPORT
None by default.
=head1 SEE ALSO
WebService::Bloglines
=head1 AUTHOR
Michael stepanov, <stepanov.michael@gmail.com>
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2005 by Michael Stepanov
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.6 or,
at your option, any later version of Perl 5 you may have available.
=cut