File Coverage

blib/lib/WebService/Linode.pm

Criterion	Covered	Total	%
statement	18	64	28.1
branch	0	22	0.0
condition	0	3	0.0
subroutine	6	9	66.6
pod	1	1	100.0
total	25	99	25.2

package WebService::Linode;

require 5.006000;

use warnings;
use strict;

use Carp;
use List::Util qw(first);
use WebService::Linode::Base;

our $VERSION = '0.27';
our @ISA     = ("WebService::Linode::Base");
our $AUTOLOAD;

# beginvalidation
my $validation = {
    account => {
        estimateinvoice => [ [ 'mode' ], [qw( linodeid paymentterm planid )] ],
        info => [ [], [] ],
        paybalance => [ [], [] ],
        updatecard => [ [qw( ccexpmonth ccexpyear ccnumber )], [] ],
    },
    api => {
        spec => [ [], [] ],
    },
    avail => {
        datacenters => [ [], [] ],
        distributions => [ [], [ 'distributionid' ] ],
        kernels => [ [], [ 'isxen', 'kernelid' ] ],
        linodeplans => [ [], [ 'planid' ] ],
        nodebalancers => [ [], [] ],
        stackscripts => [ [], [qw( distributionid distributionvendor keywords )] ],
    },
    domain => {
        create => [ [ 'domain', 'type' ], [qw( axfr_ips description expire_sec lpm_displaygroup master_ips refresh_sec retry_sec soa_email status ttl_sec )] ],
        delete => [ [ 'domainid' ], [] ],
        list => [ [], [ 'domainid' ] ],
        update => [ [ 'domainid' ], [qw( axfr_ips description domain expire_sec lpm_displaygroup master_ips refresh_sec retry_sec soa_email status ttl_sec type )] ],
    },
    domain_resource => {
        create => [ [ 'domainid', 'type' ], [qw( name port priority protocol target ttl_sec weight )] ],
        delete => [ [ 'domainid', 'resourceid' ], [] ],
        list => [ [ 'domainid' ], [ 'resourceid' ] ],
        update => [ [ 'resourceid' ], [qw( domainid name port priority protocol target ttl_sec weight )] ],
    },
    image => {
        delete => [ [ 'imageid' ], [] ],
        list => [ [], [ 'imageid', 'pending' ] ],
        update => [ [ 'imageid' ], [ 'description', 'label' ] ],
    },
    linode => {
        boot => [ [ 'linodeid' ], [ 'configid' ] ],
        clone => [ [qw( datacenterid linodeid planid )], [ 'paymentterm' ] ],
        create => [ [ 'datacenterid', 'planid' ], [ 'paymentterm' ] ],
        delete => [ [ 'linodeid' ], [ 'skipchecks' ] ],
        list => [ [], [ 'linodeid' ] ],
        mutate => [ [ 'linodeid' ], [] ],
        reboot => [ [ 'linodeid' ], [ 'configid' ] ],
        resize => [ [ 'linodeid', 'planid' ], [] ],
        shutdown => [ [ 'linodeid' ], [] ],
        update => [ [ 'linodeid' ], [qw( alert_bwin_enabled alert_bwin_threshold alert_bwout_enabled alert_bwout_threshold alert_bwquota_enabled alert_bwquota_threshold alert_cpu_enabled alert_cpu_threshold alert_diskio_enabled alert_diskio_threshold backupweeklyday backupwindow label lpm_displaygroup ms_ssh_disabled ms_ssh_ip ms_ssh_port ms_ssh_user watchdog )] ],
        webconsoletoken => [ [ 'linodeid' ], [] ],
    },
    linode_config => {
        create => [ [qw( disklist kernelid label linodeid )], [qw( comments devtmpfs_automount helper_depmod helper_disableupdatedb helper_network helper_xen ramlimit rootdevicecustom rootdevicenum rootdevicero runlevel )] ],
        delete => [ [ 'configid', 'linodeid' ], [] ],
        list => [ [ 'linodeid' ], [ 'configid' ] ],
        update => [ [ 'configid' ], [qw( comments devtmpfs_automount disklist helper_depmod helper_disableupdatedb helper_network helper_xen kernelid label linodeid ramlimit rootdevicecustom rootdevicenum rootdevicero runlevel )] ],
    },
    linode_disk => {
        create => [ [qw( label linodeid size type )], [qw( fromdistributionid isreadonly rootpass rootsshkey )] ],
        createfromdistribution => [ [qw( distributionid label linodeid rootpass size )], [ 'rootsshkey' ] ],
        createfromimage => [ [ 'imageid', 'linodeid' ], [qw( label rootpass rootsshkey size )] ],
        createfromstackscript => [ [qw( distributionid label linodeid rootpass size stackscriptid stackscriptudfresponses )], [ 'rootsshkey' ] ],
        delete => [ [ 'diskid', 'linodeid' ], [] ],
        duplicate => [ [ 'diskid', 'linodeid' ], [] ],
        imagize => [ [ 'diskid', 'linodeid' ], [ 'description', 'label' ] ],
        list => [ [ 'linodeid' ], [ 'diskid' ] ],
        resize => [ [qw( diskid linodeid size )], [] ],
        update => [ [ 'diskid' ], [qw( isreadonly label linodeid )] ],
    },
    linode_ip => {
        addprivate => [ [ 'linodeid' ], [] ],
        addpublic => [ [ 'linodeid' ], [] ],
        list => [ [], [ 'ipaddressid', 'linodeid' ] ],
        setrdns => [ [ 'hostname', 'ipaddressid' ], [] ],
        swap => [ [ 'ipaddressid' ], [ 'tolinodeid', 'withipaddressid' ] ],
    },
    linode_job => {
        list => [ [ 'linodeid' ], [ 'jobid', 'pendingonly' ] ],
    },
    nodebalancer => {
        create => [ [ 'datacenterid' ], [ 'clientconnthrottle', 'label' ] ],
        delete => [ [ 'nodebalancerid' ], [] ],
        list => [ [], [ 'nodebalancerid' ] ],
        update => [ [ 'nodebalancerid' ], [ 'clientconnthrottle', 'label' ] ],
    },
    nodebalancer_config => {
        create => [ [ 'nodebalancerid' ], [qw( algorithm check check_attempts check_body check_interval check_path check_timeout port protocol ssl_cert ssl_key stickiness )] ],
        delete => [ [ 'configid', 'nodebalancerid' ], [] ],
        list => [ [ 'nodebalancerid' ], [ 'configid' ] ],
        update => [ [ 'configid' ], [qw( algorithm check check_attempts check_body check_interval check_path check_timeout port protocol ssl_cert ssl_key stickiness )] ],
    },
    nodebalancer_node => {
        create => [ [qw( address configid label )], [ 'mode', 'weight' ] ],
        delete => [ [ 'nodeid' ], [] ],
        list => [ [ 'configid' ], [ 'nodeid' ] ],
        update => [ [ 'nodeid' ], [qw( address label mode weight )] ],
    },
    stackscript => {
        create => [ [qw( distributionidlist label script )], [qw( description ispublic rev_note )] ],
        delete => [ [ 'stackscriptid' ], [] ],
        list => [ [], [ 'stackscriptid' ] ],
        update => [ [ 'stackscriptid' ], [qw( description distributionidlist ispublic label rev_note script )] ],
    },
    test => {
        echo => [ [], [] ],
    },
    user => {
        getapikey => [ [ 'password', 'username' ], [qw( expires label token )] ],
    },
};
# endvalidation

sub AUTOLOAD {
    ( my $name = $AUTOLOAD ) =~ s/.+:://;
    return if $name eq 'DESTROY';
    if ( $name =~ m/^(QUEUE_)?(.*?)_([^_]+)$/ ) {
        my ( $queue, $thing, $action ) = ( $1, $2, $3 );
        if ( exists $validation->{$thing} && exists $validation->{$thing}{$action} )
        {   no strict 'refs';
            *{$AUTOLOAD} = sub {
                my ( $self, %args ) = @_;
                for my $req ( @{ $validation->{$thing}{$action}[0] } ) {
                    if ( !exists $args{$req} ) {
                        carp
                            "Missing required argument $req for ${thing}_${action}";
                        return;
                    }
                }
                for my $given ( keys %args ) {
                    if (!first { $_ eq $given }
                        @{ $validation->{$thing}{$action}[0] },
                        @{ $validation->{$thing}{$action}[1] } )
                    {   carp "Unknown argument $given for ${thing}_${action}";
                        return;
                    }
                }
                ( my $apiAction = "${thing}_${action}" ) =~ s/_/./g;
                return $self->queue_request( api_action => $apiAction, %args ) if $queue;
                my $data = $self->do_request( api_action => $apiAction, %args );
                return [ map { $self->_lc_keys($_) } @$data ]
                    if ref $data eq 'ARRAY';
                return $self->_lc_keys($data) if ref $data eq 'HASH';
                return $data;
            };
            goto &{$AUTOLOAD};
        }
        else {
            carp "Can't call ${thing}_${action}";
            return;
        }
        return;
    }
    croak "Undefined subroutine \&$AUTOLOAD called";
}

sub send_queued_requests {
    my $self = shift;
    my $items = shift;

    if ( $self->list_queue == 0 ) {
        $self->_error( -1, "No queued items to send" );
        return;
    }

    my @responses;
    for my $data ( $self->process_queue( $items ) ) {
        if ( ref $data eq 'ARRAY' ) {
            push @responses, [ map { $self->_lc_keys($_) } @$data ];
        } elsif( ref $data eq 'HASH' ) {
            push @responses, $self->_lc_keys($data);
        } else {
            push @responses, $data;
        }
    }

    return @responses;
}

'mmm, cake';
__END__