File Coverage

blib/lib/WWW/Tumblr/Blog.pm
Criterion Covered Total %
statement 29 41 70.7
branch 8 16 50.0
condition 4 6 66.6
subroutine 6 9 66.6
pod 0 4 0.0
total 47 76 61.8


line stmt bran cond sub pod time code
1             package WWW::Tumblr::Blog;
2 16     16   65 use Moose;
  16         285  
  16         113  
3 16     16   68779 use Data::Dumper;
  16         23  
  16         883  
4 16     16   68 use JSON;
  16         21  
  16         119  
5              
6 16     16   1744 use WWW::Tumblr::API;
  16         22  
  16         94  
7             extends 'WWW::Tumblr';
8              
9             has 'base_hostname', is => 'rw', isa => 'Str', required => 1;
10              
11             tumblr_api_method info => [ 'GET', 'apikey' ];
12             tumblr_api_method avatar => [ 'GET', 'none', undef, 'size' ];
13             tumblr_api_method likes => [ 'GET', 'apikey'];
14             tumblr_api_method followers => [ 'GET', 'oauth' ];
15              
16             tumblr_api_method posts => [ 'GET', 'apikey', undef, 'type' ];
17             tumblr_api_method posts_queue => [ 'GET', 'oauth' ];
18             tumblr_api_method posts_draft => [ 'GET', 'oauth' ];
19             tumblr_api_method posts_submission => [ 'GET', 'oauth' ];
20              
21             tumblr_api_method post_delete => [ 'POST', 'oauth' ];
22              
23             # posting methods!
24              
25             my %post_required_params = (
26             text => 'body',
27             photo => { any => [qw(source data)] },
28             quote => 'quote',
29             link => 'url',
30             chat => 'conversation',
31             audio => { any => [qw(external_url data)] },
32             video => { any => [qw(embed data)] },
33             );
34              
35             sub post {
36 5     5 0 4279 my $self = shift;
37 5         18 my %args = @_;
38              
39 5         21 $self->_post( %args );
40             }
41              
42             sub _post {
43 5     5   8 my $self = shift;
44 5         11 my %args = @_;
45              
46 5         65 my $subr = join('/', split( /_/, [ split '::', [ caller( 1 ) ]->[3] ]->[-1] ) );
47              
48             Carp::croak "no type specified when trying to post"
49 5 50       28 unless $args{ type };
50              
51             # check for required params per type:
52            
53 5 50       21 if ( $post_required_params{ $args{ type } } ) {
54 5         12 my $req = $post_required_params{ $args{ type } };
55 5 100 66     44 if ( ref $req && ref $req eq 'HASH' && defined $req->{any} ) {
      66        
56             Carp::croak "Trying to post type ".$args{type}." without any of: " .
57 0         0 join( ' ', @{ $req->{any} } )
58 3 50       6 if scalar( grep { $args{ $_ } } @{ $req->{any} } ) == 0;
  6         23  
  3         12  
59             } else {
60             Carp::croak "Trying to post type ".$args{type}." without: $req"
61 2 100       196 unless defined $args{ $req };
62             }
63             }
64              
65 4         160 my $response = $self->_tumblr_api_request({
66             auth => 'oauth',
67             http_method => 'POST',
68             url_path => 'blog/' . $self->base_hostname . '/' . $subr,
69             extra_args => \%args,
70             });
71              
72 4 50       4000412 if ( $response->is_success ) {
73 4         74 return decode_json( $response->decoded_content)->{response};
74             } else {
75 0           $self->error( WWW::Tumblr::ResponseError->new(
76             response => $response
77             ));
78             return
79 0           }
80             }
81              
82             sub post_edit {
83 0     0 0   my $self = shift;
84 0           my %args = @_;
85             Carp::croak "no id specified when trying to edit a post!"
86 0 0         unless $args{ id };
87              
88 0           $self->_post( %args );
89             }
90              
91             sub post_reblog {
92 0     0 0   my $self = shift;
93 0           my %args = @_;
94              
95             Carp::croak "no id specified when trying to reblog a post!"
96 0 0         unless $args{ id };
97 0           $self->_post( %args );
98             }
99              
100 0     0 0   sub blog { Carp::croak "Unsupported" }
101              
102             1;
103              
104             =pod
105              
106             =head1 NAME
107              
108             WWW::Tumblr::Blog
109              
110             =head1 SYNOPSIS
111              
112             my $blog = $t->blog('stuff.tumblr.com');
113             # or the domain name:
114             # my $blog = $t->blog('myblogontumblrandstuff.com');
115              
116             # as per http://www.tumblr.com/docs/en/api/v2#blog-info
117             my $info = $blog->info;
118              
119             # as per http://www.tumblr.com/docs/en/api/v2#blog-likes
120             my $likes = $blog->likes;
121             my $likes = $blog->likes(
122             limit => 5,
123             offset => 10,
124             );
125              
126             # as per http://www.tumblr.com/docs/en/api/v2#photo-posts
127             my $posts = $blog->posts(
128             type => 'photo',
129             ... # etc
130             );
131              
132             # Posting to the blog:
133            
134             # using the source param:
135             my $post = $blog->post(
136             type => 'photo',
137             source => 'http://someserver.com/photo.jpg',
138             );
139              
140             # using local files with the data param
141             # which needs to be an array reference
142             my $post = $blog->post(
143             type => 'photo',
144             data => [ '/home/david/larry.jpg' ],
145             );
146              
147             # you can post multiple files, as per the Tumblr API:
148             my $post = $blog->post(
149             type => 'photo',
150             data => [ '/file1.jpg', 'file2.jpg', ... ],
151             );
152              
153             # if the result was false (empty list), then do something with the
154             # error:
155             do_something_with_the_error( $tumblr->error ) unless $post;
156             # or $likes
157             # or $info
158             # or anything else
159              
160             =head1 CAVEATS
161              
162             I never really tried posting audios or videos.
163              
164             =head1 BUGS
165              
166             Please refer to L<WWW::Tumblr>.
167              
168             =head1 AUTHOR(S)
169              
170             The same folks as L<WWW::Tumblr>.
171              
172             =head1 SEE ALSO
173              
174             L<WWW::Tumblr>, L<WWW::Tumblr::ResponseError>.
175              
176             =head1 COPYRIGHT and LICENSE
177              
178             Same as L<WWW::Tumblr>.
179              
180             =cut
181