API-Plesk
view release on metacpan or search on metacpan
lib/API/Plesk.pm view on Meta::CPAN
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.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);
};
alarm 0;
warn $res->as_string if defined $self->{debug} && $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 version="1.0" encoding="UTF-8"?><packet version="$self->{api_version}">$xml</packet>|;
$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</$tag>";
}
}
$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 = 'API::Plesk::' . $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__
=head1 NAME
API::Plesk - OO interface to the Plesk XML API (http://www.parallels.com/en/products/plesk/).
=head1 SYNOPSIS
use API::Plesk;
my $api = API::Plesk->new(
username => 'user', # required
password => 'pass', # required
url => 'https://127.0.0.1:8443/enterprise/control/agent.php', # required
api_version => '1.6.3.1',
debug => 0,
timeout => 30,
);
my $res = $api->customer->get();
if ($res->is_success) {
for ( @{$res->data} ) {
print "login: $_->{login}\n";
}
}
else {
print $res->error;
}
=head1 DESCRIPTION
( run in 2.245 seconds using v1.01-cache-2.11-cpan-56fb94df46f )