File Coverage

blib/lib/WebService/Dropbox.pm

Criterion	Covered	Total	%
statement	56	170	32.9
branch	3	84	3.5
condition	7	43	16.2
subroutine	19	33	57.5
pod	3	11	27.2
total	88	341	25.8

package WebService::Dropbox;
use strict;
use warnings;
use Carp ();
use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK SEEK_SET SEEK_END);
use JSON;
use URI;
use File::Temp;
use WebService::Dropbox::Auth;
use WebService::Dropbox::Files;
use WebService::Dropbox::Files::CopyReference;
use WebService::Dropbox::Files::ListFolder;
use WebService::Dropbox::Files::UploadSession;
use WebService::Dropbox::Sharing;
use WebService::Dropbox::Users;

our $VERSION = '2.09';

__PACKAGE__->mk_accessors(qw/
    timeout
    key
    secret
    access_token

    error
    req
    res
/);

$WebService::Dropbox::USE_LWP = 0;
$WebService::Dropbox::DEBUG = 0;
$WebService::Dropbox::VERBOSE = 0;

my $JSON = JSON->new->ascii;
my $JSON_PRETTY = JSON->new->pretty->utf8->canonical;

sub import {
    eval {
        require Furl;
        require IO::Socket::SSL;
    };if ($@ || ($Furl::VERSION < 3.08)) {
        __PACKAGE__->use_lwp;
    }
}

sub use_lwp {
    require LWP::UserAgent;
    require HTTP::Request;
    require HTTP::Request::Common;
    $WebService::Dropbox::USE_LWP++;
}

sub debug {
    $WebService::Dropbox::DEBUG = defined $_[0] ? $_[0] : 1;
}

sub verbose {
    $WebService::Dropbox::VERBOSE = defined $_[0] ? $_[0] : 1;
}

sub new {
    my ($class, $args) = @_;

    bless {
        timeout      => $args->{timeout}        || 86400,
        key          => $args->{key}            || '',
        secret       => $args->{secret}         || '',
        access_token => $args->{access_token}   || '',
        env_proxy    => $args->{env_proxy}      || 0,
    }, $class;
}

sub api {
    my ($self, $args) = @_;

    # Content-download endpoints
    if (my $output = delete $args->{output}) {
        if (ref $output eq 'CODE') {
            $args->{write_code} = $output; # code ref
        } elsif (ref $output) {
            $args->{write_file} = $output; # file handle
            binmode $args->{write_file};
        } else {
            open $args->{write_file}, '>', $output; # file path
            Carp::croak("invalid output, output must be code ref or filehandle or filepath.")
                unless $args->{write_file};
            binmode $args->{write_file};
        }
    }

    # Always HTTP POST. https://www.dropbox.com/developers/documentation/http/documentation#formats
    $args->{method}  = 'POST';

    $args->{headers} ||= [];

    if ($self->access_token && $args->{url} ne 'https://notify.dropboxapi.com/2/files/list_folder/longpoll') {
        push @{ $args->{headers} }, 'Authorization', 'Bearer ' . $self->access_token;
    }

    # Set PARAMETERS
    my $params = delete $args->{params};

    # Token
    # * PARAMETERS in to Request Body (application/x-www-form-urlencoded)
    # * RETURNS in to Response Body (application/json)
    if ($args->{url} eq 'https://api.dropboxapi.com/oauth2/token') {
        $args->{content} = $params;
    }

    # RPC endpoints
    # * PARAMETERS in to Request Body (application/json)
    # * RETURNS in to Response Body (application/json)
    elsif ($args->{url} =~ qr{ \A https://(?:api|notify).dropboxapi.com }xms) {
        if ($params) {
            push @{ $args->{headers} }, 'Content-Type', 'application/json';
            $args->{content} = $JSON->encode($params);
        }
    }

    # Content-upload endpoints or Content-download endpoints
    # * PARAMETERS in to Dropbox-API-Arg (JSON Format)
    # * RETURNS in to Dropbox-API-Result (JSON Format)
    elsif ($args->{url} =~ qr{ \A https://content.dropboxapi.com }xms) {
        if ($params) {
            push @{ $args->{headers} }, 'Dropbox-API-Arg', $JSON->encode($params);
        }
        if ($args->{content}) {
            push @{ $args->{headers} }, 'Content-Type', 'application/octet-stream';
        }
    }

    my ($req, $res);
    if ($WebService::Dropbox::USE_LWP) {
        ($req, $res) = $self->api_lwp($args);
    } else {
        ($req, $res) = $self->api_furl($args);
    }

    $self->req($req);
    $self->res($res);

    my $is_success = $self->res->code =~ qr{ \A [23] }xms ? 1 : 0;

    my $decoded_content = $res->decoded_content;

    my $res_data;
    my $res_json = $res->header('Dropbox-Api-Result');
    if (!$res_json && $res->header('Content-Type') =~ qr{ \A (?:application/json|text/javascript) }xms) {
        $res_json = $decoded_content;
    }

    if ($res_json && $res_json ne 'null') {
        $res_data = $JSON->decode($res_json);
    }

    if ($WebService::Dropbox::DEBUG || !$is_success) {
        my $level = $is_success ? 'DEBUG': 'ERROR';
        my $color = $is_success ? "\e[32m" : "\e[31m";
        my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime(time);
        my $time = sprintf("%04d-%02d-%02dT%02d:%02d:%02d", $year + 1900, $mon + 1, $mday, $hour, $min, $sec);
        if ($WebService::Dropbox::VERBOSE) {
            warn sprintf(qq|%s [WebService::Dropbox] [%s] %s
\e[90m%s %s %s
%s
%s\e[0m
${color}%s %s\e[0m
\e[90m%s
%s\e[0m
|,
                $time,
                $level,
                $req->uri,
                $req->method,
                $req->uri,
                $req->protocol || '',
                $req->headers->as_string,
                ( ref $args->{content} ? '' : $args->{content} && $params ? $JSON_PRETTY->encode($params) : '' ),
                $res->protocol,
                $res->status_line,
                $res->headers->as_string,
                ( $res_data ? $JSON_PRETTY->encode($res_data) : $decoded_content . "\n" ),
            );
        } else {
            warn sprintf("%s [WebService::Dropbox] [%s] %s %s -> [%s] %s",
                $time,
                $level,
                $req->uri,
                ( $params ? $JSON->encode($params) : '-' ),
                $res->code,
                ( $res_json || $decoded_content ),
            );
        }
    }

    unless ($is_success) {
        unless ($self->error) {
            $self->error($decoded_content);
        }
        return;
    }

    $self->error(undef);

    return $res_data || +{};
}

sub api_lwp {
    my ($self, $args) = @_;

    my @headers = @{ $args->{headers} || +[] };

    if ($args->{write_file}) {
        $args->{write_code} = sub {
            my $buf = shift;
            $args->{write_file}->print($buf);
        };
    }

    if ($args->{content} && UNIVERSAL::can($args->{content}, 'read')) {
        my $buf;
        my $content = delete $args->{content};
        $args->{content} = sub {
            read($content, $buf, 1024);
            return $buf;
        };
        my $assert = sub {
            $_[0] or Carp::croak(
                "Failed to $_[1] for Content-Length: $!",
            );
        };
        $assert->(defined(my $cur_pos = tell($content)), 'tell');
        $assert->(seek($content, 0, SEEK_END),           'seek');
        $assert->(defined(my $end_pos = tell($content)), 'tell');
        $assert->(seek($content, $cur_pos, SEEK_SET),    'seek');
        my $content_length = $end_pos - $cur_pos;
        push @headers, 'Content-Length' => $content_length;
    }

    my $req;
    if ($args->{content} && ref $args->{content} eq 'HASH') {
        # application/x-www-form-urlencoded
        $req = HTTP::Request::Common::request_type_with_data(
            $args->{method},
            $args->{url},
            @headers,
            Content => $args->{content}
        );
    } else {
        # application/json or application/octet-stream
        # $args->{content} is encodeed json or file handle
        $req = HTTP::Request->new(
            $args->{method},
            $args->{url},
            \@headers,
            $args->{content},
        );
    }

    $req->protocol('HTTP/1.1');

    my $res = $self->ua->request($req, $args->{write_code});
    ($req, $res);
}

sub api_furl {
    my ($self, $args) = @_;

    if (my $write_file = delete $args->{write_file}) {
        $args->{write_code} = sub {
            $write_file->print($_[3]);
        };
    }

    if (my $write_code = delete $args->{write_code}) {
        $args->{write_code} = sub {
            if ($_[0] =~ qr{ \A 2 }xms) {
                $write_code->(@_);
            } else {
                $self->error($_[3]);
            }
        };
    }

    my $res = $self->furl->request(%$args);
    ($res->request, $res);
}

sub ua {
    my $self = shift;
    my $ua = LWP::UserAgent->new;
    $ua->timeout($self->timeout);
    if ($self->{env_proxy}) {
        $ua->env_proxy;
    }
    $ua;
}

sub furl {
    my $self = shift;
    unless ($self->{furl}) {
        $self->{furl} = Furl->new(
            timeout => $self->timeout,
            ssl_opts => {
                SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_PEER(),
            },
        );
        $self->{furl}->env_proxy if $self->{env_proxy};
    }
    $self->{furl};
}

sub mk_accessors {
    my $package = shift;
    no strict 'refs';
    foreach my $field ( @_ ) {
        *{ $package . '::' . $field } = sub {
            return $_[0]->{ $field } if scalar( @_ ) == 1;
            return $_[0]->{ $field }  = scalar( @_ ) == 2 ? $_[1] : [ @_[1..$#_] ];
        };
    }
}

sub env_proxy { $_[0]->{env_proxy} = defined $_[1] ? $_[1] : 1 }

1;
__END__