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