percona/percona-toolkit
1
0
Fork 0
mirror of https://github.com/percona/percona-toolkit.git synced 2025-09-10 05:00:45 +00:00
Code Issues Packages Projects Releases Wiki Activity

Simplify and test Percona::WebAPI::Client.pm according to new web API specs.

Browse Source
This commit is contained in:
Daniel Nichter
2013-01-31 12:58:09 -07:00
parent a8da9c268a
commit 24e505a43d
9 changed files with 332 additions and 99 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
lib/Percona/Test/Mock/UserAgent.pm
View File

@@ -20,11 +20,14 @@
{
package Percona::Test::Mock::UserAgent;
use Percona::Toolkit qw(Dumper);
sub new {
my ($class, %args) = @_;
my $self = {
encode => $args{encode} || sub { return $_[0] },
decode => $args{decode} || sub { return $_[0] },
requests => [],
responses => {
get => [],
post => [],
@@ -41,11 +44,12 @@ sub new {
sub request {
my ($self, $req) = @_;
my $type = lc($req->method);
push @{$self->{requests}}, uc($type) . ' ' . $req->uri;
if ( $type eq 'post' || $type eq 'put' ) {
push @{$self->{content}->{$type}}, $req->content;
}
my $r = shift @{$self->{responses}->{$type}};
my $c = $self->{encode}->($r->{content});
my $c = $r->{content} ? $self->{encode}->($r->{content}) : '';
my $h = HTTP::Headers->new;
$h->header(%{$r->{headers}}) if exists $r->{headers};
my $res = HTTP::Response->new(

146
lib/Percona/WebAPI/Client.pm
View File

@@ -1,5 +1,4 @@
# This program is copyright 2012-2013 Percona Inc.
# Feedback and improvements are welcome.
# This program is copyright 2012 codenode LLC, 2012-2013 Percona Ireland Ltd.
#
# THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
# WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
@@ -46,20 +45,13 @@ has 'api_key' => (
required => 1,
);
has 'base_url' => (
has 'entry_link' => (
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',
@@ -79,48 +71,24 @@ 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('Content-Type', '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
link
)) or die;
my ($url) = $args{url};
my ($link) = $args{link};
# 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.
# Get the resources at the link.
eval {
$self->_request(
method => 'GET',
url => $url,
link => $link,
);
};
if ( my $e = $EVAL_ERROR ) {
@@ -132,10 +100,8 @@ sub get {
}
}
# 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 {
# The resource should be represented as JSON, decode it.
my $resource = eval {
decode_json($self->response->content);
};
if ( $EVAL_ERROR ) {
@@ -145,22 +111,26 @@ sub get {
return;
}
my $objs;
# If the server tells us the resource's type, create a new object
# of that type. Else, if there's no type, there's no resource, so
# we should have received links. This usually only happens for the
# entry link. The returned resource objects ref may be scalar or
# an arrayref; the caller should know.
my $resource_objects;
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' ) {
$type = "Percona::WebAPI::Resource::$type";
if ( ref $resource eq 'ARRAY' ) {
PTDEBUG && _d('Got a list of', $type, 'resources');
foreach my $attribs ( @$res ) {
$resource_objects = [];
foreach my $attribs ( @$resource ) {
my $obj = $type->new(%$attribs);
push @$objs, $obj;
push @$resource_objects, $obj;
}
}
else {
PTDEBUG && _d('Got a', $type, 'resource');
$objs = $type->new(%$res);
PTDEBUG && _d('Got a', $type, 'resource', Dumper($resource));
$resource_objects = $type->new(%$resource);
}
};
if ( $EVAL_ERROR ) {
@@ -168,44 +138,54 @@ sub get {
return;
}
}
elsif ( $res ) {
$self->update_links($res);
elsif ( exists $resource->{links} ) {
# Lie to the caller: this isn't an object, but the caller can
# treat it like one, e.g. my $links = $api->get(<entry links>);
# then access $links->{self}. A Links object couldn't have
# dynamic attribs anyway, so no use having a real Links obj.
$resource_objects = $resource->{links};
}
else {
warn "Did not get X-Percona-Resource-Type or content from $url\n";
warn "Did not get X-Percona-Resource-Type or links from $link\n";
}
return $objs;
return $resource_objects;
}
# For a successful POST, the server sets the Location header with
# the URI of the newly created resource.
sub post {
my $self = shift;
return $self->_set(
$self->_set(
@_,
method => 'POST',
);
return $self->response->header('Location');
}
# For a successful PUT, the server returns nothing because the caller
# already has the resources URI (if not, the caller should POST).
sub put {
my $self = shift;
return $self->_set(
$self->_set(
@_,
method => 'PUT',
);
return;
}
sub delete {
my ($self, %args) = @_;
have_required_args(\%args, qw(
url
link
)) or die;
my ($url) = $args{url};
my ($link) = $args{link};
eval {
$self->_request(
method => 'DELETE',
url => $url,
link => $link,
headers => { 'Content-Length' => 0 },
);
};
@@ -221,17 +201,18 @@ sub delete {
return;
}
# Low-level POST and PUT handler.
sub _set {
my ($self, %args) = @_;
have_required_args(\%args, qw(
method
resources
url
link
)) or die;
my $method = $args{method};
my $res = $args{resources};
my $url = $args{url};
my $link = $args{link};
my $content = '';
if ( ref($res) eq 'ARRAY' ) {
@@ -262,7 +243,7 @@ sub _set {
eval {
$self->_request(
method => $method,
url => $url,
link => $link,
content => $content,
);
};
@@ -275,30 +256,21 @@ sub _set {
}
}
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;
}
# Low-level HTTP request handler for all methods. Sets $self->response
# from the request. Returns nothing on success (HTTP status 2xx-3xx),
# else throws an Percona::WebAPI::Exception::Request.
sub _request {
my ($self, %args) = @_;
have_required_args(\%args, qw(
method
url
link
)) or die;
my $method = $args{method};
my $url = $args{url};
my $link = $args{link};
my @optional_args = (
'content',
@@ -306,12 +278,12 @@ sub _request {
);
my ($content, $headers) = @args{@optional_args};
my $req = HTTP::Request->new($method => $url);
my $req = HTTP::Request->new($method => $link);
$req->content($content) if $content;
if ( uc($method) eq 'DELETE' ) {
$self->ua->default_header('Content-Length' => 0);
}
PTDEBUG && _d('Request', $method, $url, Dumper($req));
PTDEBUG && _d('Request', $method, $link, Dumper($req));
my $response = $self->ua->request($req);
PTDEBUG && _d('Response', Dumper($response));
@@ -323,10 +295,10 @@ sub _request {
if ( !($response->code >= 200 && $response->code < 400) ) {
die Percona::WebAPI::Exception::Request->new(
method => $method,
url => $url,
link => $link,
content => $content,
status => $response->code,
error => "Failed to $method $url"
error => "Failed to $method $link",
);
}
@@ -335,16 +307,6 @@ sub _request {
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;
}

7
lib/Percona/WebAPI/Representation.pm
View File

@@ -31,14 +31,17 @@ our @EXPORT_OK = qw(
);
sub as_hashref {
my $resource = shift;
my ($resource, %args) = @_;
# Copy the object into a new hashref.
my $as_hashref = { %$resource };
# Delete the links because they're just for client-side use
# and the caller should be sending this object, not getting it.
delete $as_hashref->{links};
# But sometimes for testing we want to keep the links.
if ( !defined $args{with_links} || !$args{with_links} ) {
delete $as_hashref->{links};
}
return $as_hashref;
}

8
lib/Percona/WebAPI/Resource/Agent.pm
View File

@@ -38,7 +38,13 @@ has 'versions' => (
is => 'ro',
isa => 'Maybe[HashRef]',
required => 0,
default => undef,
);
has 'links' => (
is => 'rw',
isa => 'Maybe[HashRef]',
required => 0,
default => sub { return {} },
);
no Lmo;

19
lib/Percona/WebAPI/Resource/Config.pm
View File

@@ -22,12 +22,31 @@ package Percona::WebAPI::Resource::Config;
use Lmo;
has 'id' => (
is => 'r0',
isa => 'Int',
required => 1,
);
has 'name' => (
is => 'ro',
isa => 'Str',
required => 1,
);
has 'options' => (
is => 'ro',
isa => 'HashRef',
required => 1,
);
has 'links' => (
is => 'rw',
isa => 'Maybe[HashRef]',
required => 0,
default => sub { return {} },
);
no Lmo;
1;
}

1
lib/Percona/WebAPI/Resource/Run.pm
View File

@@ -44,7 +44,6 @@ has 'query' => (
is => 'ro',
isa => 'Maybe[Str]',
required => 0,
default => undef,
);
has 'output' => (

7
lib/Percona/WebAPI/Resource/Service.pm
View File

@@ -46,6 +46,13 @@ has 'spool_schedule' => (
required => 0,
);
has 'links' => (
is => 'rw',
isa => 'Maybe[HashRef]',
required => 0,
default => sub { return {} },
);
sub BUILDARGS {
my ($class, %args) = @_;
if ( ref $args{runs} eq 'ARRAY' ) {