File Coverage

blib/lib/Net/Google/DataAPI/Role/Service.pm

Criterion	Covered	Total	%
statement	13	15	86.6
branch			n/a
condition			n/a
subroutine	5	5	100.0
pod			n/a
total	18	20	90.0

package Net::Google::DataAPI::Role::Service;
use Any::Moose '::Role';
use Carp;
use LWP::UserAgent;
use URI;
use XML::Atom;
use XML::Atom::Entry;
use XML::Atom::Feed;
use Net::Google::DataAPI::Types;
use Net::Google::DataAPI::Auth::Null;
our $VERSION = '0.04';

$XML::Atom::ForceUnicode = 1;
$XML::Atom::DefaultVersion = 1;

has gdata_version => (
    isa => 'Str',
    is => 'ro',
    required => 1,
    default => '2.0',
);

has ua => (
    isa => 'LWP::UserAgent',
    is => 'ro',
    required => 1,
    lazy_build => 1,
);

has service => (
    does => 'Net::Google::DataAPI::Role::Service',
    is => 'ro',
    required => 1,
    lazy_build => 1,
);

has source => (
    isa => 'Str',
    is => 'ro',
    required => 1,
    default => __PACKAGE__,
);

has auth => (
    is => 'ro',
    does => 'Net::Google::DataAPI::Types::Auth',
    required => 1,
    lazy_build => 1,
    handles => ['sign_request'],
    coerce => 1,
);

has namespaces => (
    isa => 'HashRef[Str]',
    is => 'ro',
);

sub ns {
    my ($self, $name) = @_;

    if ($name eq 'gd') {
        return XML::Atom::Namespace->new('gd', 'http://schemas.google.com/g/2005')
    }
    $self->namespaces->{$name} or confess "Namespace '$name' is not defined!";
    return XML::Atom::Namespace->new($name, $self->namespaces->{$name});
};

sub _build_ua {
    my $self = shift;
    my $ua = LWP::UserAgent->new(
        agent => $self->source,
        requests_redirectable => [],
        env_proxy => 1,
    );
    $ua->default_headers(
        HTTP::Headers->new(
            GData_Version => $self->gdata_version,
        )
    );
    return $ua;
}

sub _build_auth { Net::Google::DataAPI::Auth::Null->new }

sub _build_service {return $_[0]}

sub request {
    my ($self, $args) = @_;
    my $req = $self->prepare_request($args);
    my $uri = $req->uri;
    my $res = eval {$self->ua->request($req)};
    if ($ENV{GOOGLE_DATAAPI_DEBUG} && $res) {
        warn $res->request ? $res->request->as_string : $req->as_string;
        warn $res->as_string;
    }
    if ($@ || $res->is_error) {
        confess sprintf(
            "request for '%s' failed:\n\t%s\n\t%s\n\t",
            $uri,
            ($res ? $res->status_line : $@),
            ($res ? $res->content : $!),
        );
    }
    if (my $res_obj = $args->{response_object}) {
        my $type = $res->content_type;
        if ($res->content_length && $type !~ m{^application/atom\+xml}) {
            confess sprintf(
                "Content-Type of response for '%s' is not 'application/atom+xml':  %s",
                $uri,
                $type
            );
        }
        my $obj = eval {$res_obj->new(\($res->content))};
        confess sprintf(
            "response for '%s' is broken: %s",
            $uri,
            $@
        ) if $@;
        return $obj;
    }
    return $res;
}

sub prepare_request {
    my ($self, $args) = @_;
    if (ref($args) eq 'HTTP::Request') {
        return $args;
    }
    my $method = delete $args->{method};
    $method = $args->{content} || $args->{parts} ? 'POST' : 'GET' unless $method;
    my $uri = URI->new($args->{uri});
    my @existing_query = $uri->query_form;
    $uri->query_form(
        {
            @existing_query,
            %{$args->{query}}
        }
    ) if $args->{query};
    my $req = HTTP::Request->new($method => "$uri");
    if (my $parts = $args->{parts}) {
        $req->header('Content-Type' => 'multipart/related');
        for my $part (@$parts) {
            ref $part eq 'HTTP::Message'
                or confess "part argument should be a HTTP::Message object";
            $req->add_part($part);
        }
    }
    $req->content($args->{content}) if $args->{content};
    $req->header('Content-Type' => $args->{content_type}) if $args->{content_type};
    if ($args->{header}) {
        while (my @pair = each %{$args->{header}}) {
            $req->header(@pair);
        }
    }
    $self->sign_request($req, $args->{sign_host});
    return $req;
}

sub get_feed {
    my ($self, $url, $query) = @_;
    return $self->request(
        {
            uri => $url,
            query => $query,
            response_object => 'XML::Atom::Feed',
        }
    );
}

sub get_entry {
    my ($self, $url) = @_;
    return $self->request(
        {
            uri => $url,
            response_object => 'XML::Atom::Entry',
        }
    );
}

sub post {
    my ($self, $url, $entry, $header) = @_;
    return $self->request(
        {
            uri => $url,
            content => $entry->as_xml,
            header => $header || undef,
            content_type => 'application/atom+xml',
            response_object => ref $entry,
        }
    );
}

sub put {
    my ($self, $args) = @_;
    return $self->request(
        {
            method => 'PUT',
            uri => $args->{self}->editurl,
            content => $args->{entry}->as_xml,
            header => {'If-Match' => $args->{self}->etag },
            content_type => 'application/atom+xml',
            response_object => 'XML::Atom::Entry',
        }
    );
}

sub delete {
    my ($self, $args) = @_;
    my $res = $self->request(
        {
            uri => $args->{self}->editurl,
            method => 'DELETE',
            header => {'If-Match' => $args->{self}->etag},
        }
    );
    return $res;
}

no Any::Moose '::Role';

1;

__END__

=pod

=head1 NAME

Net::Google::DataAPI::Role::Service - provides base functionalities for Google Data API service

=head1 SYNOPSIS

    package MyService;
    use Any::Moose;
    use Net::Google::DataAPI;
    with 'Net::Google::DataAPI::Role::Service' => {
        service => 'wise',
        source => __PACKAGE__,
        ns => {
            foobar => 'http://example.com/schema#foobar',
        },
    }

    feedurl hoge => (
        is => 'ro',
        isa => 'Str',
        entry_class => 'MyService::Hoge',
        default => 'http://example.com/feed/hoge',
    );

    1;

=head1 DESCRIPTION

=head1 AUTHOR

Nobuo Danjou E<lt>[e-mail]<gt>

=head1 SEE ALSO

L<Net::Google::AuthSub>

L<Net::Google::DataAPI>

=cut