view release on metacpan or  search on metacpan

lib/CloudApp/REST.pm  view on Meta::CPAN

package CloudApp::REST;

use Moose;
use MooseX::Types::URI qw(Uri);

use LWP::UserAgent;
use HTTP::Request;
use JSON::XS;
use Module::Load;
use Data::Dumper;

=head1 NAME

CloudApp::REST - Perl Interface to the CloudApp REST API

=head1 VERSION

Version 0.02

=cut

our $VERSION = '0.02';

has useragent => (
    is       => 'ro',
    required => 0,
    isa      => 'LWP::UserAgent',
    lazy     => 1,
    default  => sub {
        my $self = shift;
        my $ua   = LWP::UserAgent->new;
        $ua->agent($self->agent_name);
        $ua->proxy('http', $self->proxy) if $self->proxy;
        return $ua;
    },
    clearer => '_reset_useragent',
                 );

has debug => (is => 'rw', required => 0, isa => 'Bool', default => 0);

has agent_name => (is => 'rw', required => 0, isa => 'Str', default => __PACKAGE__ . "/" . $VERSION);
has private_base_url => (is => 'rw', required => 0, isa => Uri, coerce => 1, default => sub { to_Uri('http://my.cl.ly/') });
has public_base_url  => (is => 'rw', required => 0, isa => Uri, coerce => 1, default => sub { to_Uri('http://cl.ly/') });
has fileupload_url   => (is => 'rw', required => 0, isa => Uri, coerce => 1, default => sub { to_Uri('http://f.cl.ly') });

has auth_netloc => (is => 'rw', required => 0, isa => 'Str', default => 'my.cl.ly:80');
has auth_realm  => (is => 'rw', required => 0, isa => 'Str', default => 'Application');

has email => (is => 'rw', required => 0, isa => 'Str');
has username => (is => 'rw', required => 0, isa => 'Str', trigger => sub { shift->email(shift) });
has password => (is => 'rw', required => 0, isa => 'Str');

has proxy => (is => 'rw', required => 0, isa => Uri, coerce => 1);

=head1 SYNOPSIS

This is a Perl Interface to the CloudApp REST API.  You can find more information about
CloudApp at L<http://www.getcloudapp.com/>.

Here's an example on how to retrieve the last 5 items:

  use CloudApp::REST;
  
  my $cl = CloudApp::REST->new;
  
  $cl->email('email@example.com');
  $cl->password('my_supersafe_secret');

lib/CloudApp/REST.pm  view on Meta::CPAN

=over 4

=item I<uri =E<gt> $uri>

The URI that is requested, eg. C<http://my.cl.ly/items?page=1&per_page=5>.

=item I<method =E<gt> $method>

The HTTP method of the request type.  If the parameter C<params> to L</_get_response>
is set, C<method> is ignored and set to C<POST>, otherwise to the value of C<method>.  Defaults
to C<GET> in all other cases.

=item I<params =E<gt> \%params>

If C<params> is set, the keys and values are used as C<POST> parameters with their values,
the HTTP method is set to C<POST>.

If C<params> has a key C<file>, this method tries to upload that file.  However, it is not
checked if the file exists (you need to do this by yourself if you use this method directly).

=item I<noredirect =E<gt> $bool>

If C<noredirect> is set to a true value, this method won't follow any redirects.

=back

I<Some notes:>

=over 4

=item

After each call, the current user agent instance is destroyed.  This is done to
reset the redirect status so that the next request won't contain auth data
unless required.

=item

This method handles all HTTP status codes that are considered as C<successful>
(all C<2xx> codes) and the codes C<302> and C<303>.  If other status codes are returned,
the request is considered an error and the method dies.

=back

=cut

sub _get_response {
    my $self   = shift;
    my $params = shift;

    my $uri    = $params->{uri} || die "No URI given!";
    my $method = $params->{method};
    my %body   = $params->{params} ? %{ $params->{params} } : ();

    $self->useragent->requests_redirectable([]) if $params->{noredirect};

    my $res;
    unless (exists $body{file}) {
        $self->_debug("New request, URI is $uri");
        my $req = HTTP::Request->new;
        $req->header(Accept => 'application/json');
        $req->content_type('application/json');
        $req->uri($uri);

        $req->method('GET');
        if (%body) {
            $self->_debug("Have content, method will be POST");

            my $body_json = encode_json \%body;
            $req->content($body_json);
            $req->method('POST');
        }
        if (defined $method && $method) {
            $self->_debug("Explicit method $method");
            $req->method($method);
        }

        $res = $self->useragent->request($req);
    } else {
        my $file = delete $body{file};
        $res = $self->useragent->post($uri, [%body, file => [$file]], Content_Type => 'form-data');
    }

    $self->_reset_useragent;

    if ($res->is_success) {
        $self->_debug("Request successful: " . $res->code);
        $self->_debug("Content: '" . $res->content . "'");
        if ($res->content !~ /^\s*$/) {
            return decode_json($res->content);
        } else {
            return undef;
        }
    } elsif ($res->code == 303 || $res->code == 302) {
        $self->authenticate;
        my $location = to_Uri($res->header('Location'));
        my %params = map { $_ => $location->query_param($_) } $location->query_param;
        return $self->_get_response({ uri => $res->header('Location'), noredirect => 1 });
    } else {
        die "Request error: " . $res->status_line . Dumper($res);
    }
}

=head2 _debug

Parameters:

=over

=item C<@msgs>

=back

Small debug message handler that C<warn>s C<@msgs> joined with a line break.  Only prints if C<debug> set to C<true>.

=cut

sub _debug {
    my $self = shift;
    warn join("\n", @_) . "\n" if $self->debug;