追記 2007/12/11
Tumblr v3 になってからメンテナンスしていないので現在このコードは動きません。
Tumblrのbotでも作ってみようかと思ったんだけど、APIからはReblogとかできないのでmechを使って書いてみた。モジュール書いたの初めて。名前がTumblr::BotとかだったりPODの英語がひどいってレベルじゃない、というか途中で書くのあきらめたりしてるけどそこは目をつぶってください。
- 参考にさせていただきました。ありがとうございます!
使う人がいるかどうかわかりませんが、ログインを伴う操作をするとブラウザの方がログアウトしてしまうので注意。readとwrite以外。
use Tumblr::Bot;
use YAML;
use XML::Simple;
my $email = 'youremail@example.com';
my $password = 'password';
my $tumblr = Tumblr::Bot->new(
email => $email,
password => $password,
);
warn $tumblr->dashboard;
warn Dump $tumblr->friends;
warn Dump $tumblr->followers;
warn Dump XMLin $tumblr->read(
id => 'user',
start => 0,
num => 5,
);
$tumblr->write(
type => 'photo',
source => 'http://example.com/photo.jpg',
);
$tumblr->add_friend('http://user.tumblr.com/');
$tumblr->reblog('http://user.tumblr.com/post/xxxxxxx');
package Tumblr::Bot;
use strict;
use WWW::Mechanize;
use WWW::Mechanize::DecodedContent;
use Web::Scraper;
use Switch;
use Encode qw//;
use URI;
our $VERSION = '0.01';
sub new {
my ( $class, %options ) = @_;
my $email = delete $options{email};
my $password = delete $options{password};
$options{agent} ||= __PACKAGE__ . '/' . $Tumblr::Bot::VERSION;
$options{cookie_jar} ||= {};
my $mech = WWW::Mechanize->new(%options);
my $self = bless {
mech => $mech,
login => {
email => $email,
password => $password,
}
}, $class;
$self;
}
sub login {
my $self = shift;
$self->post( 'http://www.tumblr.com/login' => $self->{login} );
warn 'logged in to tumblr';
}
sub get_content {
my ( $self, $uri, $encoding ) = @_;
my $content = $self->get($uri) ? $self->content : undef;
if ( $content && $encoding ) {
$content = Encode::encode( $encoding => $content );
}
$content;
}
sub get {
my ( $self, $uri ) = @_;
$self->{mech}->get($uri);
if ( $self->{mech}->uri =~ /login/ig ) {
$self->login;
$self->{mech}->get($uri);
}
$self->{mech}->success;
}
sub post {
my ( $self, $uri, $options ) = @_;
$self->{mech}->post($uri, $options);
$self->{mech}->success;
}
sub content {
my $self = shift;
$self->{mech}->decoded_content;
}
sub dashboard {
my $self = shift;
$self->get_content('http://www.tumblr.com/dashboard');
}
sub read {
my ( $self, %options ) = @_;
my $id = delete $options{id};
my $uri = URI->new( sprintf 'http://%s.tumblr.com/api/read', $id );
$uri->query_form(\%options);
$self->get_content($uri);
}
sub write {
my ( $self, %params ) = @_;
return unless $self->_validate_write(%params);
$params{email} = $self->{login}{email};
$params{password} = $self->{login}{password};
$params{generator} = $self->{mech}{agent};
$self->post( 'http://www.tumblr.com/api/write' => \%params );
}
sub _validate_write {
my ( $self, %params ) = @_;
switch ( lc $params{type} ) {
case 'regular' {
return (defined $params{title} || defined $params{body});
}
case 'photo' {
return (defined $params{source} || defined $params{data});
}
case 'quote' {
return defined $params{quote};
}
case 'link' {
return defined $params{url};
}
case 'conversation' {
return defined $params{conversation};
}
case 'video' {
return defined $params{embed};
}
}
}
sub add_friend {
my ( $self, $tumblr ) = @_;
my $uri = URI->new('http://www.tumblr.com/publisher/iframe');
$uri->query_form( src => $tumblr );
$self->get($uri);
if ( $self->content =~ /form/ ) {
$self->{mech}->submit_form( form_number => 1 );
}
else {
warn 'already your friend';
}
}
sub friends {
my $self = shift;
my $scraper = scraper {
process '//ul[@id="friends"]/li', 'friends[]' => scraper {
process '//a[2]', name => 'TEXT',
process '//a[2]', url => '@href',
process 'img', img => '@src',
};
};
$scraper->scrape(
\$self->dashboard, URI->new('http://www.tumblr.com/dashboard')
)->{friends};
}
sub followers {
my $self = shift;
my $scraper = scraper {
process '//ul[@id="followers"]/li/a[1]', 'followers[]' => scraper {
process 'img', 'name' => '@alt',
process 'a', url => '@href',
process 'img', 'img' => '@src',
};
};
$scraper->scrape(
\$self->dashboard, URI->new('http://www.tumblr.com/dashboard')
)->{followers};
}
sub reblog {
my ( $self, $post ) = @_;
my($id) = $post =~ m{/post/(\d+)$};
my $url = 'http://www.tumblr.com/reblog/' . $id;
$self->get($url);
$self->{mech}->submit_form( form_number => 1 );
}
1;
=head1 NAME
=head1 SYNOPSIS
use Tumblr::Bot;
use YAML;
use XML::Simple;
my $email = 'youremail@example.com';
my $password = 'password';
my $tumblr = Tumblr::Bot->new(
email => $email,
password => $password,
);
warn $tumblr->dashboard;
warn Dump $tumblr->friends;
warn Dump $tumblr->followers;
warn Dump XMLin $tumblr->read(
id => 'user',
start => 0,
num => 5,
);
$tumblr->write(
type => 'photo',
source => 'http://example.com/photo.jpg',
);
$tumblr->add_friend('http://user.tumblr.com/');
$tumblr->reblog('http://user.tumblr.com/post/xxxxxxx');
=head1 DESCRIPTION
=head1 METHODS
=head2 new
=over4
=item email, passowrd
=back
=head2 dashboard
=head2 friends
=head2 followers
=head2 read
=over4
=item id, start, num
L<http://www.tumblr.com/api>
=back
=head2 write
=over4
=item type
L<http://www.tumblr.com/api>
=back
=head2 add_friend
=over4
=item tumblr home url
=back
=head2 reblog
=over4
=item permalink
=back
=head1 AUTHOR
E<lt>E<gt>
=head1 LICENSE
=head1 SEE ALSO
L<http://www.tumblr.com/>L<http://www.tumblr.com/faqs>L<http://www.tumblr.com/api>
=cut