File Coverage

blib/lib/Net/Google/Blogger/Blog.pm

Criterion	Covered	Total	%
statement	10	12	83.3
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	14	16	87.5

package Net::Google::Blogger::Blog;

use warnings;
use strict;

use Any::Moose;
use XML::Simple ();
use URI::Escape ();

use Net::Google::Blogger::Blog::Entry;


our $VERSION = '0.09';

has id              => ( is => 'ro', isa => 'Str', required => 1 );
has numeric_id      => ( is => 'ro', isa => 'Str', required => 1 );
has title           => ( is => 'rw', 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 );
has source_xml_tree => ( is => 'ro', isa => 'HashRef', required => 1 );
has blogger         => ( is => 'ro', isa => 'Net::Google::Blogger', required => 1 );

has entries => (
    is         => 'rw',
    isa        => 'ArrayRef[Net::Google::Blogger::Blog::Entry]',
    lazy_build => 1,
    auto_deref => 1,
);

__PACKAGE__->meta->make_immutable;


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

    my $id = $params{source_xml_tree}{id}[0];
    my $links = $params{source_xml_tree}{link};

    return {
        id         => $id,
        numeric_id => $id =~ /(\d+)$/,
        title      => $params{source_xml_tree}{title}[0]{content},
        id_url     => (grep $_->{rel} eq 'self', @$links)[0]{href},
        public_url => (grep $_->{rel} eq 'alternate', @$links)[0]{href},
        post_url   => (grep $_->{rel} =~ /#post$/, @$links)[0]{href},
        %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 (keys %params_to_req_args_map) {
        $req_args{$params_to_req_args_map{$_}} = $params{$_} if exists $params{$_};
    }
    if (my $sort_mode = $params{sort_by}) {
        $req_args{orderby} = $sort_mode_map{$sort_mode};
    }

    # Execute request and parse the response.
    my $response = $self->blogger->http_get($url, %req_args);
    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 Net::Google::Blogger::Blog::Entry->new(
                  source_xml_tree => $_,
                  blog            => $self,
              ),
              @{ $response_tree->{entry} };
    return wantarray ? @entries : \@entries;
}


sub add_entry {
    ## Adds given entry to the blog.
    my $self = shift;
    my ($entry) = @_;

    my $response = $self->blogger->http_post(
        $self->post_url,
        'Content-Type' => 'application/atom+xml',
        Content        => $entry->as_xml,
    );

    die 'Unable to add entry to blog: ' . $response->status_line unless $response->is_success;
    $entry->update_from_http_response($response);

    push @{ $self->entries }, $entry;
    return $entry;
}


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

    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;

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