lib/Net/Plesk/Response.pm

   1 package Net::Plesk::Response;
   2
   3 use strict;
   4 use XML::Simple;
   5 use XML::XPath;
   6 use XML::XPath::XMLParser;
   7
   8 =head1 NAME
   9
  10 Net::Plesk::Response - Plesk response object
  11
  12 =head1 SYNOPSIS
  13
  14   my $response = $plesk->some_method( $and, $args );
  15
  16   if ( $response->is_success ) {
  17
  18     my $id  = $response->id;
  19     #...
  20
  21   } else {
  22
  23     my $error = $response->error; #error code
  24     my $errortext = $response->errortext; #error message
  25     #...
  26   }
  27
  28 =head1 DESCRIPTION
  29
  30 The "Net::Plesk::Response" class represents Plesk responses.
  31
  32 =cut
  33
  34 sub new {
  35   my $proto = shift;
  36   my $class = ref($proto) || $proto;
  37   my $self = {};
  38   bless($self, $class);
  39
  40   my $encoding = ''; #default
  41   my $data = shift;
  42   if ($data =~ /^\<\?xml version=\"1.0\"(\s+encoding="([\w\-]*)")?\?\>(.*)$/s){
  43     $encoding = $2; #don't actually do anything with this yet
  44     $data = $3;
  45   }else{
  46     $data =~ s/[^\w\s]/ /g;  # yes, we lose stuff
  47     $data = '<?xml version="1.0"?>' .
  48       '<packet version="' . $self->{'version'} . '">' .
  49       "<system><status>error</status><errcode>500</errcode>" .
  50       "<errtext>Malformed Plesk response:" . $data .  "</errtext>".
  51       "</system></packet>";
  52   }
  53
  54   my $xp = XML::XPath->new(xml => $data);
  55   my $nodeset = $xp->find('//result');
  56   foreach my $node ($nodeset->get_nodelist) {
  57     push @{$self->{'results'}}, XML::XPath::XMLParser::as_string($node);
  58   }
  59   $nodeset = $xp->find('//system');
  60   foreach my $node ($nodeset->get_nodelist) {
  61     my $parsed = XML::XPath::XMLParser::as_string($node);
  62     $parsed =~ s/\<(\/?)system\>/<$1result>/ig;
  63     push @{$self->{'results'}}, $parsed;
  64   }
  65
  66   $self;
  67 }
  68
  69 sub is_success {
  70   my $self = shift;
  71   my $status = 1;
  72   foreach my $result (@{$self->{'results'}}) {
  73     $status = (XMLin($result)->{'status'} eq 'ok');
  74     last unless $status;
  75   }
  76   $status;
  77 }
  78
  79 sub error {
  80   my $self = shift;
  81   my @errcode;
  82   foreach my $result (@{$self->{'results'}}) {
  83     my $errcode = XMLin($result)->{'errcode'};
  84     push @errcode, $errcode if $errcode;
  85   }
  86   return wantarray ? @errcode : $errcode[0];
  87 }
  88
  89 sub errortext {
  90   my $self = shift;
  91   my @errtext;
  92   foreach my $result (@{$self->{'results'}}) {
  93     my $errtext = XMLin($result)->{'errtext'};
  94     push @errtext, $errtext if $errtext;
  95   }
  96   return wantarray ? @errtext : $errtext[0];
  97 }
  98
  99 sub id {
 100   my $self = shift;
 101   my @id;
 102   foreach my $result (@{$self->{'results'}}) {
 103     my $id = XMLin($result)->{'id'};
 104     push @id, $id if $id;
 105   }
 106   return wantarray ? @id : $id[0];
 107 }
 108
 109
 110 =head1 BUGS
 111
 112 Needs better documentation.
 113
 114 =head1 SEE ALSO
 115
 116 L<Net::Plesk>,
 117
 118 =head1 AUTHOR
 119
 120 Jeff Finucane E<lt>jeff@cmh.netE<gt>
 121
 122 =head1 COPYRIGHT AND LICENSE
 123
 124 Copyright (C) 2006 Jeff Finucane
 125
 126 This library is free software; you can redistribute it and/or modify
 127 it under the same terms as Perl itself.
 128
 129 =cut
 130
 131 1;