File Coverage

blib/lib/WebService/Hatena/Fotolife.pm

Criterion	Covered	Total	%
statement	6	6	100.0
branch			n/a
condition			n/a
subroutine	2	2	100.0
pod			n/a
total	8	8	100.0

package WebService::Hatena::Fotolife;
use 5.008001;
use base qw(XML::Atom::Client);

use strict;
use warnings;
use FileHandle;
use Encode qw(encode_utf8 is_utf8);
use Image::Info qw(image_info);

use WebService::Hatena::Fotolife::Entry;

our $VERSION = '0.07';
our $PostURI = 'http://f.hatena.ne.jp/atom/post';
our $FeedURI = 'http://f.hatena.ne.jp/atom/feed';

use constant GEORSS => q;

sub new {
    my $class   = shift;
    my %params  = @_;
    my $headers = delete $params{headers} || [];
    my $consumer_key = delete $params{consumer_key};
    my $consumer_secret = delete $params{consumer_secret};
    my $access_token = delete $params{access_token};
    my $access_token_secret = delete $params{access_token_secret};
    my $self    = $class->SUPER::new(%params)
        or return $class->error($class->SUPER::errstr);

    $self->{consumer_key} = $consumer_key;
    $self->{consumer_secret} = $consumer_secret;
    $self->{access_token} = $access_token;
    $self->{access_token_secret} = $access_token_secret;

    $self->{headers} = $headers;
    $self->{ua}->agent(__PACKAGE__."/$VERSION");
    $self;
}

sub use_oauth {
    return defined $_[0]->access_token;
}

sub consumer_key { $_[0]->{consumer_key} }
sub consumer_secret { $_[0]->{consumer_secret} }
sub access_token { $_[0]->{access_token} }
sub access_token_secret { $_[0]->{access_token_secret} }

sub createEntry {
    my ($self, %param) = @_;

    return $self->error('title and image source are both required')
        unless $param{title} || grep {!$_} @param{qw(filename scalarref)};

    my $image = $self->_get_image($param{filename} || $param{scalarref})
        or return $self->error($self->errstr);
    my $entry = $self->_make_entry(create => +{ %param, image => $image });

    $self->SUPER::createEntry($PostURI, $entry);
}

sub updateEntry {
    my ($self, $EditURI, %param) = @_;

    return $self->error('EditURI and title are both required')
        unless $EditURI || $param{title};

    my $entry = $self->_make_entry(update => \%param);

    $self->SUPER::updateEntry($EditURI, $entry);
}

sub munge_request {
    my $self    = shift;
    my $req     = shift;
    my $headers = [@{ $self->{headers} }];

    if ($self->use_oauth) {
        require OAuth::Lite::Consumer;
        require OAuth::Lite::Token;
        require OAuth::Lite::AuthMethod;

        my $consumer = OAuth::Lite::Consumer->new(
            consumer_key => $self->consumer_key,
            consumer_secret => $self->consumer_secret,
            auth_method => OAuth::Lite::AuthMethod::URL_QUERY(),
        );
        my $access_token = OAuth::Lite::Token->new(
            token => $self->access_token,
            secret => $self->access_token_secret,
        );
        my $url = $req->uri;
        $req->uri($url . '?' . $consumer->gen_auth_query($req->method, $url, $access_token, {}));
    } else {
        $self->SUPER::munge_request($req);
    }
    while (my ($key, $value) = splice @$headers, 0, 2) {
        $req->header($key => $value);
    }

    $req;
}

sub munge_response {
    my $self = shift;
    my $res  = shift;

    my $status = $res->header('Status');
    if ($status and $status =~ s/^(\d+)\s+(?=.+)//) {
        $res->code($1);
        $res->message($status);
    }

    $self->SUPER::munge_response($res, @_);
}

sub getFeed {
    my $self = shift;
       $self->SUPER::getFeed($FeedURI);
}

sub _make_entry {
    my ($self, $method, $param) = @_;
    $param ||= {};

    my $entry = WebService::Hatena::Fotolife::Entry->new;
       $entry->title($param->{title});
       $entry->generator($param->{generator}) if defined $param->{generator};

    if ($method eq 'create') {
        my $image = $param->{image};
        $entry->content(${$image->{content}});
        $entry->content->type($image->{content_type});
    }

    if (defined $param->{folder}) {
        my $dc = XML::Atom::Namespace->new(dc => 'http://purl.org/dc/elements/1.1/');
        $entry->set($dc, 'subject', $param->{folder});
    }

    if (defined $param->{lat} && defined $param->{lon}) {
        my $georss = XML::Atom::Namespace->new(georss => GEORSS);
        $entry->set($georss, 'point', $param->{lat} . ' ' . $param->{lon});
    }

    if ($param->{hatena} && ref $param->{hatena} eq 'HASH') {
        my $hatena = XML::Atom::Namespace->new(
            hatena => 'http://www.hatena.ne.jp/info/xmlns#'
        );

        for my $key (keys %{$param->{hatena}}) {
            $entry->set($hatena, $key, $param->{hatena}{$key});
        }
    }

    $entry;
}

sub _get_image {
    my ($self, $image_source) = @_;
    my $image;

    if (ref $image_source eq 'SCALAR') {
        $image = $image_source;
    }
    else {
        $image = do {
            local $/ = undef;
            my $fh = FileHandle->new($image_source)
                or return $self->error("can't open $image_source: $!");
            my $content = <$fh>;
            \$content;
        };
    }

    my $info  = Image::Info::image_info($image);
    return $self->error($info->{error})
        if $info->{error} and $info->{error} !~ /short read/;

    my $mime = $info->{file_media_type};
    if (ref $mime eq 'ARRAY') {
        $mime = $mime->[0];
    }

    +{
        content      => $image,
        content_type => $mime,
    };
}

1;

__END__