Net::Tumblr

tumblrのAPIでごにょごにょしようモジュール。インスパイア元→Net::Tumblr - fubaはてな。あっちの実装のがシンプルです。私のは見た目から汚い。
長いので続きを読む記法。

package Net::Tumblr;

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

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

use Carp qw/croak/;
use LWP::UserAgent;

my $api = {
    read  => sub { sprintf 'http://%s.tumblr.com/api', shift },
    write => 'http://www.tumblr.com/api/write',
};

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

sub read {
    my $self = shift;
    my %arg = @_;
    
    my $uid = delete $arg{uid} or croak 'no userid';
    
    return $self->ua->get($api->{read}->($uid), %arg);
}

sub write {
    my $self = shift;
    my $type = '_' . shift or croak;
    my %arg = @_;
    
    $arg{email}     ||= $self->email     or croak 'no email';
    $arg{password}  ||= $self->password  or croak 'no password';
    $arg{generator} ||= $self->generator;
    
    return $self->$type(%arg);
}

sub _regular {
    my $self = shift;
    my %arg = @_;
    
    my $res = $self->ua->post($api->{write}, [
        type => 'regular',
        
        email     => $arg{email},
        password  => $arg{password},
        generator => $arg{generator},
        
        title => $arg{title} || '',
        body  => $arg{body}  || croak 'no body',
    ]);
    return $res;
}

sub _photo {
    my $self = shift;
    my %arg = @_;
    
    my $res = $self->ua->post($api->{write}, [
        type      => 'photo',
        
        email     => $arg{email},
        password  => $arg{password},
        generator => $arg{generator},
        
        caption => $arg{caption} || '',
        source  => $arg{source}  || croak 'no source',
    ]);
    return $res;
}

sub _quote {
    my $self = shift;
    my %arg = @_;
    
    my $res = $self->ua->post($api->{write}, [
        type      => 'quote',
        
        email     => $arg{email},
        password  => $arg{password},
        generator => $arg{generator},
        
        source => $arg{source} || '',
        quote  => $arg{quote}  || croak 'no quote',
    ]);
    return $res;
}

sub _link {
    my $self = shift;
    my %arg = @_;
    
    my $res = $self->ua->post($api->{write}, [
        type => 'link',
        
        email     => $arg{email},
        password  => $arg{password},
        generator => $arg{generator},
        
        name        => $arg{name}        || '',
        description => $arg{description} || '',
        url         => $arg{url}         || croak 'no url',
    ]);
    return $res;
}

sub _conversation {
    my $self = shift;
    my %arg = @_;
    
    my $res = $self->ua->post($api->{write}, [
        type => 'conversation',
        
        email     => $arg{email},
        password  => $arg{password},
        generator => $arg{generator},
        
        title        => $arg{title}        || '',
        conversation => $arg{conversation} || croak 'no conversation',
    ]);
    return $res;
}

sub _video {
    my $self = shift;
    my %arg = @_;
    
    my $res = $self->ua->post($api->{write}, {
        type => 'video',
        
        email     => $arg{email},
        password  => $arg{password},
        generator => $arg{generator},
        
        caption => $arg{caption} || '',
        embed   => $arg{embed}   || croak 'no embed',
    });
    return $res;
}

sub AUTOLOAD {
    my $self = shift;
    our $AUTOLOAD =~ s/^.+:://;
    
    return if $AUTOLOAD eq 'DESTROY';
    
    if ($AUTOLOAD =~ /^_/) {
        croak "unknown internal method: $AUTOLOAD";
    }
    else {
        croak "unknown method: $AUTOLOAD";
    }
}

1;

使い方はこんな感じ。あと引数はutf8にして渡さないとたぶん化けると思う。asciiの範囲でしか試してないからわからないけど。

use Net::Tumblr;
my $t = Net::Tumblr->new(
    email => 'your.address@example.com',
    password => 'YourPassword',
);

my $res = $t->write('photo', source => 'http://www.example.com/foo.jpg');
# $res: HTTP::Response obj.

今書き直し中。