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