view release on metacpan or  search on metacpan

lib/API/Plesk.pm  view on Meta::CPAN

        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/>";