From 3e8bc1837343e34bac7106be458add3982fb77da Mon Sep 17 00:00:00 2001 From: jeff Date: Sat, 14 Oct 2006 21:13:30 +0000 Subject: Initial import --- lib/Net/Plesk.pm | 246 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 246 insertions(+) create mode 100644 lib/Net/Plesk.pm (limited to 'lib/Net/Plesk.pm') diff --git a/lib/Net/Plesk.pm b/lib/Net/Plesk.pm new file mode 100644 index 0000000..2b33c51 --- /dev/null +++ b/lib/Net/Plesk.pm @@ -0,0 +1,246 @@ +package Net::Plesk; + +use 5.005; +use strict; + +use vars qw( $VERSION @ISA $AUTOLOAD $DEBUG $PROTO_VERSION $POST_URL + @EXPORT_OK %EXPORT_TAGS ); # @EXPORT + +use Exporter; +use LWP; +use Data::Dumper; + +use Net::Plesk::Response; +use Net::Plesk::Method; +use Net::Plesk::Method::domain_add; +use Net::Plesk::Method::domain_del; +use Net::Plesk::Method::domain_get; +use Net::Plesk::Method::mail_add; +use Net::Plesk::Method::mail_remove; +use Net::Plesk::Method::mail_set; +use Net::Plesk::Method::client_add; +use Net::Plesk::Method::client_get; +use Net::Plesk::Method::client_ippool_add_ip; + +@ISA = qw(Exporter); + +$VERSION = '0.01'; + +$PROTO_VERSION = '1.4.0.0'; + +$DEBUG = 1; + +my $ua = LWP::UserAgent->new; +$ua->agent("Net::Plesk/$VERSION"); + +=head1 NAME + +Net::Plesk - Perl extension for Plesk XML Remote API + +=head1 SYNOPSIS + + use Net::Plesk; + + my $plesk = new Net::Plesk ( + 'POST' => 'https://plesk.sample.com:8443/enterprise/control/agent.php', + ':HTTP_AUTH_LOGIN' => '1357948', + ':HTTP_AUTH_PASSWD' => 'password', + ); + + # client_get + + my $clientname = 'tofu_beast'; + my $response = $plesk->client_get( $clientname ); + die $response->errortext unless $response->is_success; + my $clientID = $response->id; + + # client_add + + unless $clientID { + my $clientname = 'Tofu Beast'; + my $login = 'tofu_beast'; + my $password = 'manyninjas'; + my $response = $plesk->client_add( $clientname, + $login, + $password, + $phone, + $fax, + $email, + $address, + $city, + $state, + $postcode, + $country, + ); + die $response->errortext unless $response->is_success; + $clientID = $response->id; + print "$clientname created with ID $clientID\n"; + } + + # client_ippool_add_ip + + my $ipaddress = '192.168.8.45'; + my $response = $plesk->client_ippool_add_ip( $clientID, $ipaddress ); + die $response->errortext unless $response->is_success; + + # domain_get + + my $domain = 'basilisk.jp'; + my $response = $plesk->domain_get( $domain ); + die $response->errortext unless $response->is_success; + my $domainID = $response->id; + + # domain_add + + my $domain = 'basilisk.jp'; + my $clientID = 17; + my $ipaddr = '192.168.8.45'; + my $response = $plesk->domain_add( $domain, $clientID, $ipaddr ); + die $response->errortext unless $response->is_success; + my $domainID = $response->id; + + # domain_del + + my $domain = 'basilisk.jp'; + my $response = $plesk->domain_add( $domain ); + die $response->errortext unless $response->is_success; + + # mail_add + + my $username = 'tofu_beast'; + my $response = $plesk->mail_add( $domainID, $username, 'password' ); + die $response->errortext unless $response->is_success; + my $uid = $response->id; + print "$username created: uid $uid\n"; + + # mail_remove + + $response = $plesk->mail_remove( 'username' ); + if ( $response->is_success ) { + print "mailbox removed"; + } else { + print "error removing mailbox: ". $response->errortext; + } + + # mail_set + + my $enabled = ($user_balance <= 0); + $response = $plesk->mail_set( $domainID, 'username', 'password', $enabled ); + die $response->errortext unless $response->is_success; + +=head1 DESCRIPTION + +This module implements a client interface to SWSOFT's Plesk Remote API, +enabling a perl application to talk to a Plesk managed server. +This documentation assumes that you are familiar with the Plesk documentation +available from SWSOFT (API 1.4.0.0 or later). + +A new Net::Plesk object must be created with the I method. Once this has +been done, all Plesk commands are accessed via method calls on the object. + +=head1 METHODS + +=over 4 + +=item new OPTION => VALUE ... + +Creates a new Net::Plesk object. The I, I<:HTTP_AUTH_LOGIN>, and +I<:HTTP_AUTH_PASSWD> options are required. + +=cut + +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = { 'version' => $PROTO_VERSION, + @_, + }; + bless($self, $class); +} + +=item AUTOLOADed methods + +Not all Plesk methods are available. See the Plesk documentation for methods, +arguments and return values. See B for available methods. + +Responses are returned as B objects. See +L. + +=cut + +sub AUTOLOAD { + + my $self = shift; + $AUTOLOAD =~ s/.*:://; + return if $AUTOLOAD eq 'DESTROY'; + + $AUTOLOAD =~ /^([[:alpha:]_]\w*)$/; + die "$AUTOLOAD Illegal method: $1" unless $1; + my $autoload = "Net::Plesk::Method::$1"; + + #inherit? + my $req = HTTP::Request->new('POST' => $self->{'POST'}); + $req->content_type('text/xml'); + + for (keys(%$self)) { + next if $_ eq 'POST'; + $req->header( $_ => $self->{$_} ); + } + + my $packet = $autoload->new(@_); + $req->content( + '' . + '' . + $$packet . + '' + ); + + warn $req->as_string. "\n" + if $DEBUG; + + my $res = $ua->request($req); + + # Check the outcome of the response + if ($res->is_success) { + + warn "\nRESPONSE:\n". $res->content + if $DEBUG; + + my $response = new Net::Plesk::Response $res->content; + + warn Dumper( $response ) + if $DEBUG; + + $response; + } + else { + die $res->status_line, "\n"; + } + +} + +=back + +=head1 BUGS + + Multiple request packets not tested. + +=head1 SEE ALSO + +SWSOFT Plesk Remote API documentation (1.4.0.0 or later) + +=head1 AUTHOR + +Jeff Finucane Ejeff@cmh.netE + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2006 Jeff Finucane + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut + +1; + -- cgit v1.2.1