Net::Tumblr - Whitebell::HatenaBlog

~~出かけるのであとで書く。出かけてる間に考えてみたら、dataまわりがちょっと気になるので、もう少し書き直してみます。目標は今年中。~~たぶんでけた。依存増えたけど気にしない。

あとこのエントリ書いてからauthenticate、check-vimeo、check-audioを実装してないことに気づいたけど、後で。check-vimeoは実装しないかも。

依存モジュール

version
Class::Accessor::Fast
HTTP::Request::Common
Image::ExifTool
LWP::UserAgent
Perl6::Slurp
URI
URI::QueryParam

つかいかた

全部は書いてないです。あとで書くメソッド。

# こんすとらくた
my $tumblr1 = Net::Tumblr->new(
    email => YOUR_EMAIL_ADDRESS,
    password => YOUR_PASSWORD,
);

my $tumblr2 = Net::Tumblr->new(
    email => YOUR_EMAIL_ADDRESS,
    password => YOUR_PASSWORD,
    default_uid => 'whitebell',
);

# 読んでみよう。

# 普通に。返値はHTTP::Responseオブジェクト。
my $res1 = $tumblr1->read(uid => 'whitebell');
# JSONで。
my $res2 = $tumblr1->read(uid => 'whitebell', data => 'json');

# コンストラクタにdefault_uidを指定してあれば、uidは省略できる。
# この場合$tumblr1->read(uid => 'whitebell')とおんなじ。
my $res3 = $tumblr2->read;

# ポストしよう。

# テキスト。titleは省略可。
my $res4 = $tumblr1->write(type => 'regular', title => 'title', body => 'body');

# 画像。captionは省略可。
my $res5 = $tumblr1->write(type => 'photo', source => 'http://search.cpan.org/s/img/cpan_banner.png', caption => 'caption');

# ローカルにある画像。dataは次のどれか。ようするに中で使ってる&Perl6::Slurp::slurpが読めるもの。
# * ファイル名
# * ファイルハンドル
# * 型グロブのリファレンス
# * IO::Fileオブジェクト
# * スカラのリファレンス
my $res6 = $tumblr2->write(type => 'photo', data => 'example.jpg', caption => 'caption');

# リンク。name, descriptionは省略可。
my $res7 = $tumblr1->write(type => 'link', name => 'example.com', description => 'description', url => 'http://example.com/');

# 会話。title は省略可。
my $res8 = $tumblr1->write(type => 'conversation', title => 'title', conversation => "a: foo\nb: bar\nc: baz");

# 動画。captionは省略可。embedはYouTubeのURLか、埋め込み用のHTML。
# これもdataが使えるんだけど、vimeoのアカウントいるし作ってない。photoの部分と同じだから書けば出来るだろうけど、テストできないので。
my $res9 = $tumblr1->write(type => 'video', embed => 'http://youtube.com/watch?v=qjL_FM23FzU', caption => 'caption');

# 音声。captionは省略可。dataはphotoと同じ。
my $res10 = $tumblr1->write(type => 'audio', data => 'example.mp3', caption => 'caption');

参考

http://www.tumblr.com/api/
- 本家のリファレンス。英語。
http://lostage.is-a-geek.org/api/tumblr/
- 日本語訳。

コードは以下。

package Net::Tumblr;

use strict;
use warnings;
use version; our $VERSION = qv('0.1.0');

use base qw/Class::Accessor::Fast/;
__PACKAGE__->mk_accessors(qw/email password generator default_uid _ua/);

use Carp qw/croak/;
use LWP::UserAgent;
use HTTP::Request::Common;
use URI;
use URI::QueryParam;
use Image::ExifTool qw/ImageInfo/;
use Perl6::Slurp qw/slurp/;

sub new {
    my $class = shift;
    my %args = @_;
    return bless {
        email       => $args{email}       || '',
        password    => $args{password}    || '',
        generator   => $args{generator}   || "Net::Tumblr/$VERSION",
        default_uid => $args{default_uid} || '',
        _ua         => LWP::UserAgent->new(agagent => ($args{agent} || "Net::Tumblr/$VERSION")),
    }, $class;
}

sub api {
    my ($self, $type, $params) = @_;
    
    if ($type eq 'write') {
        $params or croak 'err: 2nd param undef';
        
        $params->{type} and $params->{type} =~ /^(regular|quote|photo|link|conversation|video|audio)$/i or
            croak q"param 'type': type =~ /^(regular|quote|photo|link|conversation|video|audio)$/";
        $params->{type} = lc $params->{type};
        
        my @params = (
            email     => $params->{email},
            password  => $params->{password},
            type      => $params->{type},
            generator => $params->{generator},
        );
        
        if ($params->{type} eq 'regular') {
            croak 'require body parameter' unless $params->{body};
            
            push @params, 'title', $params->{title} if $params->{title};
            push @params, 'body', $params->{body};
            
            return POST 'http://www.tumblr.com/api/write',
                Content => \@params;
        }
        elsif ($params->{type} eq 'photo') {
            croak 'require source parameter' unless $params->{source} or $params->{data};
            
            push @params, 'caption', $params->{caption} if $params->{caption};
            
            if ($params->{source}) {
                push @params, 'source', $params->{source};
                return POST 'http://www.tumblr.com/api/write',
                    Content => \@params;
            }
            else {
                my $buf = slurp($params->{data}, {irs => undef});
                my $mime = ImageInfo(\$buf)->{MIMEType};
                
                return POST 'http://www.tumblr.com/api/write',
                    Content_Type => 'form-data',
                    Content => [
                        @params,
                        data => [undef, undef, Content_Type => $mime, Content => $buf],
                    ];
            }
        }
        elsif ($params->{type} eq 'quote') {
            croak 'require qupte parameter' unless $params->{quote};
            
            push @params, 'source', $params->{source} if $params->{source};
            push @params, 'quote', $params->{quote};
            
            return POST 'http://www.tumblr.com/api/write',
                Content => \@params;
        }
        elsif ($params->{type} eq 'link') {
            croak 'require url parameter' unless $params->{url};
            
            push @params, 'name', $params->{name} if $params->{name};
            push @params, 'description', $params->{description} if $params->{description};
            push @params, 'url', $params->{url};
            
            return POST 'http://www.tumblr.com/api/write',
                Content => \@params;
        }
        elsif ($params->{type} eq 'conversation') {
            croak 'require conversation parameter' unless $params->{conversation};
            
            push @params, 'title', $params->{title} if $params->{title};
            push @params, 'conversation', $params->{conversation};
            
            return POST 'http://www.tumblr.com/api/write',
                Content => \@params;
        }
        elsif ($params->{type} eq 'video') {
            croak 'require embed parameter' unless $params->{embed};
            
            push @params, 'caption', $params->{caption} if $params->{caption};
            push @params, 'embed', $params->{embed};
            
            return POST 'http://www.tumblr.com/api/write',
                Content => \@params;
        }
        elsif ($params->{type} eq 'audio') {
            croak 'require data parameter' unless $params->{data};
            
            push @params, 'caption', $params->{caption} if $params->{caption};
            
            my $buf = slurp($params->{data}, {irs => undef});
            my $mime = ImageInfo(\$buf)->{MIMEType};
            
            return POST 'http://www.tumblr.com/api/write',
                Content_Type => 'form-data',
                Content => [
                    @params,
                    data => [undef, undef, Content_Type => $mime, Content => $buf],
                ];
        }
        
        croak 'not reached';
    }
    elsif ($type eq 'read') {
        $params or croak 'err: 2nd param undef';
        
        if (!ref $params) {
            return sprintf 'http://%s.tumblr.com/api', $params;
        }
        elsif (ref $params eq 'HASH') {
            my $uri = URI->new(sprintf 'http://%s.tumblr.com/api', $params->{uid});
            
            if (lc $params->{data} eq 'json') {
                $uri->path('/api/json');
                $uri->query_param_append(debug => 1) if $params->{debug};
            }
            
            if ($params->{start}) {
                croak q"param 'start': 0 < start"
                    if $params->{start} != int $params->{start} or $params->{start} < 0;
                $uri->query_param_append(start => int $params->{start});
            }
            if ($params->{num}) {
                croak q"param 'num': 0 <= num <= 50"
                    if $params->{num} != int $params->{num} or $params->{num} > 50 or $params->{num} < 0;
                $uri->query_param_append(num => int $params->{num});
            }
            if ($params->{type}) {
                croak q"param 'type': type =~ /^(regular|quote|photo|link|conversation|video|audio)$/"
                    if $params->{type} !~ /^(regular|quote|photo|link|conversation|video|audio)$/i;
                $uri->query_param_append(type => lc $params->{type});
            }
            if ($params->{id}) {
                croak q"param 'id' must be a positive integer"
                    if $params->{id} != int $params->{id} or $params->{id} < 0;
                $uri->query_param_append(id => int $params->{id});
            }
            
            return $uri->as_string;
        }
        else { croak '2nd param must be scalar or hashref' }
    }
    else { croak 'unknown api type' }
}

sub read {
    my $self = shift;
    my %args = @_;
    unless ($args{uid} ||= $self->default_uid) { croak 'undefined uid' }
    
    return $self->_ua->get(__PACKAGE__->api(read => \%args));
}

sub write {
    my $self = shift;
    my %args = @_;
    
    $args{email}     ||= $self->email     or croak 'no email';
    $args{password}  ||= $self->password  or croak 'no password';
    $args{generator} ||= $self->generator;
    
    return $self->_ua->request(__PACKAGE__->api(write => \%args));
}

1;