File Coverage

blib/lib/DigitalOcean.pm

Criterion	Covered	Total	%
statement	54	221	24.4
branch	0	26	0.0
condition	0	18	0.0
subroutine	18	54	33.3
pod	20	20	100.0
total	92	339	27.1

use strict;
package DigitalOcean;
use Mouse;

use DigitalOcean::Response;
use DigitalOcean::Droplet;
use DigitalOcean::Meta;
use DigitalOcean::Links;
use DigitalOcean::Collection;
use DigitalOcean::Account;
use DigitalOcean::Action;
use DigitalOcean::Domain;
use DigitalOcean::Droplet::Upgrade;
use DigitalOcean::SSH::Key;

#for requesting
use LWP::UserAgent;
use LWP::Protocol::https;

#for dealing with JSON
use JSON::XS;

#for printing pretty deaths
use Data::Dumper qw//;

#DigitalOcean packages
use DigitalOcean::Error;

#ABSTRACT: An OO interface to the Digital Ocean API (v2).

has oauth_token => (
    is => 'rw',
    isa => 'Str',
    required => 1,
);

has ua => (
    is  => 'ro',
    isa => 'LWP::UserAgent',
    required    => 0,
    default => sub { LWP::UserAgent->new },
);

has api => (
    is => 'ro',
    isa => 'Str',
    default => 'https://api.digitalocean.com/v2/',
    required => 0,
);

has 'time_between_requests' => (
        is => 'rw',
        isa => 'Int',
        default => 2,
        required => 0,
);

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


has ratelimit_limit => (
    is => 'rw',
);


has ratelimit_remaining => (
    is => 'rw',
);


has ratelimit_reset => (
    is => 'rw',
);

#define constants for HTTP request types
use constant {
    GET => 'GET',
    DELETE => 'DELETE',
    PUT => 'PUT',
    POST => 'POST',
    HEAD => 'HEAD',
};


has die_pretty => (
    is => 'rw',
    isa => 'Bool',
    default => 1,
);


has last_response => (
    is => 'rw',
    isa => 'Undef|DigitalOcean::Response',
    default => undef,
);


has per_page => (
    is => 'rw',
    isa =>'Undef|Int',
    default => undef,
);

sub _request {
    my $self = shift;
    my (%args) = @_;
    my ($req_method, $path, $params, $req_body_hash, $type) = ($args{req_method}, $args{path}, $args{params}, $args{req_body_hash}, $args{type});

    #create request
    my $uri = URI->new($self->api . $path);

    #assign per_page if global value is set and one was not passed in
    if(not $params->{per_page} and $self->per_page) {
        $params->{per_page} = $self->per_page;
    }

    $uri->query_form($params);
    print "REQUESTING " . $uri->as_string . "\n";

    my $req = HTTP::Request->new(
        $req_method,
        $uri,
    );

    #add authentication
    $req->header(Authorization => 'Bearer ' . $self->oauth_token);

    my $wait_on_action;

    #set body content
    if($req_body_hash) {
        #get wait on action out if it was passed in
        $wait_on_action = delete $req_body_hash->{wait_on_action};

        #set json header
        $req->header('Content-Type' => 'application/json');

        #put json in body
        my $json_coder = JSON::XS->new->ascii->allow_nonref;
        my $req_body = $json_coder->encode($req_body_hash);
        $req->content($req_body);

        print "REQ BODY $req_body\n";
    }

    my $response = $self->ua->request($req);
    my $json;
    if($response->content) {
        $json = JSON::XS->new->utf8->decode($response->content);

        #TEMPORARY
        my $coder = JSON::XS->new->ascii->pretty->allow_nonref;
        my $pretty_printed_unencoded = $coder->encode ($json);
        print "$pretty_printed_unencoded\n";

        #die with DigitalOcean::Error
        if($response->code < 200 or $response->code >= 300) {
            my $do_error = DigitalOcean::Error->new(
                id => $json->{id},
                message => $json->{message},
                status_code => $response->code,
                status_message => $response->message,
                status_line => $response->status_line,
            );

            die $self->die_pretty ? Data::Dumper->Dump([$do_error, $self]) : $do_error;
        }

    }

    my $do_response = DigitalOcean::Response->new(
        json => $json,
        status_code => $response->code,
        status_message => $response->message,
        status_line => $response->status_line,
    );

    if($json and ref($json) eq 'HASH') {
        #add meta object if one was passed back
        $do_response->meta(DigitalOcean::Meta->new(%{$json->{meta}})) if $json->{meta};

        if($json->{links}) {
            #add links object if one was passed back
            $do_response->links(DigitalOcean::Links->new(%{$json->{links}}));

            #if actions array is present and we are supposed to wait on events, then wait!
            if($json->{links}->{actions} and ($self->wait_on_actions or $wait_on_action)) {
                print "WAITING on ACTION in request\n";

                #wait on each returned action that occurred from the API call
                for my $act_temp (@{$json->{links}->{actions}}) {
                    my $action = $self->action($act_temp->{id});

                    #wait on action
                    $action->wait;
                }
            }
        }
    }

    $self->last_response($do_response);

    #parse ratelimit headers
    $self->ratelimit_limit($response->header('RateLimit-Limit'));
    $self->ratelimit_remaining($response->header('RateLimit-Remaining'));
    $self->ratelimit_reset($response->header('RateLimit-Reset'));

    return $do_response;
}

sub _GET {
    my $self = shift;
    my (%args) = @_;
    $args{req_method} = GET;

    return $self->_request(%args);
}

sub _POST {
    my $self = shift;
    my (%args) = @_;
    $args{req_method} = POST;

    return $self->_request(%args);
}

sub _DELETE {
    my $self = shift;
    my (%args) = @_;
    $args{req_method} = DELETE;

    return $self->_request(%args);
}

sub _PUT {
    my $self = shift;
    my (%args) = @_;
    $args{req_method} = PUT;

    return $self->_request(%args);
}

sub _decode {
    my ($self, $type, $json, $key) = @_;
    my $attrs = $key ? $json->{$key} : $json;
    $attrs->{DigitalOcean} = $self;
    return $type->new($attrs);
}

sub _decode_many {
    my ($self, $type, $arr) = @_;
    [map { $self->_decode($type, $_) } @{$arr}];
}


sub get_user_information {
    my ($self) = @_;

    my $do_response = $self->_GET(path => "account");
    return $self->_decode('DigitalOcean::Account', $do_response->json, 'account');
}

sub _get_collection {
    my ($self, $path, $type_name, $json_key, $params, $init_objects) = @_;

    $init_objects = [] unless $init_objects;

    my $do_response = $self->_GET(path => $path, params => $params);

    return DigitalOcean::Collection->new (
        DigitalOcean => $self,
        type_name => $type_name,
        json_key => $json_key,
        params => $params,
        response => $do_response,
        init_objects => $init_objects,
    );
}

sub _get_object {
    my ($self, $path, $type_name, $json_key) = @_;

    my $do_response = $self->_GET(path => $path);
    return $self->_decode($type_name, $do_response->json, $json_key);
}

sub _get_array {
    my ($self, $path, $type_name, $json_key) = @_;

    my $do_response = $self->_GET(path => $path);

    my $arr;
    if($json_key) {
        $arr = $do_response->json->{$json_key};
    }
    else {
        $arr = $do_response->json;
    }

    return $self->_decode_many($type_name, $arr);
}

sub _put_object {
    my ($self, $path, $type_name, $json_key, $req_body_hash) = @_;

    my $do_response = $self->_PUT(path => $path, req_body_hash => $req_body_hash);
    return $self->_decode($type_name, $do_response->json, $json_key);
}

sub _post_object {
    my ($self, $path, $type_name, $json_key, $req_body_hash) = @_;

    my $do_response = $self->_POST(path => $path, req_body_hash => $req_body_hash);
    return $self->_decode($type_name, $do_response->json, $json_key);
}

sub _create {
    my ($self, $path, $type_name, $json_key, $req_body_hash) = @_;

    my $do_response = $self->_POST(path => $path, req_body_hash => $req_body_hash);
    return $self->_decode($type_name, $do_response->json, $json_key);
}

sub _delete {
    my $self = shift;
    my (%args) = @_;
    my $do_response = $self->_DELETE(%args);

    return $do_response->status_code == 204;
}

sub _action {
    my $self = shift;
    my (%args) = @_;

    #don't delete, because _request might need to wait on event
    my $wait_on_action = $args{req_body_hash}->{wait_on_action};

    my $do_response = $self->_POST(%args);

    my $action = $self->_decode('DigitalOcean::Action', $do_response->json, 'action');

    $action->wait if $wait_on_action or $self->wait_on_actions;

    return $action;
}


sub actions {
    my ($self, $per_page) = @_;
    my $init_arr = [['DigitalOcean', $self]];
    return $self->_get_collection('actions', 'DigitalOcean::Action', 'actions', {per_page => $per_page}, $init_arr);
}


sub action {
    my ($self, $id) = @_;

    return $self->_get_object("actions/$id", 'DigitalOcean::Action', 'action');
}


sub domains {
    my ($self, $per_page) = @_;
    my $init_arr = [['DigitalOcean', $self]];
    return $self->_get_collection('domains', 'DigitalOcean::Domain', 'domains', {per_page => $per_page}, $init_arr);
}


sub create_domain {
    my $self = shift;
    my %args = @_;

    my $domain = $self->_create('domains', 'DigitalOcean::Domain', 'domain', \%args);
    $domain->DigitalOcean($self);

    return $domain;
}


sub domain {
    my ($self, $id) = @_;

    my $domain = $self->_get_object("domains/$id", 'DigitalOcean::Domain', 'domain');
    $domain->DigitalOcean($self);

    return $domain;
}


sub create_droplet {
    my $self = shift;
    my %args = @_;

    my $droplet = $self->_create('droplets', 'DigitalOcean::Droplet', 'droplet', \%args);
    $droplet->DigitalOcean($self);

    return $droplet;
}


sub droplet {
    my ($self, $id) = @_;

    my $droplet = $self->_get_object("droplets/$id", 'DigitalOcean::Droplet', 'droplet');
    $droplet->image->DigitalOcean($self);

    return $droplet;
}


sub droplets {
    my ($self, $per_page) = @_;
    my $init_arr = [['DigitalOcean', $self]];
    return $self->_get_collection('droplets', 'DigitalOcean::Droplet', 'droplets', {per_page => $per_page}, $init_arr);
}


sub droplet_upgrades {
    my ($self) = @_;

    return $self->_get_array('droplet_upgrades', 'DigitalOcean::Droplet::Upgrade');
}

sub _images {
    my ($self, $params) = @_;
    my $init_arr = [['DigitalOcean', $self]];
    return $self->_get_collection('images', 'DigitalOcean::Image', 'images', $params, $init_arr);
}


sub images {
    my ($self, $per_page) = @_;
    return $self->_images({per_page => $per_page});
}


sub distribution_images {
    my ($self, $per_page) = @_;
    return $self->_images({per_page => $per_page, type => 'distribution'});
}


sub application_images {
    my ($self, $per_page) = @_;
    return $self->_images({per_page => $per_page, type => 'application'});
}


sub user_images {
    my ($self, $per_page) = @_;
    return $self->_images({per_page => $per_page, private => 'true'});
}


sub image {
    my ($self, $id_or_slug) = @_;

    my $image = $self->_get_object("images/$id_or_slug", 'DigitalOcean::Image', 'image');

    return $image;
}


sub ssh_keys {
    my ($self, $per_page) = @_;
    my $init_arr = [['DigitalOcean', $self]];
    return $self->_get_collection('account/keys', 'DigitalOcean::SSH::Key', 'ssh_keys', {per_page => $per_page}, $init_arr);
}


sub create_ssh_key {
    my $self = shift;
    my %args = @_;

    my $ssh_key = $self->_create('account/keys', 'DigitalOcean::SSH::Key', 'ssh_key', \%args);
    $ssh_key->DigitalOcean($self);

    return $ssh_key;
}


sub ssh_key {
    my ($self, $id_or_finger) = @_;

    my $ssh_key = $self->_get_object("account/keys/$id_or_finger", 'DigitalOcean::SSH::Key', 'ssh_key');

    return $ssh_key;
}


sub regions {
    my ($self, $per_page) = @_;
    return $self->_get_collection('regions', 'DigitalOcean::Region', 'regions', {per_page => $per_page});
}


sub sizes {
    my ($self, $per_page) = @_;
    return $self->_get_collection('sizes', 'DigitalOcean::Size', 'sizes', {per_page => $per_page});
}

__PACKAGE__->meta->make_immutable();

1;

__END__