mirror of
https://github.com/percona/percona-toolkit.git
synced 2025-09-11 13:40:07 +00:00
354 lines
8.2 KiB
Perl
354 lines
8.2 KiB
Perl
# This program is copyright 2012-2013 Percona Inc.
|
|
# Feedback and improvements are welcome.
|
|
#
|
|
# THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
|
|
# WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
|
|
# MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
|
|
#
|
|
# This program is free software; you can redistribute it and/or modify it under
|
|
# the terms of the GNU General Public License as published by the Free Software
|
|
# Foundation, version 2; OR the Perl Artistic License. On UNIX and similar
|
|
# systems, you can issue `man perlgpl' or `man perlartistic' to read these
|
|
# licenses.
|
|
#
|
|
# You should have received a copy of the GNU General Public License along with
|
|
# this program; if not, write to the Free Software Foundation, Inc., 59 Temple
|
|
# Place, Suite 330, Boston, MA 02111-1307 USA.
|
|
# ###########################################################################
|
|
# Percona::WebAPI::Client package
|
|
# ###########################################################################
|
|
{
|
|
package Percona::WebAPI::Client;
|
|
|
|
our $VERSION = '0.01';
|
|
|
|
use strict;
|
|
use warnings FATAL => 'all';
|
|
use English qw(-no_match_vars);
|
|
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
|
|
|
|
use LWP;
|
|
use JSON;
|
|
use Scalar::Util qw(blessed);
|
|
use English qw(-no_match_vars);
|
|
|
|
use Lmo;
|
|
use Percona::Toolkit;
|
|
use Percona::WebAPI::Representation;
|
|
use Percona::WebAPI::Exception::Request;
|
|
|
|
Percona::WebAPI::Representation->import(qw(as_json));
|
|
Percona::Toolkit->import(qw(_d Dumper have_required_args));
|
|
|
|
has 'api_key' => (
|
|
is => 'ro',
|
|
isa => 'Str',
|
|
required => 1,
|
|
);
|
|
|
|
has 'base_url' => (
|
|
is => 'rw',
|
|
isa => 'Str',
|
|
default => sub { return 'https://api.tools.percona.com' },
|
|
required => 0,
|
|
);
|
|
|
|
has 'links' => (
|
|
is => 'rw',
|
|
isa => 'HashRef',
|
|
lazy => 1,
|
|
default => sub { return +{} },
|
|
);
|
|
|
|
has 'ua' => (
|
|
is => 'rw',
|
|
isa => 'Object',
|
|
lazy => 1,
|
|
required => 1,
|
|
builder => '_build_ua',
|
|
);
|
|
|
|
has 'response' => (
|
|
is => 'rw',
|
|
isa => 'Object',
|
|
required => 0,
|
|
default => undef,
|
|
);
|
|
|
|
sub _build_ua {
|
|
my $self = shift;
|
|
my $ua = LWP::UserAgent->new;
|
|
$ua->agent("Percona::WebAPI::Client/$Percona::WebAPI::Client::VERSION");
|
|
$ua->default_header('application/json');
|
|
$ua->default_header('X-Percona-API-Key', $self->api_key);
|
|
return $ua;
|
|
}
|
|
|
|
sub BUILD {
|
|
my ($self) = @_;
|
|
|
|
eval {
|
|
$self->get(
|
|
url => $self->base_url,
|
|
);
|
|
};
|
|
if ( my $e = $EVAL_ERROR ) {
|
|
if (blessed($e) && $e->isa('Percona::WebAPI::Exception::Request')) {
|
|
die $e;
|
|
}
|
|
else {
|
|
die "Unknown error: $e";
|
|
}
|
|
}
|
|
|
|
return;
|
|
}
|
|
|
|
sub get {
|
|
my ($self, %args) = @_;
|
|
|
|
have_required_args(\%args, qw(
|
|
url
|
|
)) or die;
|
|
my ($url) = $args{url};
|
|
|
|
# Returns:
|
|
my @resources;
|
|
|
|
# Get resource representations from the url. The server should always
|
|
# return a list of resource reps, even if there's only one resource.
|
|
eval {
|
|
$self->_request(
|
|
method => 'GET',
|
|
url => $url,
|
|
);
|
|
};
|
|
if ( my $e = $EVAL_ERROR ) {
|
|
if (blessed($e) && $e->isa('Percona::WebAPI::Exception::Request')) {
|
|
die $e;
|
|
}
|
|
else {
|
|
die "Unknown error: $e";
|
|
}
|
|
}
|
|
|
|
# Transform the resource representations into an arrayref of hashrefs.
|
|
# Each hashref contains (hopefully) all the attribs necessary to create
|
|
# a corresponding resource object.
|
|
my $res = eval {
|
|
decode_json($self->response->content);
|
|
};
|
|
if ( $EVAL_ERROR ) {
|
|
warn sprintf "Error decoding resource: %s: %s",
|
|
$self->response->content,
|
|
$EVAL_ERROR;
|
|
return;
|
|
}
|
|
|
|
my $objs;
|
|
if ( my $type = $self->response->headers->{'x-percona-resource-type'} ) {
|
|
eval {
|
|
my $type = "Percona::WebAPI::Resource::$type";
|
|
|
|
# Create resource objects using the server-provided attribs.
|
|
if ( ref $res eq 'ARRAY' ) {
|
|
PTDEBUG && _d('Got a list of', $type, 'resources');
|
|
foreach my $attribs ( @$res ) {
|
|
my $obj = $type->new(%$attribs);
|
|
push @$objs, $obj;
|
|
}
|
|
}
|
|
else {
|
|
PTDEBUG && _d('Got a', $type, 'resource');
|
|
$objs = $type->new(%$res);
|
|
}
|
|
};
|
|
if ( $EVAL_ERROR ) {
|
|
warn "Error creating $type resource objects: $EVAL_ERROR";
|
|
return;
|
|
}
|
|
}
|
|
elsif ( $res ) {
|
|
$self->update_links($res);
|
|
}
|
|
else {
|
|
warn "Did not get X-Percona-Resource-Type or content from $url\n";
|
|
}
|
|
|
|
return $objs;
|
|
}
|
|
|
|
sub post {
|
|
my $self = shift;
|
|
return $self->_set(
|
|
@_,
|
|
method => 'POST',
|
|
);
|
|
}
|
|
|
|
sub put {
|
|
my $self = shift;
|
|
return $self->_set(
|
|
@_,
|
|
method => 'PUT',
|
|
);
|
|
}
|
|
|
|
sub delete {
|
|
my ($self, %args) = @_;
|
|
|
|
have_required_args(\%args, qw(
|
|
url
|
|
)) or die;
|
|
my ($url) = $args{url};
|
|
|
|
eval {
|
|
$self->_request(
|
|
method => 'DELETE',
|
|
url => $url,
|
|
headers => { 'Content-Length' => 0 },
|
|
);
|
|
};
|
|
if ( my $e = $EVAL_ERROR ) {
|
|
if (blessed($e) && $e->isa('Percona::WebAPI::Exception::Request')) {
|
|
die $e;
|
|
}
|
|
else {
|
|
die "Unknown error: $e";
|
|
}
|
|
}
|
|
|
|
return;
|
|
}
|
|
|
|
sub _set {
|
|
my ($self, %args) = @_;
|
|
|
|
have_required_args(\%args, qw(
|
|
method
|
|
resources
|
|
url
|
|
)) or die;
|
|
my $method = $args{method};
|
|
my $res = $args{resources};
|
|
my $url = $args{url};
|
|
|
|
my $content = '';
|
|
if ( ref($res) eq 'ARRAY' ) {
|
|
PTDEBUG && _d('List of resources');
|
|
$content = '[' . join(",\n", map { as_json($_) } @$res) . ']';
|
|
}
|
|
elsif ( ref($res) ) {
|
|
PTDEBUG && _d('Resource object');
|
|
$content = as_json($res);
|
|
}
|
|
elsif ( $res !~ m/\n/ && -f $res ) {
|
|
PTDEBUG && _d('List of resources in file', $res);
|
|
$content = '[';
|
|
my $data = do {
|
|
local $INPUT_RECORD_SEPARATOR = undef;
|
|
open my $fh, '<', $res
|
|
or die "Error opening $res: $OS_ERROR";
|
|
<$fh>;
|
|
};
|
|
$data =~ s/,?\s*$/]/;
|
|
$content .= $data;
|
|
}
|
|
else {
|
|
PTDEBUG && _d('Resource text');
|
|
$content = $res;
|
|
}
|
|
|
|
eval {
|
|
$self->_request(
|
|
method => $method,
|
|
url => $url,
|
|
content => $content,
|
|
);
|
|
};
|
|
if ( my $e = $EVAL_ERROR ) {
|
|
if (blessed($e) && $e->isa('Percona::WebAPI::Exception::Request')) {
|
|
die $e;
|
|
}
|
|
else {
|
|
die "Unknown error: $e";
|
|
}
|
|
}
|
|
|
|
my $response = eval {
|
|
decode_json($self->response->content);
|
|
};
|
|
if ( $EVAL_ERROR ) {
|
|
warn sprintf "Error decoding response to $method $url: %s: %s",
|
|
$self->response->content,
|
|
$EVAL_ERROR;
|
|
return;
|
|
}
|
|
|
|
$self->update_links($response);
|
|
|
|
return;
|
|
}
|
|
|
|
sub _request {
|
|
my ($self, %args) = @_;
|
|
|
|
have_required_args(\%args, qw(
|
|
method
|
|
url
|
|
)) or die;
|
|
my $method = $args{method};
|
|
my $url = $args{url};
|
|
|
|
my @optional_args = (
|
|
'content',
|
|
'headers',
|
|
);
|
|
my ($content, $headers) = @args{@optional_args};
|
|
|
|
my $req = HTTP::Request->new($method => $url);
|
|
$req->content($content) if $content;
|
|
if ( uc($method) eq 'DELETE' ) {
|
|
$self->ua->default_header('Content-Length' => 0);
|
|
}
|
|
PTDEBUG && _d('Request', $method, $url, Dumper($req));
|
|
|
|
my $response = $self->ua->request($req);
|
|
PTDEBUG && _d('Response', Dumper($response));
|
|
|
|
if ( uc($method) eq 'DELETE' ) {
|
|
$self->ua->default_header('Content-Length' => undef);
|
|
}
|
|
|
|
if ( !($response->code >= 200 && $response->code < 400) ) {
|
|
die Percona::WebAPI::Exception::Request->new(
|
|
method => $method,
|
|
url => $url,
|
|
content => $content,
|
|
status => $response->code,
|
|
error => "Failed to $method $url"
|
|
);
|
|
}
|
|
|
|
$self->response($response);
|
|
|
|
return;
|
|
}
|
|
|
|
sub update_links {
|
|
my ($self, $links) = @_;
|
|
return unless $links && ref $links && scalar keys %$links;
|
|
while (my ($rel, $link) = each %$links) {
|
|
$self->links->{$rel} = $link;
|
|
}
|
|
PTDEBUG && _d('Updated links', Dumper($self->links));
|
|
return;
|
|
}
|
|
|
|
no Lmo;
|
|
1;
|
|
}
|
|
# ###########################################################################
|
|
# End Percona::WebAPI::Client package
|
|
# ###########################################################################
|