File Coverage

blib/lib/WebService/Bloglines/Blogroll.pm

Criterion	Covered	Total	%
statement	58	91	63.7
branch	9	26	34.6
condition	0	6	0.0
subroutine	17	21	80.9
pod	6	6	100.0
total	90	150	60.0

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 .= "$_\n";
		$blogroll_html .= "\n";

		for my $item (@{$blogroll_hash->{$_}}) {
			$blogroll_html .= "$item->{item_title}\n"
														if $item->{item_url} && $item->{item_title};
		}

		$blogroll_html .= ''
	}

	$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__