/lib/Net/Dropbox/API.pm
Perl | 527 lines | 472 code | 52 blank | 3 comment | 16 complexity | f902024af947bbf8199c8ca461181a3c MD5 | raw file
- package Net::Dropbox::API;
- use common::sense;
- use File::Basename qw(basename);
- use JSON;
- use Mouse;
- use Net::OAuth;
- use LWP::UserAgent;
- use URI;
- use HTTP::Request::Common;
- use Data::Random qw(rand_chars);
- use Encode;
- =head1 NAME
- Net::Dropbox::API - A dropbox API interface
- =head1 VERSION
- Version 1.9.8
- =cut
- our $VERSION = '1.9';
- =head1 SYNOPSIS
- The Dropbox API is a OAuth based API. I try to abstract as much away as
- possible so you should not need to know too much about it.
- This is how it works:
- use Net::Dropbox::API;
- my $box = Net::Dropbox::API->new({key => 'KEY', secret => 'SECRET'});
- my $login_link = $box->login; # user needs to click this link and login
- $box->auth; # oauth keys get exchanged
- my $info = $box->account_info; # and here we have our account info
- See the examples for a working Mojolicious web client using the Dropbox
- API.
- You can find Dropbox's API documentation at L<https://www.dropbox.com/developers/web_docs>
- =head1 FUNCTIONS
- =cut
- has 'debug' => (is => 'rw', isa => 'Bool', default => 0);
- has 'error' => (is => 'rw', isa => 'Str', predicate => 'has_error');
- has 'key' => (is => 'rw', isa => 'Str');
- has 'secret' => (is => 'rw', isa => 'Str');
- has 'login_link' => (is => 'rw', isa => 'Str');
- has 'callback_url' => (is => 'rw', isa => 'Str', default => 'http://localhost:3000/callback');
- has 'request_token' => (is => 'rw', isa => 'Str');
- has 'request_secret' => (is => 'rw', isa => 'Str');
- has 'access_token' => (is => 'rw', isa => 'Str');
- has 'access_secret' => (is => 'rw', isa => 'Str');
- has 'context' => (is => 'rw', isa => 'Str', default => 'sandbox');
- =head2 login
- This sets up the initial OAuth handshake and returns the login URL. This
- URL has to be clicked by the user and the user then has to accept
- the application in dropbox.
- Dropbox then redirects back to the callback URL defined with
- C<$self-E<gt>callback_url>. If the user already accepted the application the
- redirect may happen without the user actually clicking anywhere.
- =cut
- sub login {
- my $self = shift;
- my $ua = LWP::UserAgent->new;
- my $request = Net::OAuth->request("request token")->new(
- consumer_key => $self->key,
- consumer_secret => $self->secret,
- request_url => 'https://api.dropbox.com/1/oauth/request_token',
- request_method => 'POST',
- signature_method => 'HMAC-SHA1',
- timestamp => time,
- nonce => $self->nonce,
- callback => $self->callback_url,
- callback_confirmed => ($self->callback_url ? 'true' : undef)
- );
- $request->sign;
- my $res = $ua->request(POST $request->to_url);
- if ($res->is_success) {
- my $response = Net::OAuth->response('request token')->from_post_body($res->content);
- $self->request_token($response->token);
- $self->request_secret($response->token_secret);
- print "Got Request Token ", $response->token, "\n" if $self->debug;
- print "Got Request Token Secret ", $response->token_secret, "\n" if $self->debug;
- return 'https://www.dropbox.com/1/oauth/authorize?oauth_token='.$response->token.'&oauth_callback='.$self->callback_url;
- }
- else {
- $self->error($res->status_line);
- warn "Something went wrong: " . $res->status_line;
- }
- }
- =head2 auth
- The auth method changes the initial request token into access token that we need
- for subsequent access to the API. This method only has to be called once
- after login.
- =cut
- sub auth {
- my $self = shift;
- my $ua = LWP::UserAgent->new;
- my $request = Net::OAuth->request("access token")->new(
- consumer_key => $self->key,
- consumer_secret => $self->secret,
- request_url => 'https://api.dropbox.com/1/oauth/access_token',
- request_method => 'POST',
- signature_method => 'HMAC-SHA1',
- timestamp => time,
- nonce => $self->nonce,
- callback => $self->callback_url,
- token => $self->request_token,
- token_secret => $self->request_secret,
- );
- $request->sign;
- my $res = $ua->request(POST $request->to_url);
- if ($res->is_success) {
- my $response = Net::OAuth->response('access token')->from_post_body($res->content);
- $self->access_token($response->token);
- $self->access_secret($response->token_secret);
- print "Got Access Token ", $response->token, "\n" if $self->debug;
- print "Got Access Token Secret ", $response->token_secret, "\n" if $self->debug;
- }
- else {
- $self->error($res->status_line);
- warn "Something went wrong: ".$res->status_line;
- }
- }
- =head2 account_info
- account_info polls the users info from dropbox.
- =cut
- sub account_info {
- my $self = shift;
- return from_json($self->_talk('account/info'));
- }
- =head2 list
- lists all files in the path defined:
- $data = $box->list(); # top-level
- $data = $box->list( "/Photos" ); # folder
- The data returned is a ref to a hash containing various fields returned
- by Dropbox, including a C<hash> value, which can be used later to check
- if Dropbox data beneath a specified folder has changed since the last call.
- For this, C<list()> accepts an optional 'hash' argument:
- $data = $box->list({ hash => "ce9ccbfb8f255f234c93adcfef33b5a6" },
- "/Photos");
- This will either return
- { http_response_code => 304 }
- in which case nothing has changed since the last call, or
- { http_response_code => 200,
- # ... various other fields
- }
- if there were modifications.
- =cut
- sub list {
- my $self = shift;
- my $opts = {};
- if(defined $_[0] and ref($_[0]) eq "HASH") {
- # optional option hash present
- $opts = shift;
- }
- my $path = shift;
- $path = '' unless defined $path;
- $path = '/'.$path if $path=~m|^[^/]|;
- my $uri = URI->new('files/'.$self->context.$path);
- $uri->query_form($opts) if scalar keys %$opts;
- my $talk_opts = {};
- if(exists $opts->{hash}) {
- $talk_opts = {
- error_handler => sub {
- my $obj = shift;
- my $resp = shift;
- # HTTP::Status is nice but old RHEL5 has issues with it
- # so we use plain codes
- if( $resp->code == 304 ) {
- return to_json({ http_response_code => 304 });
- } else {
- return $self->_talk_default_error_handler($resp);
- }
- },
- };
- }
- return from_json($self->_talk($talk_opts, $uri->as_string));
- }
- =head2 copy
- copies a folder
- copy($from, $to)
- =cut
- sub copy {
- my $self = shift;
- my ($from, $to) = @_;
- my $opts = 'root='.$self->context;
- return from_json($self->_talk('fileops/copy?'.$opts,
- undef, undef, undef, undef, undef,
- { from_path => $from, to_path => $to }));
- }
- =head2 move
- move a folder
- move($from, $to)
- =cut
- sub move {
- my $self = shift;
- my ($from, $to) = @_;
- my $opts = 'root='.$self->context;
- return from_json($self->_talk('fileops/move?'.$opts,
- undef, undef, undef, undef, undef,
- { from_path => $from, to_path => $to }));
- }
- =head2 mkdir
- creates a folder
- mkdir($path)
- =cut
- sub mkdir {
- my $self = shift;
- my ($path) = @_;
- my $opts = 'root='.$self->context;
- return from_json($self->_talk('fileops/create_folder?'.$opts,
- undef, undef, undef, undef, undef,
- { path => $path }));
- }
- =head2 delete
- delete a folder
- delete($path)
- =cut
- sub delete {
- my $self = shift;
- my ($path) = @_;
- my $opts = 'root='.$self->context;
- return from_json($self->_talk('fileops/delete?'.$opts,
- undef, undef, undef, undef, undef,
- { path => $path }));
- }
- =head2 view
- creates a cookie protected link for the user to look at.
- view($path)
- =cut
- sub view {
- my $self = shift;
- my ($path) = @_;
- return from_json($self->_talk('fileops/links/'.$self->context.'/'.$path));
- }
- =head2 metadata
- creates a cookie protected link for the user to look at.
- metadata($path)
- =cut
- sub metadata {
- my $self = shift;
- my $path = shift || '';
- return from_json($self->_talk('metadata/'.$self->context.'/'.$path));
- }
- =head2 putfile
- uploads a file to dropbox
- =cut
- sub putfile {
- my $self = shift;
- my $file = shift;
- my $path = shift || '';
- my $filename = shift || basename( $file );
- return from_json(
- $self->_talk(
- 'files/'.$self->context.'/'.$path,
- 'POST',
- { file => [ $file ] },
- $filename, # can't decode_utf8
- 'api-content',
- undef,
- { file => decode_utf8($filename) }
- )
- );
- }
- =head2 getfile
- get a file from dropbox
- =cut
- =head2 debug
- Set this to a non-false value in order to print some debugging information to STDOUT.
- debug(1)
- =cut
- sub getfile {
- my $self = shift;
- my $path = shift || '';
- my $file = shift || '';
- return $self->_talk('files/'.$self->context.'/'.$path, undef, undef, undef, 'api-content', $file);
- }
- =head1 INTERNAL API
- =head2 _talk
- _talk handles the access to the restricted resources. You should
- normally not need to access this directly.
- =cut
- =head2 nonce
- Generate a different nonce for every request.
- =cut
- sub nonce { join( '', rand_chars( size => 16, set => 'alphanumeric' )); }
- sub _talk {
- my $self = shift;
- my $opts = {};
- if(defined $_[0] and ref($_[0]) eq "HASH") {
- # optional option hash present
- $opts = shift;
- }
- my $command = shift;
- my $method = shift || 'GET';
- my $content = shift;
- my $filename= shift;
- my $api = shift || 'api';
- my $content_file = shift;
- my $extra_params = shift;
- if( !defined $opts->{error_handler} ) {
- $opts->{error_handler} = \&_talk_default_error_handler;
- }
- my $ua = LWP::UserAgent->new;
- my %opts = (
- consumer_key => $self->key,
- consumer_secret => $self->secret,
- request_url => 'https://'.$api.'.dropbox.com/1/'.$command,
- request_method => $method,
- signature_method => 'HMAC-SHA1',
- timestamp => time,
- nonce => $self->nonce,
- #callback => $self->callback_url,
- token => $self->access_token,
- token_secret => $self->access_secret,
- extra_params => $extra_params
- );
- if($filename) {
- push @{$content->{file}},$filename;
- }
- my $request = Net::OAuth->request("protected resource")->new( %opts );
- $request->sign;
- print "_talk URL: ", $request->to_url, "\n" if $self->debug;
- my $res;
- if($content_file) {
- $res = $ua->get($request->to_url, ':content_file' => $content_file);
- } elsif($method =~ /get/i){
- $res = $ua->get($request->to_url);
- } else {
- $res = $ua->post($request->to_url, Content_Type => 'form-data', Content => $content );
- }
- if ($res->is_success) {
- print "Got Content ", $res->content, "\n" if $self->debug;
- my $data;
- eval {
- $data = from_json($res->content);
- };
- if($@) {
- # this doesn't look like JSON, might be file content
- return $res->content;
- }
- $data->{http_response_code} = $res->code();
- return to_json($data);
- } else {
- $self->error($res->status_line);
- return $opts->{error_handler}->($self, $res);
- }
- return;
- }
- sub _talk_default_error_handler {
- my $self = shift;
- my $res = shift;
- warn "Something went wrong: ".$res->status_line;
- return to_json({error => $res->status_line,
- http_response_code => $res->code});
- }
- =head1 AUTHOR
- Lenz Gschwendtner, C<< <norbu09 at cpan.org> >>
- With Bug fixes from:
- Greg Knauss C<< gknauss at eod.com >>
- Chris Prather C<< chris at prather.org >>
- Shinichiro Aska
- [ktdreyer]
- SureVoIP L<http://www.surevoip.co.uk>
- =head1 BUGS
- Please report any bugs through the web interface at
- L<https://github.com/norbu09/Net--Dropbox/issues>. I will be notified, and then you'll
- automatically be notified of progress on your bug as I make changes.
- =head1 SUPPORT
- You can find documentation for this module with the perldoc command.
- perldoc Net::Dropbox::API
- You can also look for information at:
- =over 4
- =item * AnnoCPAN: Annotated CPAN documentation
- L<http://annocpan.org/dist/Net-Dropbox-API>
- =item * CPAN Ratings
- L<http://cpanratings.perl.org/d/Net-Dropbox-API>
- =item * Search CPAN
- L<http://search.cpan.org/dist/Net-Dropbox-API/>
- =back
- =head1 COPYRIGHT & LICENSE
- Copyright 2010 Lenz Gschwendtner.
- This program is free software; you can redistribute it and/or modify it
- under the terms of either: the GNU General Public License as published
- by the Free Software Foundation; or the Artistic License.
- See http://dev.perl.org/licenses/ for more information.
- =cut
- 1; # End of Net::Dropbox