| 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 |  |  |  |  |  |  |  |