lib/Net/Plesk.pm

   1 package Net::Plesk;
   2
   3 use 5.005;
   4 use strict;
   5
   6 use vars qw( $VERSION @ISA $AUTOLOAD $DEBUG $PROTO_VERSION $POST_URL
   7              @EXPORT_OK %EXPORT_TAGS ); # @EXPORT
   8
   9 use Exporter;
  10 use LWP;
  11 use Data::Dumper;
  12
  13 use Net::Plesk::Response;
  14 use Net::Plesk::Method;
  15 use Net::Plesk::Method::domain_add;
  16 use Net::Plesk::Method::domain_del;
  17 use Net::Plesk::Method::domain_get;
  18 use Net::Plesk::Method::mail_add;
  19 use Net::Plesk::Method::mail_remove;
  20 use Net::Plesk::Method::mail_set;
  21 use Net::Plesk::Method::client_add;
  22 use Net::Plesk::Method::client_get;
  23 use Net::Plesk::Method::client_ippool_add_ip;
  24
  25 @ISA = qw(Exporter);
  26
  27 $VERSION = '0.02';
  28
  29 $PROTO_VERSION = '1.4.1.0';
  30
  31 $DEBUG = 1;
  32
  33 my $ua = LWP::UserAgent->new;
  34 $ua->agent("Net::Plesk/$VERSION");
  35
  36 =head1 NAME
  37
  38 Net::Plesk - Perl extension for Plesk XML Remote API
  39
  40 =head1 SYNOPSIS
  41
  42   use Net::Plesk;
  43
  44   my $plesk = new Net::Plesk (
  45     'POST'      => 'https://plesk.sample.com:8443/enterprise/control/agent.php',
  46     ':HTTP_AUTH_LOGIN' => '1357948',
  47     ':HTTP_AUTH_PASSWD' => 'password',
  48   );
  49
  50   # client_get
  51
  52   my $clientname = 'tofu_beast';
  53   my $response = $plesk->client_get( $clientname );
  54   die $response->errortext unless $response->is_success;
  55   my $clientID = $response->id;
  56
  57   # client_add
  58
  59   unless $clientID {
  60     my $clientname = 'Tofu Beast';
  61     my $login      = 'tofu_beast';
  62     my $password   = 'manyninjas';
  63     my $response = $plesk->client_add( $clientname,
  64                                        $login,
  65                                        $password,
  66                                        $phone,
  67                                        $fax,
  68                                        $email,
  69                                        $address,
  70                                        $city,
  71                                        $state,
  72                                        $postcode,
  73                                        $country,
  74                                       );
  75     die $response->errortext unless $response->is_success;
  76     $clientID = $response->id;
  77     print "$clientname created with ID $clientID\n";
  78   }
  79
  80   # client_ippool_add_ip
  81
  82   my $ipaddress = '192.168.8.45';
  83   my $response = $plesk->client_ippool_add_ip( $clientID, $ipaddress );
  84   die $response->errortext unless $response->is_success;
  85
  86   # domain_get
  87
  88   my $domain = 'basilisk.jp';
  89   my $response = $plesk->domain_get( $domain );
  90   die $response->errortext unless $response->is_success;
  91   my $domainID = $response->id;
  92
  93   # domain_add
  94
  95   my $domain = 'basilisk.jp';
  96   my $clientID = 17;
  97   my $ipaddr = '192.168.8.45';
  98   my $response = $plesk->domain_add( $domain, $clientID, $ipaddr );
  99   die $response->errortext unless $response->is_success;
 100   my $domainID = $response->id;
 101
 102   # domain_del
 103
 104   my $domain = 'basilisk.jp';
 105   my $response = $plesk->domain_add( $domain );
 106   die $response->errortext unless $response->is_success;
 107
 108   # mail_add
 109
 110   my $username = 'tofu_beast';
 111   my $response = $plesk->mail_add( $domainID, $username, 'password' );
 112   die $response->errortext unless $response->is_success;
 113   my $uid = $response->id;
 114   print "$username created: uid $uid\n";
 115
 116   # mail_remove
 117
 118   $response = $plesk->mail_remove( 'username' );
 119   if ( $response->is_success ) {
 120     print "mailbox removed";
 121   } else {
 122     print "error removing mailbox: ". $response->errortext;
 123   }
 124
 125   # mail_set
 126
 127   my $enabled = ($user_balance <= 0);
 128   $response = $plesk->mail_set( $domainID, 'username', 'password', $enabled );
 129   die $response->errortext unless $response->is_success;
 130
 131 =head1 DESCRIPTION
 132
 133 This module implements a client interface to SWSOFT's Plesk Remote API,
 134 enabling a perl application to talk to a Plesk managed server.
 135 This documentation assumes that you are familiar with the Plesk documentation
 136 available from SWSOFT (API 1.4.0.0 or later).
 137
 138 A new Net::Plesk object must be created with the I<new> method.  Once this has
 139 been done, all Plesk commands are accessed via method calls on the object.
 140
 141 =head1 METHODS
 142
 143 =over 4
 144
 145 =item new OPTION => VALUE ...
 146
 147 Creates a new Net::Plesk object.  The I<URL>, I<:HTTP_AUTH_LOGIN>, and
 148 I<:HTTP_AUTH_PASSWD> options are required.
 149
 150 =cut
 151
 152 sub new {
 153   my $proto = shift;
 154   my $class = ref($proto) || $proto;
 155   my $self = { 'version' => $PROTO_VERSION,
 156                @_,
 157              };
 158   bless($self, $class);
 159 }
 160
 161 =item AUTOLOADed methods
 162
 163 Not all Plesk methods are available.  See the Plesk documentation for methods,
 164 arguments and return values.  See B<Net::Plesk::Method> for available methods.
 165
 166 Responses are returned as B<Net::Plesk::Response> objects.  See
 167 L<Net::Plesk::Response>.
 168
 169 =cut
 170
 171 sub AUTOLOAD {
 172
 173   my $self = shift;
 174   $AUTOLOAD =~ s/.*:://;
 175   return if $AUTOLOAD eq 'DESTROY';
 176
 177   $AUTOLOAD =~ /^([[:alpha:]_]\w*)$/;
 178   die "$AUTOLOAD Illegal method: $1" unless $1;
 179   my $autoload = "Net::Plesk::Method::$1";
 180
 181   #inherit?
 182   my $req = HTTP::Request->new('POST' => $self->{'POST'});
 183   $req->content_type('text/xml');
 184
 185   for (keys(%$self)) {
 186     next if $_ eq 'POST';
 187     $req->header( $_ => $self->{$_} );
 188   }
 189
 190   my $packet = $autoload->new(@_);
 191   $req->content(
 192           '<?xml version="1.0"?>' .
 193           '<packet version="' . $self->{'version'} . '">' .
 194           $$packet .
 195           '</packet>'
 196   );
 197
 198   warn $req->as_string. "\n"
 199     if $DEBUG;
 200
 201   my $res = $ua->request($req);
 202
 203   # Check the outcome of the response
 204   if ($res->is_success) {
 205
 206     warn "\nRESPONSE:\n". $res->content
 207       if $DEBUG;
 208
 209     my $response = new Net::Plesk::Response $res->content;
 210
 211     warn Dumper( $response )
 212       if $DEBUG;
 213
 214     $response;
 215   }
 216   else {
 217     new Net::Plesk::Response (
 218       '<?xml version="1.0" encoding="UTF-8"?>'. #a lie?  probably safe
 219       '<packet version="' . $self->{'version'} . '">' .
 220       "<system><status>error</status><errcode>500</errcode>" .
 221       "<errtext>" . $res->status_line . "</errtext></system>" .
 222       "</packet>"
 223     );
 224   }
 225
 226 }
 227
 228 =back
 229
 230 =head1 BUGS
 231
 232  Multiple request packets not tested.
 233
 234 =head1 SEE ALSO
 235
 236 SWSOFT Plesk Remote API documentation (1.4.0.0 or later)
 237
 238 =head1 AUTHOR
 239
 240 Jeff Finucane E<lt>jeff@cmh.netE<gt>
 241
 242 =head1 COPYRIGHT AND LICENSE
 243
 244 Copyright (C) 2006 Jeff Finucane
 245
 246 This library is free software; you can redistribute it and/or modify
 247 it under the same terms as Perl itself.
 248
 249 =cut
 250
 251 1;
 252