File Coverage

blib/lib/API/Plesk.pm

Criterion	Covered	Total	%
statement	78	109	71.5
branch	15	40	37.5
condition	8	24	33.3
subroutine	16	20	80.0
pod	3	7	42.8
total	120	200	60.0

package API::Plesk;

use strict;
use warnings;

use Carp;
use Data::Dumper;

use HTTP::Request;
use LWP::UserAgent;
use XML::Fast;
use version;

use API::Plesk::Response;

our $VERSION = '2.00_3';

# creates accessors to components
# can support old interface of API::Plesk
init_components(
    # new
    customer           => [['1.6.3.0', 'Customer']],
    webspace           => [['1.6.3.0', 'Webspace']],
    site               => [['1.6.3.0', 'Site']],
    site_alias         => [['1.6.3.0', 'SiteAlias']],
    sitebuilder        => [['1.6.3.0', 'SiteBuilder']],
    ftp_user           => [['1.6.3.0', 'FTPUser']],
    service_plan       => [['1.6.3.0', 'ServicePlan']],
    service_plan_addon => [['1.6.3.0', 'ServicePlanAddon']],
    database           => [['1.6.3.0', 'Database']],
    webuser            => [['1.6.3.0', 'WebUser']],
    dns                => [['1.6.3.0', 'DNS']],
    mail               => [['1.6.3.0', 'Mail']],

    # old
    Accounts => [['1.5.0.0', 'Accounts']],
    Domains  => [['1.5.0.0', 'Domains']],
);

# constructor
sub new {
    my $class = shift;
    $class = ref ($class) || $class;

    my $self = {
        username    => '',
        password    => '',
        url         => '',
        api_version => '1.6.3.1',
        debug       => 0,
        timeout     => 30,
        (@_)
    };

    confess "Required username!" unless $self->{username};
    confess "Required password!" unless $self->{password};
    confess "Required url!"      unless $self->{url};

    return bless $self, $class;
}

# sends request to Plesk API
sub send {
    my ( $self, $operator, $operation, $data, %params ) = @_;

    confess "Wrong request data!" unless $data && ref $data;

    my $xml = { $operator => { $operation => $data } };

    $xml = $self->render_xml($xml);

    warn "REQUEST $operator => $operation\n$xml" if $self->{debug};

    my ($response, $error) = $self->xml_http_req($xml);

    warn "RESPONSE $operator => $operation => $error\n$response" if $self->{debug};

    unless ( $error ) {
        $response = xml2hash $response, array => [$operation, 'result', 'property'];
    }

    return API::Plesk::Response->new(
        operator  => $operator,
        operation => $operation,
        response  => $response,
        error     => $error,
    );
}

sub bulk_send { confess "Not implemented!" }

# Send xml request to plesk api
sub xml_http_req {
    my ($self, $xml) = @_;

    # HTTP::Request undestends only bytes
    utf8::encode($xml) if utf8::is_utf8($xml);

    my $ua = new LWP::UserAgent( parse_head => 0 );
    my $req = new HTTP::Request POST => $self->{url};

    $req->push_header(':HTTP_AUTH_LOGIN',  $self->{username});
    $req->push_header(':HTTP_AUTH_PASSWD', $self->{password});
    $req->content_type('text/xml; charset=UTF-8');
    $req->content($xml);

    # LWP6 hack to prevent verification of hostname
    $ua->ssl_opts(verify_hostname => 0) if $ua->can('ssl_opts');

    warn $req->as_string if $self->{debug} > 1;

    my $res = eval {
        local $SIG{ALRM} = sub { die "connection timeout" };
        alarm $self->{timeout};
        $ua->request($req);
    };
    alarm 0;

    warn $res->as_string if $self->{debug} > 1;

    return ('', 'connection timeout')
        if !$res || $@ || ref $res && $res->status_line =~ /connection timeout/;

    return $res->is_success() ?
        ($res->content(), '') :
        ('', $res->status_line);
}


# renders xml packet for request
sub render_xml {
    my ($self, $hash) = @_;

    my $xml = _render_xml($hash);

    $xml = qq|$xml|;

    $xml;
}

# renders xml from hash
sub _render_xml {
    my ( $hash ) = @_;

    return $hash unless ref $hash;

    my $xml = '';

    for my $tag ( keys %$hash ) {
        my $value = $hash->{$tag};
        if ( ref $value eq 'HASH' ) {
            $value = _render_xml($value);
        }
        elsif ( ref $value eq 'ARRAY' ) {
            my $tmp;
            $tmp .= _render_xml($_) for ( @$value );
            $value = $tmp;
        }
        elsif ( ref $value eq 'CODE' ) {
            $value = _render_xml(&$value);
        }

        if ( !defined $value or $value eq '' ) {
            $xml .= "<$tag/>";
        }
        else {
            $xml .= "<$tag>$value";
        }
    }

    $xml;
}


# initialize components
sub init_components {
    my ( %c ) = @_;
    my $caller = caller;

    for my $alias (  keys %c ) {

        my $classes = $c{$alias};

        my $sub = sub {
            my( $self ) = @_;
            $self->{"_$alias"} ||= $self->load_component($classes);
            return $self->{"_$alias"} || confess "Not implemented!";
        };

        no strict 'refs';

        *{"$caller\::$alias"} = $sub;


    }

}

# loads component package and creates object
sub load_component {
    my ( $self, $classes ) = @_;
    my $version = version->parse($self->{api_version});

    for my $item ( @$classes ) {

        # select compitable version of component
        if ( $version >= $item->[0] ) {

            my $pkg = ref($self) . '::' . $item->[1];

            my $module = "$pkg.pm";
               $module =~ s/::/\//g;

            local $@;
            eval { require $module };
            if ( $@ ) {
                confess "Failed to load $pkg: $@";
            }

            return $pkg->new(plesk => $self);

        }

    }

}

1;

__END__