view release on metacpan or  search on metacpan

lib/API/Plesk.pm  view on Meta::CPAN

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.03';

# 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']],
    subdomain          => [['1.6.3.0', 'Subdomain']],
    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']],
    user               => [['1.6.3.0', 'User']],

    # 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    => '',
        secret_key  => '',
        url         => '',
        api_version => '1.6.3.1',
        debug       => 0,
        timeout     => 30,
        (@_)
    };

    if (!$self->{secret_key}) {
        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};

    if ($self->{secret_key}) {
        $req->push_header(':KEY',  $self->{secret_key});
    } else {
        $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 defined $self->{debug}  &&  $self->{debug} > 1;

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