@@ -0,0 +1,8 @@
+Main maintainer:
+ David Moreno <david@axiombox.com>
+
+Contributors (from the git history):
+ Squeeks <privacymyass@gmail.com>
+ Artem Krivopolenov <akrivopolenov@gmail.com>
+ Fernando Vezzosi <buccia@repnz.net>
+
@@ -1,3 +1,19 @@
+5.00 - Sun Aug 25 15:35:41 CEST 2013
+ - Final 5.00.
+
+5.00_04 - Fri Aug 23 10:06:19 CEST 2013
+ - Dealing with stupid upstream Tumblr API responses.
+
+5.00_03 - Wed Aug 21 11:47:34 CEST 2013
+ - Added note for 5.00_02, since I forgot :)
+
+5.00_02 - Wed Aug 21 11:26:38 CEST 2013
+ - Minor POD syntax fixes.
+ - Using File::Spec on a couple of tests.
+
+5.00_01 - Tue Aug 20 23:52:40 CEST 2013
+ - Added support for Tumblr API v2.
+
4.1 - Mon Jun 15 12:04:03 EDT 2009
- Fixed issue with missing user/passwd on delete/read
RT#46716. Thanks to http://suzuki.openid.ne.jp/
@@ -1,11 +1,38 @@
-examples/authenticate.pl
-examples/check-audio.pl
-examples/check-vimeo.pl
-examples/read_json.pl
-examples/write.pl
-lib/WWW/Tumblr.pm
+AUTHORS
Changes
+examples/oauth_1.cgi
+examples/oauth_2.cgi
+lib/WWW/Tumblr.pm
+lib/WWW/Tumblr/API.pm
+lib/WWW/Tumblr/Authentication.pm
+lib/WWW/Tumblr/Authentication/APIKey.pm
+lib/WWW/Tumblr/Authentication/None.pm
+lib/WWW/Tumblr/Authentication/OAuth.pm
+lib/WWW/Tumblr/Blog.pm
+lib/WWW/Tumblr/ResponseError.pm
+lib/WWW/Tumblr/Tagged.pm
+lib/WWW/Tumblr/Test.pm
+lib/WWW/Tumblr/User.pm
Makefile.PL
-MANIFEST
+MANIFEST This list of files
README
-Rakefile
+t/00-load.t
+t/01-blog_info.t
+t/02-blog_avatar.t
+t/03-blog_likes.t
+t/04-blog_followers.t
+t/05-blog_posts.t
+t/06-blog_postings.t
+t/07-blog_post_data_image.t
+t/08-blog_post_data_images.t
+t/09-user_info.t
+t/10-user_dashboard.t
+t/11-user_likes.t
+t/12-user_following.t
+t/13-user_follow.t
+t/14-user_unfollow.t
+t/15-tagged.t
+t/data/larrywall.jpg
+t/data/learnperl.jpg
+META.yml Module YAML meta-data (added by MakeMaker)
+META.json Module JSON meta-data (added by MakeMaker)
@@ -0,0 +1,57 @@
+{
+ "abstract" : "unknown",
+ "author" : [
+ "David Moreno <david@axiombox.com>"
+ ],
+ "dynamic_config" : 1,
+ "generated_by" : "ExtUtils::MakeMaker version 6.72, CPAN::Meta::Converter version 2.132140",
+ "license" : [
+ "perl_5"
+ ],
+ "meta-spec" : {
+ "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
+ "version" : "2"
+ },
+ "name" : "WWW-Tumblr",
+ "no_index" : {
+ "directory" : [
+ "t",
+ "inc"
+ ]
+ },
+ "prereqs" : {
+ "build" : {
+ "requires" : {
+ "ExtUtils::MakeMaker" : "0",
+ "LWP::Simple" : "0",
+ "Test::More" : "0"
+ }
+ },
+ "configure" : {
+ "requires" : {
+ "ExtUtils::MakeMaker" : "0"
+ }
+ },
+ "runtime" : {
+ "requires" : {
+ "HTTP::Request::Common" : "0",
+ "JSON" : "0",
+ "LWP::UserAgent" : "0",
+ "Moose" : "0",
+ "Net::OAuth::Client" : "0"
+ }
+ }
+ },
+ "release_status" : "stable",
+ "resources" : {
+ "X_twitter" : "http://twitter.com/habanerd",
+ "bugtracker" : {
+ "web" : "https://github.com/damog/www-tumblr/issues"
+ },
+ "homepage" : "http://github.com/damog/www-tumblr",
+ "repository" : {
+ "url" : "git://github.com/damog/www-tumblr.git"
+ }
+ },
+ "version" : "5.00"
+}
@@ -0,0 +1,33 @@
+---
+abstract: unknown
+author:
+ - 'David Moreno <david@axiombox.com>'
+build_requires:
+ ExtUtils::MakeMaker: 0
+ LWP::Simple: 0
+ Test::More: 0
+configure_requires:
+ ExtUtils::MakeMaker: 0
+dynamic_config: 1
+generated_by: 'ExtUtils::MakeMaker version 6.72, CPAN::Meta::Converter version 2.132140'
+license: perl
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
+name: WWW-Tumblr
+no_index:
+ directory:
+ - t
+ - inc
+requires:
+ HTTP::Request::Common: 0
+ JSON: 0
+ LWP::UserAgent: 0
+ Moose: 0
+ Net::OAuth::Client: 0
+resources:
+ X_twitter: http://twitter.com/habanerd
+ bugtracker: https://github.com/damog/www-tumblr/issues
+ homepage: http://github.com/damog/www-tumblr
+ repository: git://github.com/damog/www-tumblr.git
+version: 5.00
@@ -1,8 +1,36 @@
-#!/usr/bin/perl
-
+use strict;
+use warnings;
use ExtUtils::MakeMaker;
WriteMakefile(
- NAME => 'WWW::Tumblr',
- VERSION_FROM => 'lib/WWW/Tumblr.pm'
+ NAME => 'WWW::Tumblr',
+ VERSION_FROM => 'lib/WWW/Tumblr.pm',
+ AUTHOR => q{David Moreno <david@axiombox.com>},
+ LICENSE => 'perl',
+
+ PREREQ_PM => {
+ 'Moose' => 0,
+ 'JSON' => 0,
+ 'LWP::UserAgent' => 0,
+ 'Net::OAuth::Client' => 0,
+ 'HTTP::Request::Common' => 0,
+ },
+
+ TEST_REQUIRES => {
+ 'Test::More' => 0,
+ 'LWP::Simple' => 0,
+ },
+
+ META_MERGE => {
+ resources => {
+ homepage => 'http://github.com/damog/www-tumblr',
+ repository => 'git://github.com/damog/www-tumblr.git',
+ x_twitter => 'http://twitter.com/habanerd',
+ bugtracker => 'https://github.com/damog/www-tumblr/issues',
+ }
+ },
+
+ dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
+ clean => { FILES => 'WWW::Tumblr-*' },
+
);
@@ -1 +1 @@
-See the pod or the Changes file.
\ No newline at end of file
+WWW::Tumblr - Perl bindings for the Tumblr API.
Please refer to https://metacpan.org/module/WWW::Tumblr for detailed
documentation and information about this module. Such a link will always point to
last stable release.
https://github.com/damog/www-tumblr contains the git repository where only
tags should be considered as stable releases.
--
David Moreno - http://damog.net/
\ No newline at end of file
@@ -1,14 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-
-use lib '../lib';
-
-use WWW::Tumblr;
-
-my $t = WWW::Tumblr->new;
-
-$t->email('damogar@gmail.com');
-$t->password('zemIjAeRZYLkE8TxRv2duRWlqtpDlAMkqRJkEdrQlhUv6o1y');
-$t->authenticate or die $t->errstr;
@@ -1,14 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-
-use lib '../lib';
-
-use WWW::Tumblr;
-
-my $t = WWW::Tumblr->new;
-
-$t->email('damogar@gmail.com');
-$t->password('zemIjAeRZYLkE8TxRv2duRWlqtpDlAMkqRJkEdrQlhUv6o1y');
-$t->check_audio or die $t->errstr;
@@ -1,17 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-
-use lib '../lib';
-
-use WWW::Tumblr;
-
-my $t = WWW::Tumblr->new;
-
-$t->email('hola@adios.com');
-$t->password('sdf');
-
-my $s = $t->check_vimeo or die $t->errstr;
-
-print $s;
\ No newline at end of file
@@ -0,0 +1,35 @@
+#!/usr/bin/env perl -w
+
+use strict;
+use 5.014;
+use lib '../lib/';
+
+use Storable;
+use WWW::Tumblr::Authentication::OAuth;
+
+my $tumblr_oauth = WWW::Tumblr::Authentication::OAuth->new(
+ consumer_key => 'xxx',
+ secret_key => 'xxx',
+ callback => 'http://localhost/callback',
+);
+
+say $tumblr_oauth->authorize_url();
+
+# Save session
+say "Session saved";
+store $tumblr_oauth->session_store, 'tmp_session';
+
+print "Enter oauth token: ";
+chomp( my $oauth_token = <STDIN> );
+
+print "Enter oauth verifier: ";
+chomp( my $oauth_verifier = <STDIN> );
+
+say "Restore session";
+$tumblr_oauth->session_store( retrieve('tmp_session') );
+
+$tumblr_oauth->oauth_token( $oauth_token );
+$tumblr_oauth->oauth_verifier( $oauth_verifier );
+
+say $tumblr_oauth->token();
+say $tumblr_oauth->token_secret();
\ No newline at end of file
@@ -0,0 +1,35 @@
+#!/usr/bin/env perl -w
+
+use strict;
+use 5.014;
+use lib '../lib/';
+
+use Storable;
+use WWW::Tumblr;
+
+my $oauth = WWW::Tumblr->new(
+ consumer_key => 'xxx',
+ secret_key => 'xxx',
+ callback => 'http://localhost/callback',
+)->oauth_tools;
+
+say $oauth->authorize_url();
+
+# Save session
+say "Session saved";
+store $oauth->session_store, 'tmp_session';
+
+print "Enter oauth token: ";
+chomp( my $oauth_token = <STDIN> );
+
+print "Enter oauth verifier: ";
+chomp( my $oauth_verifier = <STDIN> );
+
+say "Restore session";
+$oauth->session_store( retrieve('tmp_session') );
+
+$oauth->oauth_token( $oauth_token );
+$oauth->oauth_verifier( $oauth_verifier );
+
+say $oauth->token();
+say $oauth->token_secret();
\ No newline at end of file
@@ -1,13 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-
-use lib '../lib';
-
-use WWW::Tumblr;
-
-my $t = WWW::Tumblr->new;
-
-$t->user('damog');
-print $t->read_json(id => 27715443);
@@ -1,16 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-
-use lib '../lib';
-
-use WWW::Tumblr;
-
-my $tumblr = WWW::Tumblr->new;
-
-$tumblr->email('foo@bar.com');
-$tumblr->password('');
-
-$tumblr->write(type => 'regular', title => 'whaaaaaaaaaa')
- or die $tumblr->errstr;
\ No newline at end of file
@@ -0,0 +1,50 @@
+package WWW::Tumblr::API;
+
+use strict;
+use warnings;
+
+use Moose;
+use JSON 'decode_json';
+use Moose::Exporter;
+Moose::Exporter->setup_import_methods(with_caller => ['tumblr_api_method']);
+use WWW::Tumblr::ResponseError;
+
+sub tumblr_api_method ($$) {
+ my $class = Moose::Meta::Class->initialize( shift );
+ my $method_name = $_[0];
+ my $method_spec = $_[1];
+
+ my $sub = sub {
+ my $self = shift;
+ my $args = { @_ };
+
+ my ( $http_method, $auth_method, $req_params, $url_param ) = @{ $method_spec };
+
+ my $kind = lc( pop( @{ [ split '::', ref $self ] }));
+
+ my $response = $self->_tumblr_api_request({
+ auth => $auth_method,
+ http_method => $http_method,
+ url_path => $kind . '/' . ( $kind eq 'blog' ? $self->base_hostname . '/' : '' ) .
+ join('/', split /_/, $method_name) .
+ ( defined $url_param && defined $args->{ $url_param } ?
+ '/' . delete( $args->{ $url_param } ) : ''
+ ),
+ extra_args => $args,
+ });
+
+ if ( $response->is_success || ( $response->code == 301 && $method_name eq 'avatar') ) {
+ return decode_json($response->decoded_content)->{response};
+ } else {
+ $self->error( WWW::Tumblr::ResponseError->new(
+ response => $response
+ ) );
+ return;
+ }
+ };
+
+ $class->add_method($method_name, $sub );
+
+}
+
+1;
@@ -0,0 +1,8 @@
+package WWW::Tumblr::Authentication::APIKey;
+
+use strict;
+use warnings;
+
+use base 'WWW::Tumblr::Authentication';
+
+1;
@@ -0,0 +1,8 @@
+package WWW::Tumblr::Authentication::None;
+
+use strict;
+use warnings;
+
+use base 'WWW::Tumblr::Authentication';
+
+1;
@@ -0,0 +1,44 @@
+package WWW::Tumblr::Authentication::OAuth;
+
+use strict;
+use warnings;
+
+use Carp;
+use Moose;
+
+use base 'WWW::Tumblr::Authentication';
+extends 'WWW::Tumblr';
+
+has 'authorize_url', is => 'rw', isa => 'Str', lazy => 1, default => sub {
+ my $self = shift;
+ croak "The consumer_key and secret_key must be defined!"
+ unless $self->consumer_key && $self->secret_key;
+
+ return $self->oauth->authorize_url();
+};
+
+has 'oauth_token', is => 'rw', isa => 'Str';
+has 'oauth_verifier', is => 'rw', isa => 'Str';
+
+has 'token', is => 'rw', isa => 'Str', lazy => 1, default => sub{ shift->_get_token() };
+has 'token_secret', is => 'rw', isa => 'Str', lazy => 1, default => sub { shift->_get_token('secret') };
+
+has '_access_token', is => 'rw';
+
+sub _get_token {
+ my $self = shift;
+ my $type = shift || 'token';
+
+ croak "Cannot get OAuth token without 'oauth_token' and 'oauth_verifier' defined!"
+ unless $self->oauth_token && $self->oauth_verifier;
+
+ warn "Session looks empty, _get_token will fall, probably"
+ unless keys %{ $self->_session };
+
+ $self->_access_token( $self->oauth->get_access_token( $self->oauth_token, $self->oauth_verifier ) )
+ unless $self->_access_token;
+
+ return $type eq 'secret' ? $self->_access_token->token_secret : $self->_access_token->token;
+}
+
+1;
@@ -0,0 +1,12 @@
+package WWW::Tumblr::Authentication;
+
+use strict;
+use warnings;
+
+use base 'WWW::Tumblr';
+
+use WWW::Tumblr::Authentication::None;
+use WWW::Tumblr::Authentication::APIKey;
+use WWW::Tumblr::Authentication::OAuth;
+
+1;
@@ -0,0 +1,181 @@
+package WWW::Tumblr::Blog;
+use Moose;
+use Data::Dumper;
+use JSON;
+
+use WWW::Tumblr::API;
+extends 'WWW::Tumblr';
+
+has 'base_hostname', is => 'rw', isa => 'Str', required => 1;
+
+tumblr_api_method info => [ 'GET', 'apikey' ];
+tumblr_api_method avatar => [ 'GET', 'none', undef, 'size' ];
+tumblr_api_method likes => [ 'GET', 'apikey'];
+tumblr_api_method followers => [ 'GET', 'oauth' ];
+
+tumblr_api_method posts => [ 'GET', 'apikey', undef, 'type' ];
+tumblr_api_method posts_queue => [ 'GET', 'oauth' ];
+tumblr_api_method posts_draft => [ 'GET', 'oauth' ];
+tumblr_api_method posts_submission => [ 'GET', 'oauth' ];
+
+tumblr_api_method post_delete => [ 'POST', 'oauth' ];
+
+# posting methods!
+
+my %post_required_params = (
+ text => 'body',
+ photo => { any => [qw(source data)] },
+ quote => 'quote',
+ link => 'url',
+ chat => 'conversation',
+ audio => { any => [qw(external_url data)] },
+ video => { any => [qw(embed data)] },
+);
+
+sub post {
+ my $self = shift;
+ my %args = @_;
+
+ $self->_post( %args );
+}
+
+sub _post {
+ my $self = shift;
+ my %args = @_;
+
+ my $subr = join('/', split( /_/, [ split '::', [ caller( 1 ) ]->[3] ]->[-1] ) );
+
+ Carp::croak "no type specified when trying to post"
+ unless $args{ type };
+
+ # check for required params per type:
+
+ if ( $post_required_params{ $args{ type } } ) {
+ my $req = $post_required_params{ $args{ type } };
+ if ( ref $req && ref $req eq 'HASH' && defined $req->{any} ) {
+ Carp::croak "Trying to post type ".$args{type}." without any of: " .
+ join( ' ', @{ $req->{any} } )
+ if scalar( grep { $args{ $_ } } @{ $req->{any} } ) == 0;
+ } else {
+ Carp::croak "Trying to post type ".$args{type}." without: $req"
+ unless defined $args{ $req };
+ }
+ }
+
+ my $response = $self->_tumblr_api_request({
+ auth => 'oauth',
+ http_method => 'POST',
+ url_path => 'blog/' . $self->base_hostname . '/' . $subr,
+ extra_args => \%args,
+ });
+
+ if ( $response->is_success ) {
+ return decode_json( $response->decoded_content)->{response};
+ } else {
+ $self->error( WWW::Tumblr::ResponseError->new(
+ response => $response
+ ));
+ return
+ }
+}
+
+sub post_edit {
+ my $self = shift;
+ my %args = @_;
+ Carp::croak "no id specified when trying to edit a post!"
+ unless $args{ id };
+
+ $self->_post( %args );
+}
+
+sub post_reblog {
+ my $self = shift;
+ my %args = @_;
+
+ Carp::croak "no id specified when trying to reblog a post!"
+ unless $args{ id };
+ $self->_post( %args );
+}
+
+sub blog { Carp::croak "Unsupported" }
+
+1;
+
+=pod
+
+=head1 NAME
+
+WWW::Tumblr::Blog
+
+=head1 SYNOPSIS
+
+ my $blog = $t->blog('stuff.tumblr.com');
+ # or the domain name:
+ # my $blog = $t->blog('myblogontumblrandstuff.com');
+
+ # as per http://www.tumblr.com/docs/en/api/v2#blog-info
+ my $info = $blog->info;
+
+ # as per http://www.tumblr.com/docs/en/api/v2#blog-likes
+ my $likes = $blog->likes;
+ my $likes = $blog->likes(
+ limit => 5,
+ offset => 10,
+ );
+
+ # as per http://www.tumblr.com/docs/en/api/v2#photo-posts
+ my $posts = $blog->posts(
+ type => 'photo',
+ ... # etc
+ );
+
+ # Posting to the blog:
+
+ # using the source param:
+ my $post = $blog->post(
+ type => 'photo',
+ source => 'http://someserver.com/photo.jpg',
+ );
+
+ # using local files with the data param
+ # which needs to be an array reference
+ my $post = $blog->post(
+ type => 'photo',
+ data => [ '/home/david/larry.jpg' ],
+ );
+
+ # you can post multiple files, as per the Tumblr API:
+ my $post = $blog->post(
+ type => 'photo',
+ data => [ '/file1.jpg', 'file2.jpg', ... ],
+ );
+
+ # if the result was false (empty list), then do something with the
+ # error:
+ do_something_with_the_error( $tumblr->error ) unless $post;
+ # or $likes
+ # or $info
+ # or anything else
+
+=head1 CAVEATS
+
+I never really tried posting audios or videos.
+
+=head1 BUGS
+
+Please refer to L<WWW::Tumblr>.
+
+=head1 AUTHOR(S)
+
+The same folks as L<WWW::Tumblr>.
+
+=head1 SEE ALSO
+
+L<WWW::Tumblr>, L<WWW::Tumblr::ResponseError>.
+
+=head1 COPYRIGHT and LICENSE
+
+Same as L<WWW::Tumblr>.
+
+=cut
+
@@ -0,0 +1,102 @@
+package WWW::Tumblr::ResponseError;
+
+use Moose;
+use Data::Dumper;
+use JSON 'decode_json';
+
+has 'response', is => 'rw', isa => 'HTTP::Response';
+
+sub code { $_[0]->response->code }
+sub reasons {
+ my $self = $_[0];
+ my $j = decode_json( $_[0]->response->decoded_content);
+ if ( ref $j && ref $j eq 'HASH' ) {
+ if ( ref $j->{response} && ref $j->{response} eq 'ARRAY' ) {
+ unless ( scalar @{ $j->{response} }) {
+ return [ $self->response->message ]
+ }
+ return $j->{response};
+ } elsif ( ref $j->{response} && ref $j->{response} eq 'HASH' &&
+ defined $j->{response}->{errors}
+ ) {
+ if ( ref $j->{response}->{errors} eq 'HASH' &&
+ defined $j->{response}->{errors}->{state} ) {
+ return [
+ $j->{response}->{errors}->{0},
+ $j->{response}->{errors}->{state}
+ ];
+ } elsif ( ref $j->{response}->{errors} eq 'ARRAY' ) {
+ return $j->{response}->{errors};
+ } else {
+ Carp::croak "Unimplemented";
+ }
+ } else {
+ Carp::croak "Unimplemented";
+ }
+ } else {
+ Carp::croak "Unimplemented";
+ }
+}
+
+1;
+
+=pod
+
+=head1 NAME
+
+WWW::Tumblr::ResponseError
+
+=head1 SYNOPSIS
+
+ my $posts = $tumblr->blog('stupidshit.tumblr.com')->posts;
+
+ die "Couldn't get posts! " . Dumper( $tumblr->error->reasons ) unless $posts;
+
+=head1 DESCRIPTION
+
+This a class representing L<WWW::Tumblr>'s C<error> method. It contains the
+response from upstream Tumblr API.
+
+=head1 METHODS
+
+=head2 error
+
+Callable from a model context, usually L<WWW::Tumblr>.
+
+ print Dumper $tumblr->error unless $post;
+
+=head2 code
+
+HTTP response code for the error:
+
+ my $info = $blog->info;
+ print $blog->error->code . ' nono :(' unless $info;
+
+=head2 reasons
+
+Commodity method to display reasons why the error ocurred. It returns an array
+reference:
+
+ unless ( $some_tumblr_action ) {
+ print "Errors! \n";
+ print $_, "\n" for @{ $tumblr->error->reasons || [] };
+ }
+
+=head1 BUGS
+
+Please refer to L<WWW::Tumblr>.
+
+=head1 AUTHOR(S)
+
+The same folks as L<WWW::Tumblr>.
+
+=head1 SEE ALSO
+
+L<WWW::Tumblr>, L<WWW::Tumblr::ResponseError>.
+
+=head1 COPYRIGHT and LICENSE
+
+Same as L<WWW::Tumblr>.
+
+=cut
+
@@ -0,0 +1,37 @@
+package WWW::Tumblr::Tagged;
+
+1;
+
+=pod
+
+=head1 NAME
+
+WWW::Tumblr::Tagged
+
+=head1 SYNOPSIS
+
+ # this module doesn't really exist - to use tagged methods
+ # you can do something like:
+
+ my $tagged = $tumblr->tagged( tag => 'perl' );
+
+ # and that's it. There's nothing really inside WWW::Tumblr::Tagged
+
+=head1 BUGS
+
+Please refer to L<WWW::Tumblr>.
+
+=head1 AUTHOR(S)
+
+The same folks as L<WWW::Tumblr>.
+
+=head1 SEE ALSO
+
+L<WWW::Tumblr>, L<WWW::Tumblr::ResponseError>.
+
+=head1 COPYRIGHT and LICENSE
+
+Same as L<WWW::Tumblr>.
+
+=cut
+
@@ -0,0 +1,21 @@
+package WWW::Tumblr::Test;
+
+use strict;
+use warnings;
+
+use WWW::Tumblr;
+
+my $t = WWW::Tumblr->new(
+ # These are "public" keys for my small perlapi blog test.
+ # Don't be a jerk :)
+ consumer_key => 'm2TqZPKBN87VXTf0HZCDbLBmV8IKhjDnSh5SL2MrWYPrvDKIKE',
+ secret_key => 'DfNf21jsNPkDfz5rRW4tUPQf0gR1G8mYtxqBDM62XQSGHNJRY9',
+ token => '5koNK32cgylbsxs9LsTDCWFUrPccYjFCqFIbZayCFLrVlm1zuP',
+ token_secret => 'VbFLz3lZ3P2ghw5b4dHwNNw4IAq13uHgDp4reZy4N24b4VlfM8',
+);
+
+sub tumblr { $t }
+sub user { $t->user }
+sub blog { $t->blog('perlapi.tumblr.com') }
+
+1;
@@ -0,0 +1,54 @@
+package WWW::Tumblr::User;
+
+use Moose;
+use strict;
+use warnings;
+
+use WWW::Tumblr::API;
+
+extends 'WWW::Tumblr';
+
+tumblr_api_method $_, [ 'GET', 'oauth' ] for qw( info dashboard likes following );
+tumblr_api_method $_, [ 'POST', 'oauth' ] for qw( follow unfollow like unlike );
+
+sub user { Carp::croak "Unimplemented" }
+
+
+1;
+
+=pod
+
+=head1 NAME
+
+WWW::Tumblr::User
+
+=head1 SYNOPSIS
+
+ my $user = $tumblr->user;
+
+ # as per http://www.tumblr.com/docs/en/api/v2#user-methods
+ my $dashboard = $user->dashboard;
+ my $likes = $user->likes(
+ limit => 1,
+ );
+
+ die "booyah!" unless $dashboard or $likes;
+
+=head1 BUGS
+
+Please refer to L<WWW::Tumblr>.
+
+=head1 AUTHOR(S)
+
+The same folks as L<WWW::Tumblr>.
+
+=head1 SEE ALSO
+
+L<WWW::Tumblr>, L<WWW::Tumblr::ResponseError>.
+
+=head1 COPYRIGHT and LICENSE
+
+Same as L<WWW::Tumblr>.
+
+=cut
+
@@ -1,517 +1,355 @@
-#!/usr/bin/perl
-
-=head1 NAME
-
-WWW::Tumblr - Perl interface for the Tumblr API
-
-=head1 SYNOPSIS
-
- use WWW::Tumblr;
-
- # read method
- my $t = WWW::Tumblr->new;
-
- # Will read http://juanito.tumblr.com/api/read
- $t->user('juanito');
-
- # Will read http://log.damog.net/api/read
- $t->url('http://log.damog.net');
-
- # Pass Tumblr API read arguments to the read() method
- $t->read(
- start => 2,
- num => 10,
- ...
- );
-
- # Will get you JSON back
- # Same arguments as read, as defined by the API
- $t->read_json(
- ...
- );
-
- # write
- # Object initialization
- my $t = WWW::Tumblr->new;
-
- # The email you use to log in to Tumblr
- $t->email('pepito@chistes.com');
- $t->password('foobar');
-
- # You will always have to pass a type to write() and the additional
- # args depend on that type and the requests by the Tumblr API
- $t->write(
- type => 'regular',
- body => 'My body text',
- ...
-
- type => 'quote',
- quote => 'I once had a girlfriend...',
- ...
-
- type => 'conversation',
- title => 'On the subway...',
- conversation => 'Meh, meh, meh.',
- ...
-
- # File uploads:
- type => 'audio',
- data => '/tmp/my.mp3',
- ...
- );
-
- # other actions
- $t->authenticate or die $t->errstr;
- $t->check_audio or die $t->errstr;
-
- my $vimeo = $t->check_vimeo or die $t->errstr;
-
-All options passed to C<read>, C<read_json> and C<write> are all of the parameters
-specified on L<http://www.tumblr.com/api> and you simple have to pass them as key =>
-values argument pairs.
-
-The Tumblr API is not really long or difficult and this implementation covers it fully.
-
-=head1 METHODS
-
-=cut
-
package WWW::Tumblr;
use strict;
use warnings;
-use Carp;
-use Data::Dumper;
-use LWP::UserAgent;
-use HTTP::Request::Common;
-
-our $VERSION = '4.1';
+our $VERSION = '5.00';
-=head2 new
+=pod
- new(
- user => $user,
- email => $email,
- password => $password,
- url => $url,
- );
+=head1 NAME
-Initilizes a class instance.
+WWW::Tumblr - Perl bindings for the Tumblr API
-All arguments are optional, you can specify most of them here on each of the method
-calls anyway.
+=head1 VERSION
-=cut
+5.00
-sub new {
- my($class, %opts) = @_;
-
- my $ua = LWP::UserAgent->new;
-
- return bless {
- user => $opts{user},
- email => $opts{email},
- password => $opts{password},
- url => $opts{url},
- ua => $ua,
- }, $class;
-}
+=head1 SYNOPSIS
-=head2 email
+ my $t = WWW::Tumblr->new(
+ consumer_key => $consumer_key,
+ secret_key => $secret_key,
+ token => $token,
+ token_secret => $token_secret,
+ );
+
+ my $blog = $t->blog('perlapi.tumblr.com');
- email(
- $email
- );
+ print Dumper $blog->info;
-If C<$email> is specified, it sets the email class variable, otherwise, the
-previous value is returned. This is the email that users use to log in to
-Tumblr.
+=head1 DESCRIPTION
-=cut
+This module makes use of some sort of the same models as the upstream API,
+meaning that you will have User, Blog and Tagged methods:
-sub email {
- my($self, $email) = @_;
- $self->{email} = $email if $email;
- $self->{email};
-}
+ my $t = WWW::Tumblr->new(
+ consumer_key => $consumer_key,
+ secret_key => $secret_key,
+ token => $token,
+ token_secret => $token_secret,
+ );
-=head2 password
+ # Once you have a WWW::Tumblr object, you can get a WWW::Tumblr::Blog object
+ # by calling the blog() method from the former object:
+
+ my $blog = $t->blog('perlapi.tumblr.com');
+
+ # And then just use WWW::Tumblr::Blog methods from it:
+ if ( my $post = $blog->post( type => 'text', body => 'Hell yeah, son!' ) ) {
+ say "I have published post id: " . $post->{id};
+ } else {
+ print STDERR Dumper $blog->error;
+ die "I couldn't post it :(";
+ }
- password(
- $password
- );
+You can also work directly with a L<WWW::Tumblr::Blog> class for example:
-If C<$password> is specified, it sets the password class variable, otherwise
-the previous value is returned. This is the password used by users to log in
-to Tumblr.
+ # You will need to set base_hostname:
+ my $blog = WWW::Tumblr::Blog->new(
+ %four_tokens,
+ base_hostname => 'myblogontumblr.com'
+ );
-=cut
+All operation methods on the entire API will return false in case of an
+upstream error and you can check the status with C<error()>:
-sub password {
- my($self, $password) = @_;
- $self->{password} = $password if $password;
- $self->{password};
-}
+ die Dumper $blog->error unless $blog->info();
-=head2 user
+On success, methods will return a hash reference with the JSON representation
+of the upstream response. This behavior has not changed from previous versions
+of this module.
- user(
- $user
- );
+=head1 METHOD PARAMETERS
-If C<$user> is specified, it sets the user class variable, otherwise
-the previous value is returned. This is the user portion of the tumblr.com
-URL (ie. maria.tumblr.com).
+All methods require the same parameters as the upstream API, passed as hash
+where the keys are the request parameters and the values the corresponding
+data.
-=cut
+=head1 DOCUMENTATION
-sub user {
- my($self, $user) = @_;
- $self->{user} = $user if $user;
- $self->{user};
-}
+Please refer to each module for further tips, tricks and slightly more detailed
+documentation:
-=head2 url
+=over
- url(
- $url
- );
+=item *
-If C<$url> is specified, it sets the url class variable. Otherwise,
-the previous value is returned. This is the URL that some people might
-use for their Tumblelogs instead of user.tumblr.com (in my case, L<http://log.damog.net>).
+L<WWW::Tumblr::Blog>
-=cut
+=item *
-sub url {
- my($self, $url) = @_;
-
- if($url) {
- $self->{url} = $url;
- $self->{url} =~ s/\/\z//;
- } else {
- $self->{url} = 'http://' . $self->user . '.tumblr.com'
- if $self->user;
- }
-
- return $self->{url};
-}
+L<WWW::Tumblr::User>
-=head2 read_json
+=item *
- read_json(
- # read params
- ...
- );
+L<WWW::Tumblr::Tagged>
-Returns the JSON version of c<read>, it accepts the same Tumblr API
-arguments. It returns the JSON version of C<read>.
+=item *
-=cut
+L<WWW::Tumblr::ResponseError>
-sub read_json {
- my($self, %opts) = @_;
- $opts{json} = 1;
- return $self->read(%opts);
-}
+=back
-=head2 read
+Take also a look at the C<t/> directory inside the distribution. There you can see
+how you can do a bunch of things: get posts, submissions, post quotes, text,
+etc, etc.
- read(
- # read args
- ...
- );
+=head1 AUTHORIZATION
-You should have specified the user or url to use this method. Parameters
-to be passed are the ones specified on the Tumblr API, such as id, num,
-type, etc. It returns an XML string containing the output.
+It is possible to generate authorization URLs and do the whole OAuth dance. Please
+refer to the C<examples/> directory within the distribution to learn more.
-If the option C<auth => 1> is passed, an authenticated read request
-is being made in order to retrieve the private posts as well. See
-Tumblr's API for details.
+=head1 CAVEATS
-=cut
+This is considered an experimental version of the module. The request engine
+needs a complete rewrite, as well as proper documentation. The main author of the
+module wanted to release it like this to have people interested on Tumblr and Perl
+give it a spin.
-sub read {
- my($self, %opts) = @_;
-
- my $auth;
- if($opts{auth}) {
- croak "No email or password defined"
- if not $self->email or not $self->password;
- $auth = 1;
- delete $opts{auth};
- }
+=head1 BUGS
- croak "No user or url defined" unless $self->user or $self->url;
-
- my $url = $self->url . '/api/read';
-
- $url .= '/json' if defined $opts{json};
- $url .= '?'.join'&',map{qq{$_=$opts{$_}}} sort keys %opts;
-
- if($auth) {
- $opts{email} = $self->email;
- $opts{password} = $self->password;
- my $req = HTTP::Request->new(POST => $url);
- $req->content_type('application/x-www-form-urlencoded');
- $req->content(join '&', map{ qq{$_=$opts{$_}} } sort keys %opts);
- my $res = $self->{ua}->request($req);
- if($res->is_success) {
- return $res->decoded_content;
- } else {
- $self->errstr($res->as_string);
- return;
- }
- } else {
- return $self->{ua}->get($url)->content;
- }
-}
+Please report as many as you want/can. File them up at GitHub:
+L<https://github.com/damog/www-tumblr/issues/new>. Please don't use the CPAN RT.
-=head2 write
-
- write(
- type => $type,
- ...
- # other write args
- );
-
-Posts a C<type> item with the needed arguments from the Tumblr API.
-The C<type> argument is mandatory. C<email> and C<password> should have
-been specified before too. In success, it returns true, otherwise, it
-returns undef. For file uploads, just specify the filename on the C<data>
-argument.
-
-=cut
-
-sub write {
- my($self, %opts) = @_;
-
- croak "No email was defined" unless $self->email;
- croak "No password was defined" unless $self->password;
- croak "No type defined for writing" unless $opts{type};
-
- $opts{'email'} = $self->email;
- $opts{'password'} = $self->password;
-
- my $req;
- my $res;
-
- # If there's a file to upload or not
- if($opts{data}) {
- $opts{data} = [$opts{data}]; # whack!
-
- $res = $self->{ua}->request(POST 'http://www.tumblr.com/api/write', Content_Type => 'form-data', Content => \%opts);
-
- } else {
- $req = HTTP::Request->new(POST => 'http://www.tumblr.com/api/write');
- $req->content_type('application/x-www-form-urlencoded');
- $req->content(join '&', map{ qq{$_=$opts{$_}} } sort keys %opts);
- $res = $self->{ua}->request($req);
- }
-
- if($res->is_success) {
- return $res->decoded_content;
- } else {
- $self->errstr($res->as_string);
- return;
- }
-
-}
+=head1 MODULE AND TUMBLR API VERSION NOTE
-=head2 edit
+This module supports Tumblr API v2, starting from module version 5. Since the
+previous API was deprecated upstream anyway, there's no backwards compatibility
+with < 5 versions.
- edit(
- 'post-id' => 123,
- type => 'regular',
- title => 'This has changed!',
- ...
- );
+=head1 AUTHOR(S)
-Edits the post idenfied with C<post-id>. The same parameters as those used
-with C<write> can be used, but C<post-id> has to be specified.
+L<David Moreno|http://damog.net/> is the main author and maintainer of this module.
+The following amazing people have also contributed from version 5 onwards: Artem
+Krivopolenov, Squeeks, Fernando Vezzosi.
-=cut
-
-=head2 delete
-
- delete(
- 'post-id' => 123,
- );
+=head1 SEE ALSO
-Deletes the post idenfied with the C<post-id> id.
+=over
-=cut
+=item *
-sub delete {
- my($self, %opts) = @_;
+L<Net::OAuth> because, you know, we're based off it.
- $opts{email} = $self->email;
- $opts{password} = $self->password;
+=item *
- croak "No email was defined" unless $self->email;
- croak "No password was defined" unless $self->password;
+L<Moose>, likewise.
- my $req = HTTP::Request->new(POST => 'http://www.tumblr.com/api/delete');
- $req->content_type('application/x-www-form-urlencoded');
- $req->content(join '&', map { qq{$_=$opts{$_}} } sort keys %opts);
- my $res = $self->{ua}->request($req);
-
- if($res->is_success) {
- return $res->decoded_content;
- } else {
- $self->errstr($res->as_string);
- return;
- }
-}
+=back
-=head2 check_audio
+=head1 COPYRIGHT and LICENSE
- check_audio();
+This software is copyright (c) 2013 by David Moreno.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
-This method has been deprecated on this implementation since it was
-also on the Tumblr API.
+=head1 DISCLAIMER
-Checks if the user can upload an audio file. Returns true or undef.
+The author is in no way affiliated to Tumblr or Yahoo! Inc. If either of them
+want to show their appreciation for this work, they can contact the author directly
+or donate a few of those billion dollars Yahoo! paid for Tumblr, to the Perl
+Foundation at L<http://donate.perlfoundation.org/>.
=cut
-sub check_audio {
- my($self) = shift;
-
- croak "No email was defined" unless $self->email;
- croak "No password was defined" unless $self->password;
-
- $self->_POST_request(
- qq{action=check-audio&email=${\$self->email}&password=${\$self->password}}
- ) or return;
-}
-
-=head2 check_vimeo
+use Moose;
+use Carp;
+use Data::Dumper;
+use HTTP::Request::Common;
+use Net::OAuth::Client;
+use WWW::Tumblr::API;
+use WWW::Tumblr::Blog;
+use WWW::Tumblr::User;
+use WWW::Tumblr::Authentication;
+use LWP::UserAgent;
- check_vimeo();
+has 'consumer_key', is => 'rw', isa => 'Str';
+has 'secret_key', is => 'rw', isa => 'Str';
+has 'token', is => 'rw', isa => 'Str';
+has 'token_secret', is => 'rw', isa => 'Str';
+
+has 'callback', is => 'rw', isa => 'Str';
+has 'error', is => 'rw', isa => 'WWW::Tumblr::ResponseError';
+has 'ua', is => 'rw', isa => 'LWP::UserAgent', default => sub { LWP::UserAgent->new };
+
+has 'session_store', is => 'rw', isa => 'HashRef', default => sub { {} };
+
+has 'oauth', is => 'rw', isa => 'Net::OAuth::Client', default => sub {
+ my $self = shift;
+ Net::OAuth::Client->new(
+ $self->consumer_key,
+ $self->secret_key,
+ request_token_path => 'http://www.tumblr.com/oauth/request_token',
+ authorize_path => 'http://www.tumblr.com/oauth/authorize',
+ access_token_path => 'http://www.tumblr.com/oauth/access_token',
+ callback => $self->callback,
+ session => sub { if (@_ > 1) { $self->_session($_[0] => $_[1]) }; return $self->_session($_[0]) },
+ );
+};
-Deprecated as the Tumblr API discontinued it.
+sub user {
+ my ( $self ) = shift;
+ return WWW::Tumblr::User->new({
+ consumer_key => $self->consumer_key,
+ secret_key => $self->secret_key,
+ token => $self->token,
+ token_secret => $self->token_secret,
+ });
+}
-Checks if the user is logged in on Vimeo, as specified by the Tumblr API.
-Returns the maximum number of bytes available for the user to upload in case
-the user is logged in, otherwise it returns undef.
+sub blog {
+ my ( $self ) = shift;
+ my $name = shift or croak "A blog host name is needed.";
+
+ return WWW::Tumblr::Blog->new({
+ consumer_key => $self->consumer_key,
+ secret_key => $self->secret_key,
+ token => $self->token,
+ token_secret => $self->token_secret,
+ base_hostname => $name,
+ });
+}
-=cut
+sub tagged {
+ my $self = shift;
+ my $args = { @_ };
-sub check_vimeo {
- my($self) = shift;
-
- croak "No email was defined" unless $self->email;
- croak "No password was defined" unless $self->password;
-
- $self->_POST_request(
- qq{action=check-vimeo&email=${\$self->email}&password=${\$self->password}}
- ) or return;
-
- return $self->{_response};
+ return $self->_tumblr_api_request({
+ auth => 'apikey',
+ http_method => 'GET',
+ url_path => 'tagged',
+ extra_args => $args,
+ });
}
-=head2 authenticate
+sub oauth_tools {
+ my ( $self ) = shift;
+ return WWW::Tumblr::Authentication::OAuth->new(
+ consumer_key => $self->consumer_key,
+ secret_key => $self->secret_key,
+ callback => $self->callback,
+ );
+}
- authenticate();
+sub _tumblr_api_request {
+ my $self = shift;
+ my $r = shift; #args
-Checks if the C<email> and C<password> specified are correct. If they are,
-it returns true, otherwise, undef.
+ my $method_to_call = '_' . $r->{auth} . '_request';
+ return $self->$method_to_call(
+ $r->{http_method}, $r->{url_path}, $r->{extra_args}
+ );
+}
-=cut
+sub _none_request {
+ my $self = shift;
+ my $method = shift;
+ my $url_path = shift;
+ my $params = shift;
+
+ my $req;
+ if ( $method eq 'GET' ) {
+ print "Requesting... " .'http://api.tumblr.com/v2/' . $url_path, "\n";
+ $req = HTTP::Request->new(
+ $method => 'http://api.tumblr.com/v2/' . $url_path,
+ );
+ } elsif ( $method eq 'POST' ) {
+ Carp::croak "Unimplemented";
+ } else {
+ die "dude, wtf.";
+ }
-sub authenticate {
- my($self) = shift;
-
- croak "No email was defined" unless $self->email;
- croak "No password was defined" unless $self->password;
+ my $res = $self->ua->request( $req );
- $self->_POST_request(
- qq{action=authenticate&email=${\$self->email}&password=${\$self->password}}
- ) or return;
+ if ( my $prev = $res->previous ) {
+ return $prev;
+ } else { return $res };
}
-=head2 errstr
-
- errstr();
-
-It returns the error string for the last operation, so you can see why
-other methods failed.
+sub _apikey_request {
+ my $self = shift;
+ my $method = shift;
+ my $url_path = shift;
+ my $params = shift;
+
+ my $req; # request object
+ if ( $method eq 'GET' ) {
+ $req = HTTP::Request->new(
+ $method => 'http://api.tumblr.com/v2/' . $url_path . '?api_key='.$self->consumer_key . '&' .
+ ( join '&', map { $_ .'='. $params->{ $_} } keys %$params )
+ );
+ } elsif ( $method eq 'POST' ) {
+ Carp::croak "Unimplemented";
+ } else {
+ die "$method misunderstood";
+ }
-=cut
+ my $res = $self->ua->request( $req );
-sub errstr {
- my($self, $err) = @_;
- $self->{errstr} = $err if $err;
- $self->{errstr};
}
-=head2 _POST_request
-
- _POST_request($string);
-
-Internal method to post C<$string> to Tumblr. You shouldn't be using it anyway.
+sub _oauth_request {
+ my $self = shift;
+ my $method = shift;
+ my $url_path= shift;
+ my $params = shift;
+
+ my $data = delete $params->{data};
+
+ my $request = $self->oauth->_make_request(
+ 'protected resource',
+ request_method => uc $method,
+ request_url => 'http://api.tumblr.com/v2/' . $url_path,
+ consumer_key => $self->consumer_key,
+ consumer_secret => $self->secret_key,
+ token => $self->token,
+ token_secret => $self->token_secret,
+ extra_params => $params,
+ );
+ $request->sign;
+
+ my $authorization_signature = $request->to_authorization_header;
+
+ my $message;
+ if ( $method eq 'GET' ) {
+ $message = GET 'http://api.tumblr.com/v2/' . $url_path . '?' . $request->normalized_message_parameters, 'Authorization' => $authorization_signature;
+ } elsif ( $method eq 'POST' ) {
+ $message = POST('http://api.tumblr.com/v2/' . $url_path,
+ Content_Type => 'form-data',
+ Authorization => $authorization_signature,
+ Content => [
+ %$params, ( $data ? do {
+ my $i = -1;
+ map { $i++; 'data[' . $i .']' => [ $_ ] } @$data
+ } : () )
+ ]);
+ }
-=cut
+ return $self->ua->request( $message );
+}
+sub _session {
+ my $self = shift;
-sub _POST_request {
- my($self, $args) = @_;
-
- croak "No arguments present" unless $args;
-
- my $req = HTTP::Request->new(POST => 'http://www.tumblr.com/api/write');
- $req->content_type('application/x-www-form-urlencoded');
- $req->content($args);
-
- my $res = $self->{ua}->request($req);
-
- if($res->is_success) {
- return $self->{_response} = $res->decoded_content;
- } else {
- $self->{_response} = $res->decoded_content;
- $self->errstr($self->{_response});
- return;
+ if ( ref $_[0] eq 'HASH' ) {
+ $self->session_store($_[0]);
+ } elsif ( @_ > 1 ) {
+ $self->session_store->{$_[0]} = $_[1]
}
-
+ return $_[0] ? $self->session_store->{$_[0]} : $self->session_store;
}
-=head1 SEE ALSO
-
-L<http://tumblr.com>, L<http://tumblr.com/api>. See also the sample scripts on the examples/ dir.
-
-This and other interesting modules and hacks are posted by the author on
-his blog Infinite Pig Theorem, L<http://damog.net>.
-
-=head 1 CODE
-
-The code is actively maintained at L<http://github.com/damog/www-tumblr>.
-
-=head1 AUTHOR
-
-David Moreno Garza, E<lt>david@axiombox.comE<gt>
-
-=head1 THANKS
-
-You know who (L<http://maggit.net>).
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright (C) 2008 by David Moreno Garza - Axiombox
-
-L<http://axiombox.com>
-
-This library is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself, either Perl version 5.8.8 or,
-at your option, any later version of Perl 5 you may have available.
-
-=head1 DISCLAIMER
-
-I'm not a worker nor affiliated to Tumblr in any way, and this is a
-separated implementation of their own public API.
-
-=cut
-
1;
+
@@ -0,0 +1,12 @@
+#!perl -T
+
+use strict;
+use warnings;
+
+use Test::More tests => 1;
+
+BEGIN {
+ use_ok( 'WWW::Tumblr' ) || print "Bail out!\n";
+}
+
+
@@ -0,0 +1,20 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+use_ok('WWW::Tumblr');
+use_ok('WWW::Tumblr::Test');
+
+my $blog = WWW::Tumblr::Test::blog();
+my $info = $blog->info();
+
+ok ref $info eq 'HASH', 'response is a hash reference';
+ok defined $info->{blog}, 'response has a blog response';
+is ref $info->{blog}, 'HASH', 'blog response also a hash';
+
+ok scalar keys %{ $info->{blog} }, 'blog response not empty';
+
+done_testing();
+
+
@@ -0,0 +1,23 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+use_ok('WWW::Tumblr');
+use_ok('WWW::Tumblr::Test');
+
+my $blog = WWW::Tumblr::Test::blog();
+
+for my $size ( '', qw(16 24 30 40 48 64 96 128 512) ) {
+ my %size_opts = ();
+ %size_opts = ( size => $size ) if $size;
+ my $avatar = $blog->avatar( %size_opts );
+ ok $avatar, 'avatar response ok';
+ ok ref $avatar, 'avatar response is a reference';
+ is ref $avatar, 'HASH', 'avatar response reference is a hash';
+ ok defined $avatar->{avatar_url}, 'contains an avatar_url param';
+}
+
+done_testing();
+
+
@@ -0,0 +1,24 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+use_ok('WWW::Tumblr');
+use_ok('WWW::Tumblr::Test');
+
+my $blog = WWW::Tumblr::Test::blog();
+my $info = $blog->info;
+
+if ( $info && $info->{share_likes} ) {
+ my $likes = $blog->likes();
+ ok $likes, 'ok response';
+ ok ref $likes, 'response a reference';
+ is ref $likes, 'HASH', 'reference is a HASH';
+
+ ok defined $likes->{liked_posts}, 'liked_posts present';
+ ok defined $likes->{liked_count}, 'liked_count present';
+}
+
+done_testing();
+
+
@@ -0,0 +1,24 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+use_ok('WWW::Tumblr');
+use_ok('WWW::Tumblr::Test');
+
+my $blog = WWW::Tumblr::Test::blog();
+
+my $followers = $blog->followers;
+
+ok $followers, 'followers is set';
+
+ok ref $followers, 'followers is s reference';
+is ref $followers, 'HASH', 'a HASH reference';
+ok defined $followers->{total_users}, 'total users is there';
+ok defined $followers->{users}, 'users is there';
+ok ref $followers->{users}, 'users is a reference';
+is ref $followers->{users}, 'ARRAY', 'users is an array reference';
+
+done_testing();
+
+
@@ -0,0 +1,26 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+use_ok('WWW::Tumblr');
+use_ok('WWW::Tumblr::Test');
+
+my $blog = WWW::Tumblr::Test::blog();
+
+my $posts = $blog->posts;
+
+ok $posts, 'posts is set';
+
+ok ref $posts, 'posts is s reference';
+is ref $posts, 'HASH', 'a HASH reference';
+
+ok ! $blog->posts( id => 1234567890 ), 'this should be an error';
+ok $blog->posts( type => 'video' ), 'this should be fine';
+ok $blog->posts_queue, 'posts/queue';
+ok $blog->posts_draft, 'posts/draft';
+ok $blog->posts_submission, 'posts/submission';
+
+done_testing();
+
+
@@ -0,0 +1,33 @@
+use strict;
+use warnings;
+
+use Test::More;
+use LWP::Simple 'get';
+use JSON;
+use Data::Dumper;
+
+use_ok('WWW::Tumblr');
+use_ok('WWW::Tumblr::Test');
+
+my %post_types = (
+ text => { body => scalar localtime() },
+ photo => { source => 'http://lorempixel.com/400/200/' },
+ quote => { quote => get 'http://www.iheartquotes.com/api/v1/random' },
+ link => do {
+ my ( $author, $release) = @{ decode_json( get("http://api.metacpan.org/v0/favorite/_search?size=50&fields=author,release&sort=date:desc") )->{hits}->{hits}->[ int rand 50 ]->{fields} }{'author', 'release'};
+ { url => "http://metacpan.org/release/$author/$release" },
+ },
+);
+
+# TODO: chat, audio, video
+
+my $blog = WWW::Tumblr::Test::blog();
+
+for my $type ( sort keys %post_types ) {
+ ok $blog->post( type => $type, %{ $post_types{ $type } } ), "trying $type";
+}
+
+
+done_testing();
+
+
@@ -0,0 +1,23 @@
+use strict;
+use warnings;
+
+use Test::More;
+use File::Spec;
+use File::Basename qw( dirname );
+use Cwd 'abs_path';
+
+use_ok('WWW::Tumblr');
+use_ok('WWW::Tumblr::Test');
+
+my $blog = WWW::Tumblr::Test::blog();
+
+my $post = $blog->post(
+ type => 'photo',
+ data => [ File::Spec->catfile( dirname( abs_path( $0 ) ), 'data', 'larrywall.jpg' ) ],
+);
+
+ok $post, 'data posting';
+
+done_testing();
+
+
@@ -0,0 +1,23 @@
+use strict;
+use warnings;
+
+use Test::More;
+use File::Spec;
+use File::Basename qw( dirname );
+use Cwd 'abs_path';
+
+use_ok('WWW::Tumblr');
+use_ok('WWW::Tumblr::Test');
+
+my $blog = WWW::Tumblr::Test::blog();
+
+my $post = $blog->post(
+ type => 'photo',
+ data => [ glob File::Spec->catfile( dirname( abs_path( $0 ) ), 'data', '*.jpg' ) ],
+);
+
+ok $post, 'data posting';
+
+done_testing();
+
+
@@ -0,0 +1,18 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+use_ok('WWW::Tumblr');
+use_ok('WWW::Tumblr::Test');
+
+my $user = WWW::Tumblr::Test::user();
+
+my $info = $user->info();
+
+ok $info, 'user info is fine';
+ok ref $info eq 'HASH', 'response is a hash reference';
+
+done_testing();
+
+
@@ -0,0 +1,18 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+use_ok('WWW::Tumblr');
+use_ok('WWW::Tumblr::Test');
+
+my $user = WWW::Tumblr::Test::user();
+
+my $dashboard = $user->dashboard();
+
+ok $dashboard, 'user dashboard is fine';
+ok ref $dashboard eq 'HASH', 'response is a hash reference';
+
+done_testing();
+
+
@@ -0,0 +1,18 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+use_ok('WWW::Tumblr');
+use_ok('WWW::Tumblr::Test');
+
+my $user = WWW::Tumblr::Test::user();
+
+my $likes = $user->likes();
+
+ok $likes, 'user likes is fine';
+ok ref $likes eq 'HASH', 'response is a hash reference';
+
+done_testing();
+
+
@@ -0,0 +1,18 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+use_ok('WWW::Tumblr');
+use_ok('WWW::Tumblr::Test');
+
+my $user = WWW::Tumblr::Test::user();
+
+my $following = $user->following();
+
+ok $following, 'user following is fine';
+ok ref $following eq 'HASH', 'response is a hash reference';
+
+done_testing();
+
+
@@ -0,0 +1,17 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+use_ok('WWW::Tumblr');
+use_ok('WWW::Tumblr::Test');
+
+my $user = WWW::Tumblr::Test::user();
+
+my $follow = $user->follow( url => 'whenyouliveinamsterdam.tumblr.com' );
+
+ok $follow, 'user follow is fine';
+
+done_testing();
+
+
@@ -0,0 +1,17 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+use_ok('WWW::Tumblr');
+use_ok('WWW::Tumblr::Test');
+
+my $user = WWW::Tumblr::Test::user();
+
+my $unfollow = $user->unfollow( url => 'whenyouliveinamsterdam.tumblr.com' );
+
+ok $unfollow, 'user unfollow is fine';
+
+done_testing();
+
+
@@ -0,0 +1,17 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+use_ok('WWW::Tumblr');
+use_ok('WWW::Tumblr::Test');
+
+my $t = WWW::Tumblr::Test::tumblr();
+
+my $tagged = $t->tagged( tag => 'perl' );
+
+ok $tagged, 'tagged was ok';
+
+done_testing();
+
+
diff --git a/var/tmp/source/DAMOG/WWW-Tumblr-5.00/WWW-Tumblr-5.00/t/data/larrywall.jpg b/var/tmp/source/DAMOG/WWW-Tumblr-5.00/WWW-Tumblr-5.00/t/data/larrywall.jpg
new file mode 100644
index 00000000..4731843a
Binary files /dev/null and b/var/tmp/source/DAMOG/WWW-Tumblr-5.00/WWW-Tumblr-5.00/t/data/larrywall.jpg differ
diff --git a/var/tmp/source/DAMOG/WWW-Tumblr-5.00/WWW-Tumblr-5.00/t/data/learnperl.jpg b/var/tmp/source/DAMOG/WWW-Tumblr-5.00/WWW-Tumblr-5.00/t/data/learnperl.jpg
new file mode 100644
index 00000000..2ec2279a
Binary files /dev/null and b/var/tmp/source/DAMOG/WWW-Tumblr-5.00/WWW-Tumblr-5.00/t/data/learnperl.jpg differ
