File Coverage

blib/lib/WebService/Blogger/Blog.pm

Criterion	Covered	Total	%
statement	21	63	33.3
branch	0	16	0.0
condition			n/a
subroutine	7	13	53.8
pod	4	5	80.0
total	32	97	32.9

package WebService::Blogger::Blog;
our $VERSION = '0.23';
use warnings;
use strict;

use Moose;
use XML::Simple ();
use URI::Escape ();
use Encode ();
use WebService::Blogger::Blog::Entry;

with 'WebService::Blogger::AtomReading';

# Blog properties, non-updatable.
has id          => ( is => 'ro', isa => 'Str', required => 1 );
has numeric_id  => ( is => 'ro', isa => 'Str', required => 1 );
has title       => ( is => 'ro', isa => 'Str', required => 1 );
has public_url  => ( is => 'ro', isa => 'Str', required => 1 );
has id_url      => ( is => 'ro', isa => 'Str', required => 1 );
has post_url    => ( is => 'ro', isa => 'Str', required => 1 );

# Service attributes.
has source_xml_tree => ( is => 'ro', isa => 'HashRef', required => 1 );
has blogger         => ( is => 'ro', isa => 'WebService::Blogger', required => 1 );

# Blog entries.
has max_results => ( is => 'rw', isa => 'Num', required => 1, default => 30, );
has entries => (
    is         => 'rw',
    isa        => 'ArrayRef[WebService::Blogger::Blog::Entry]',
    lazy_build => 1,
    auto_deref => 1,
);

# Speed Moose up.
__PACKAGE__->meta->make_immutable;


sub BUILDARGS {
    ## Parses source XML into initial attribute values.
    my $class = shift;
    my %params = @_;

    my $tree = $params{source_xml_tree};
    my $id = $tree->{id}[0];

    # Extract attributes from XML tree and return them to be set in the instance.
    return {
        id         => $id,
        numeric_id => $id =~ /(\d+)$/,
        title      => $tree->{title}[0]{content},
        id_url     => $class->get_link_href_by_rel($tree, 'self'),
        public_url => $class->get_link_href_by_rel($tree, 'alternate'),
        post_url   => $class->get_link_href_by_rel($tree, qr/#post$/),
        %params,
    };
}


sub _build_entries {
    ## Populates the entries attribute, loading all entries for the blog.
    my $self = shift;

    # Search with no parameters.
    return $self->search_entries;
}


sub search_entries {
    ## Returns entries matching search criteria.
    my $self = shift;
    my %params = @_;

    # Construct request URL, incorporating category criteria into it, if given.
    my $url = 'http://www.blogger.com/feeds/' . $self->numeric_id . '/posts/default';
    $url .= '/-/' . join '/', map URI::Escape::uri_escape($_), @{ $params{categories} }
        if $params{categories};

    # Map our parameter names to Blogger's.
    my %params_to_req_args_map = (
        max_results   => 'max-results',
        published_min => 'published-min',
        published_max => 'published-max',
        updated_min   => 'updated-min',
        updated_max   => 'updated-max',
        order_by      => 'orderby',
        offset        => 'start-index',
    );

    # Map our sort mode parameter names to Blogger's.
    my %sort_mode_map = (
        last_modified => 'lastmodified',
        start_time    => 'starttime',
        updated       => 'updated',
    );

    # Populate request arguments hash WRT above mappings.
    my %req_args = (
        alt => 'atom',
    );
    foreach my $param (keys %params_to_req_args_map) {
        my $value = $self->$param if $self->meta->has_attribute($param);
        $value = $params{$param} if exists $params{$param};
        $req_args{$params_to_req_args_map{$param}} = $value if defined $value;
    }
    if (my $sort_mode = $params{sort_by}) {
        $req_args{orderby} = $sort_mode_map{$sort_mode};
    }

    # Execute request and parse the response.
    my $uri_obj = URI->new($url);
    $uri_obj->query_form(%req_args);
    my $response = $self->blogger->http_get($uri_obj);
    my $response_tree = XML::Simple::XMLin($response->content, ForceArray => 1);

    # Return list of entry objects constructed from list of hashes in parsed data.
    my @entries
        = map WebService::Blogger::Blog::Entry->new(
                  source_xml_tree => $_,
                  blog            => $self,
              ),
              @{ $response_tree->{entry} };
    return wantarray ? @entries : \@entries;
}


sub add_entry {
    ## Adds new entry with specified properties to the blog and returns it.
    my $self = shift;
    my %params = @_;

    # Get the XML for creation of new entry and post it to appropriate URL.
    my $creation_xml = WebService::Blogger::Blog::Entry->xml_for_creation(%params);
    my $response = $self->blogger->http_post(
        $self->post_url,
        'Content-Type' => 'application/atom+xml',
        Content        => Encode::encode_utf8($creation_xml),
    );
    die 'Unable to add entry to blog: ' . $response->status_line unless $response->is_success;

    # Create new entry object from the response.
    my $xml_tree = XML::Simple::XMLin($response->content, ForceArray => 1);
    return WebService::Blogger::Blog::Entry->new(source_xml_tree => $xml_tree, blog => $self);
}


sub delete_entry {
    ## Deletes given entry from server as well as list of entries held in blog object.
    my $self = shift;
    my ($entry) = @_;

    # Execute deletion request, with a workaround for proxies blocking DELETE method.
    my $response = $self->blogger->http_post(
        $entry->edit_url,
        'X-HTTP-Method-Override' => 'DELETE',
    );
    die 'Could not delete entry from server: ' . $response->status_line unless $response->is_success;

    # Remove the entry from local list of entries.
    $self->entries([ grep $_ ne $entry, $self->entries ]);
}


sub destroy {
    ## Removes references to the blog from child entries, so they're
    ## no longer circular. Blog object as well as entries can then be
    ## garbage-collected.
    my $self = shift;

    $_->blog(undef) foreach $self->entries;
}


1;

__END__

=head1 NAME

WebService::Blogger::Blog - represents blog entity of Google Blogger service.

=head1 SYNOPSIS

Please see L<WebService::Blogger>.

=head1 DESCRIPTION

This class represents a blog in WebService::Blogger package, and is
not designed to be instantiated directly.

=head1 METHODS

=head3 C<add_entry(%properties)>

=over

Adds given entry to the blog:

 my $new_entry = $blog->add_entry(
     title      => 'New entry',
     content    => 'New content',
     categories => [ 'news', 'testing', 'perl examples' ],
 );

=back

=head3 C<search_entries(%criteria)>

=over

Returns entries matching specified criteria. The following example
contains all possible search conditions:

my @entries = $blog->search_entries(
     published_min => '2010-08-10T23:25:00+04:00'
     published_max => '2010-07-17T23:25:00+04:00',
     updated_min   => '2010-09-17T12:25:00+04:00',
     updated_max   => '2010-09-17T14:00:00+04:00',
     order_by      => 'start_time', # can also be: 'last_modified' or 'updated'
     max_results   => 20,
     offset        => 10,           # skip first 10 entries
);

=back

=head3 C<destroy()>

=over

Removes references to the blog from child entries, so they're no
longer circular. Blog object as well as entries can then be
garbage-collected.

=back

=head1 ATTRIBUTES

=head3 C<id>

=over

Unique ID of the blog, a string in Blogger-specific format as present
in the Atom entry.

=back

=head3 C<numeric_id>

=over

Numeric ID of the blog.

=back

=head3 C<title>

=over

Title of the blog.

=back

=head3 C<public_url>

=over

The human-readable, SEO-friendly URL of the blog.

=back

=head3 C<id_url>

=over

URL of the blog based on its numeric ID. Never changes.

=back

=head3 C<post_url>

=over

URL for publishing new posts.

=back

=head3 C<entries>

=over

List of blog entries, lazily populated.

=back

=head1 AUTHOR

Kedar Warriner, C<< <kedar at cpan.org> >>

=head1 BUGS

Please report any bugs or feature requests to C<bug-webservice-blogger at rt.cpan.org>, or through
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=WebService-Blogger>.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc WebService::Blogger

You can also look for information at:

=over 4

=item * RT: CPAN's request tracker

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=WebService-Blogger>

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/WebService-Blogger>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/WebService-Blogger>

=item * Search CPAN

L<http://search.cpan.org/dist/WebService-Blogger/>

=back

=head1 ACKNOWLEDGEMENTS

 Many thanks to:
  - Egor Shipovalov who wrote the original version of this module
  - Everyone involved with CPAN.

=head1 LICENSE AND COPYRIGHT

Copyright 2010 Kedar Warriner.

This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.

See http://dev.perl.org/licenses/ for more information.

=cut