1package Net::Dropbox::API; 2 3use common::sense; 4use File::Basename qw(basename); 5use JSON; 6use Mouse; 7use Net::OAuth; 8use LWP::UserAgent; 9use URI; 10use HTTP::Request::Common; 11use Data::Random qw(rand_chars); 12use Encode; 13 14=head1 NAME 15 16Net::Dropbox::API - A dropbox API interface 17 18=head1 VERSION 19 20Version 1.9.8 21 22=cut 23 24our $VERSION = '1.9'; 25 26 27=head1 SYNOPSIS 28 29The Dropbox API is a OAuth based API. I try to abstract as much away as 30possible so you should not need to know too much about it. 31This is how it works: 32 33 use Net::Dropbox::API; 34 35 my $box = Net::Dropbox::API->new({key => 'KEY', secret => 'SECRET'}); 36 my $login_link = $box->login; # user needs to click this link and login 37 $box->auth; # oauth keys get exchanged 38 my $info = $box->account_info; # and here we have our account info 39 40See the examples for a working Mojolicious web client using the Dropbox 41API. 42 43You can find Dropbox's API documentation at L<https://www.dropbox.com/developers/web_docs> 44 45=head1 FUNCTIONS 46 47=cut 48 49has 'debug' => (is => 'rw', isa => 'Bool', default => 0); 50has 'error' => (is => 'rw', isa => 'Str', predicate => 'has_error'); 51has 'key' => (is => 'rw', isa => 'Str'); 52has 'secret' => (is => 'rw', isa => 'Str'); 53has 'login_link' => (is => 'rw', isa => 'Str'); 54has 'callback_url' => (is => 'rw', isa => 'Str', default => 'http://localhost:3000/callback'); 55has 'request_token' => (is => 'rw', isa => 'Str'); 56has 'request_secret' => (is => 'rw', isa => 'Str'); 57has 'access_token' => (is => 'rw', isa => 'Str'); 58has 'access_secret' => (is => 'rw', isa => 'Str'); 59has 'context' => (is => 'rw', isa => 'Str', default => 'sandbox'); 60 61 62=head2 login 63 64This sets up the initial OAuth handshake and returns the login URL. This 65URL has to be clicked by the user and the user then has to accept 66the application in dropbox. 67 68Dropbox then redirects back to the callback URL defined with 69C<$self-E<gt>callback_url>. If the user already accepted the application the 70redirect may happen without the user actually clicking anywhere. 71 72=cut 73 74sub login { 75 my $self = shift; 76 77 my $ua = LWP::UserAgent->new; 78 79 my $request = Net::OAuth->request("request token")->new( 80 consumer_key => $self->key, 81 consumer_secret => $self->secret, 82 request_url => 'https://api.dropbox.com/1/oauth/request_token', 83 request_method => 'POST', 84 signature_method => 'HMAC-SHA1', 85 timestamp => time, 86 nonce => $self->nonce, 87 callback => $self->callback_url, 88 callback_confirmed => ($self->callback_url ? 'true' : undef) 89 ); 90 91 $request->sign; 92 my $res = $ua->request(POST $request->to_url); 93 94 if ($res->is_success) { 95 my $response = Net::OAuth->response('request token')->from_post_body($res->content); 96 $self->request_token($response->token); 97 $self->request_secret($response->token_secret); 98 print "Got Request Token ", $response->token, "\n" if $self->debug; 99 print "Got Request Token Secret ", $response->token_secret, "\n" if $self->debug; 100 return 'https://www.dropbox.com/1/oauth/authorize?oauth_token='.$response->token.'&oauth_callback='.$self->callback_url; 101 } 102 else { 103 $self->error($res->status_line); 104 warn "Something went wrong: " . $res->status_line; 105 } 106} 107 108=head2 auth 109 110The auth method changes the initial request token into access token that we need 111for subsequent access to the API. This method only has to be called once 112after login. 113 114=cut 115 116sub auth { 117 my $self = shift; 118 119 my $ua = LWP::UserAgent->new; 120 my $request = Net::OAuth->request("access token")->new( 121 consumer_key => $self->key, 122 consumer_secret => $self->secret, 123 request_url => 'https://api.dropbox.com/1/oauth/access_token', 124 request_method => 'POST', 125 signature_method => 'HMAC-SHA1', 126 timestamp => time, 127 nonce => $self->nonce, 128 callback => $self->callback_url, 129 token => $self->request_token, 130 token_secret => $self->request_secret, 131 ); 132 133 $request->sign; 134 my $res = $ua->request(POST $request->to_url); 135 136 if ($res->is_success) { 137 my $response = Net::OAuth->response('access token')->from_post_body($res->content); 138 $self->access_token($response->token); 139 $self->access_secret($response->token_secret); 140 print "Got Access Token ", $response->token, "\n" if $self->debug; 141 print "Got Access Token Secret ", $response->token_secret, "\n" if $self->debug; 142 } 143 else { 144 $self->error($res->status_line); 145 warn "Something went wrong: ".$res->status_line; 146 } 147} 148 149=head2 account_info 150 151account_info polls the users info from dropbox. 152 153=cut 154 155sub account_info { 156 my $self = shift; 157 158 return from_json($self->_talk('account/info')); 159} 160 161=head2 list 162 163lists all files in the path defined: 164 165 $data = $box->list(); # top-level 166 $data = $box->list( "/Photos" ); # folder 167 168The data returned is a ref to a hash containing various fields returned 169by Dropbox, including a C<hash> value, which can be used later to check 170if Dropbox data beneath a specified folder has changed since the last call. 171 172For this, C<list()> accepts an optional 'hash' argument: 173 174 $data = $box->list({ hash => "ce9ccbfb8f255f234c93adcfef33b5a6" }, 175 "/Photos"); 176 177This will either return 178 179 { http_response_code => 304 } 180 181in which case nothing has changed since the last call, or 182 183 { http_response_code => 200, 184 # ... various other fields 185 } 186 187if there were modifications. 188 189=cut 190 191sub list { 192 my $self = shift; 193 my $opts = {}; 194 if(defined $_[0] and ref($_[0]) eq "HASH") { 195 # optional option hash present 196 $opts = shift; 197 } 198 my $path = shift; 199 $path = '' unless defined $path; 200 $path = '/'.$path if $path=~m|^[^/]|; 201 202 my $uri = URI->new('files/'.$self->context.$path); 203 $uri->query_form($opts) if scalar keys %$opts; 204 205 my $talk_opts = {}; 206 207 if(exists $opts->{hash}) { 208 $talk_opts = { 209 error_handler => sub { 210 my $obj = shift; 211 my $resp = shift; 212 # HTTP::Status is nice but old RHEL5 has issues with it 213 # so we use plain codes 214 if( $resp->code == 304 ) { 215 return to_json({ http_response_code => 304 }); 216 } else { 217 return $self->_talk_default_error_handler($resp); 218 } 219 }, 220 }; 221 } 222 223 return from_json($self->_talk($talk_opts, $uri->as_string)); 224} 225 226=head2 copy 227 228copies a folder 229 copy($from, $to) 230 231=cut 232 233sub copy { 234 my $self = shift; 235 my ($from, $to) = @_; 236 237 my $opts = 'root='.$self->context; 238 return from_json($self->_talk('fileops/copy?'.$opts, 239 undef, undef, undef, undef, undef, 240 { from_path => $from, to_path => $to })); 241} 242 243=head2 move 244 245move a folder 246 move($from, $to) 247 248=cut 249 250sub move { 251 my $self = shift; 252 my ($from, $to) = @_; 253 254 my $opts = 'root='.$self->context; 255 return from_json($self->_talk('fileops/move?'.$opts, 256 undef, undef, undef, undef, undef, 257 { from_path => $from, to_path => $to })); 258} 259 260=head2 mkdir 261 262creates a folder 263 mkdir($path) 264 265=cut 266 267sub mkdir { 268 my $self = shift; 269 my ($path) = @_; 270 271 my $opts = 'root='.$self->context; 272 return from_json($self->_talk('fileops/create_folder?'.$opts, 273 undef, undef, undef, undef, undef, 274 { path => $path })); 275} 276 277=head2 delete 278 279delete a folder 280 delete($path) 281 282=cut 283 284sub delete { 285 my $self = shift; 286 my ($path) = @_; 287 288 my $opts = 'root='.$self->context; 289 return from_json($self->_talk('fileops/delete?'.$opts, 290 undef, undef, undef, undef, undef, 291 { path => $path })); 292} 293 294=head2 view 295 296creates a cookie protected link for the user to look at. 297 view($path) 298 299=cut 300 301sub view { 302 my $self = shift; 303 my ($path) = @_; 304 305 return from_json($self->_talk('fileops/links/'.$self->context.'/'.$path)); 306} 307 308=head2 metadata 309 310creates a cookie protected link for the user to look at. 311 metadata($path) 312 313=cut 314 315sub metadata { 316 my $self = shift; 317 my $path = shift || ''; 318 319 return from_json($self->_talk('metadata/'.$self->context.'/'.$path)); 320} 321 322=head2 putfile 323 324uploads a file to dropbox 325 326=cut 327 328sub putfile { 329 my $self = shift; 330 my $file = shift; 331 my $path = shift || ''; 332 my $filename = shift || basename( $file ); 333 334 return from_json( 335 $self->_talk( 336 'files/'.$self->context.'/'.$path, 337 'POST', 338 { file => [ $file ] }, 339 $filename, # can't decode_utf8 340 'api-content', 341 undef, 342 { file => decode_utf8($filename) } 343 ) 344 ); 345 346} 347 348=head2 getfile 349 350get a file from dropbox 351 352=cut 353 354=head2 debug 355 356Set this to a non-false value in order to print some debugging information to STDOUT. 357 debug(1) 358 359=cut 360 361sub getfile { 362 my $self = shift; 363 my $path = shift || ''; 364 my $file = shift || ''; 365 366 return $self->_talk('files/'.$self->context.'/'.$path, undef, undef, undef, 'api-content', $file); 367} 368 369 370=head1 INTERNAL API 371 372=head2 _talk 373 374_talk handles the access to the restricted resources. You should 375normally not need to access this directly. 376 377=cut 378 379=head2 nonce 380 381Generate a different nonce for every request. 382 383=cut 384 385sub nonce { join( '', rand_chars( size => 16, set => 'alphanumeric' )); } 386 387sub _talk { 388 my $self = shift; 389 my $opts = {}; 390 if(defined $_[0] and ref($_[0]) eq "HASH") { 391 # optional option hash present 392 $opts = shift; 393 } 394 my $command = shift; 395 my $method = shift || 'GET'; 396 my $content = shift; 397 my $filename= shift; 398 my $api = shift || 'api'; 399 my $content_file = shift; 400 my $extra_params = shift; 401 402 if( !defined $opts->{error_handler} ) { 403 $opts->{error_handler} = \&_talk_default_error_handler; 404 } 405 406 my $ua = LWP::UserAgent->new; 407 408 my %opts = ( 409 consumer_key => $self->key, 410 consumer_secret => $self->secret, 411 request_url => 'https://'.$api.'.dropbox.com/1/'.$command, 412 request_method => $method, 413 signature_method => 'HMAC-SHA1', 414 timestamp => time, 415 nonce => $self->nonce, 416 #callback => $self->callback_url, 417 token => $self->access_token, 418 token_secret => $self->access_secret, 419 extra_params => $extra_params 420 ); 421 if($filename) { 422 push @{$content->{file}},$filename; 423 } 424 425 my $request = Net::OAuth->request("protected resource")->new( %opts ); 426 427 $request->sign; 428 print "_talk URL: ", $request->to_url, "\n" if $self->debug; 429 430 my $res; 431 if($content_file) { 432 $res = $ua->get($request->to_url, ':content_file' => $content_file); 433 } elsif($method =~ /get/i){ 434 $res = $ua->get($request->to_url); 435 } else { 436 $res = $ua->post($request->to_url, Content_Type => 'form-data', Content => $content ); 437 } 438 439 if ($res->is_success) { 440 print "Got Content ", $res->content, "\n" if $self->debug; 441 my $data; 442 eval { 443 $data = from_json($res->content); 444 }; 445 if($@) { 446 # this doesn't look like JSON, might be file content 447 return $res->content; 448 } 449 $data->{http_response_code} = $res->code(); 450 return to_json($data); 451 } else { 452 $self->error($res->status_line); 453 return $opts->{error_handler}->($self, $res); 454 } 455 return; 456} 457 458sub _talk_default_error_handler { 459 my $self = shift; 460 my $res = shift; 461 462 warn "Something went wrong: ".$res->status_line; 463 return to_json({error => $res->status_line, 464 http_response_code => $res->code}); 465} 466 467=head1 AUTHOR 468 469Lenz Gschwendtner, C<< <norbu09 at cpan.org> >> 470 471With Bug fixes from: 472 473Greg Knauss C<< gknauss at eod.com >> 474 475Chris Prather C<< chris at prather.org >> 476 477Shinichiro Aska 478 479[ktdreyer] 480 481SureVoIP L<http://www.surevoip.co.uk> 482 483=head1 BUGS 484 485Please report any bugs through the web interface at 486L<https://github.com/norbu09/Net--Dropbox/issues>. I will be notified, and then you'll 487automatically be notified of progress on your bug as I make changes. 488 489=head1 SUPPORT 490 491You can find documentation for this module with the perldoc command. 492 493 perldoc Net::Dropbox::API 494 495You can also look for information at: 496 497=over 4 498 499=item * AnnoCPAN: Annotated CPAN documentation 500 501L<http://annocpan.org/dist/Net-Dropbox-API> 502 503=item * CPAN Ratings 504 505L<http://cpanratings.perl.org/d/Net-Dropbox-API> 506 507=item * Search CPAN 508 509L<http://search.cpan.org/dist/Net-Dropbox-API/> 510 511=back 512 513 514=head1 COPYRIGHT & LICENSE 515 516Copyright 2010 Lenz Gschwendtner. 517 518This program is free software; you can redistribute it and/or modify it 519under the terms of either: the GNU General Public License as published 520by the Free Software Foundation; or the Artistic License. 521 522See http://dev.perl.org/licenses/ for more information. 523 524 525=cut 526 5271; # End of Net::Dropbox 528