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

Fix WebAPI::Client to always expect links: in reponse.

Browse Source
This commit is contained in:
Daniel Nichter
2012-12-26 09:16:53 -07:00
parent 5051abc7ec
commit 87080d44b2
3 changed files with 43 additions and 53 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -69,8 +69,10 @@ has 'ua' => (
);
has 'response' => (
is => 'rw',
isa => 'Object',
is => 'rw',
isa => 'Object',
required => 0,
default => undef,
);
sub _build_ua {
@@ -86,9 +88,8 @@ sub BUILD {
my ($self) = @_;
eval {
$self->_request(
method => 'GET',
url => $self->base_url,
$self->get(
url => $self->base_url,
);
};
if ( my $e = $EVAL_ERROR ) {
@@ -100,11 +101,6 @@ sub BUILD {
}
}
my $entry_links = decode_json($self->response->content);
PTDEBUG && _d('Entry links', Dumper($entry_links));
$self->links($entry_links);
return;
}
@@ -271,18 +267,17 @@ sub _set {
}
}
my $links;
eval {
$links = decode_json($self->response->content);
my $response = eval {
decode_json($self->response->content);
};
if ( $EVAL_ERROR ) {
warn sprintf "Error decoding resource: %s: %s",
warn sprintf "Error decoding response to $method $url: %s: %s",
$self->response->content,
$EVAL_ERROR;
return;
}
$self->update_links($links);
$self->update_links($response->{links});
return;
}
@@ -310,34 +305,33 @@ sub _request {
}
PTDEBUG && _d('Request', $method, $url, Dumper($req));
my $res = $self->ua->request($req);
PTDEBUG && _d('Response', Dumper($res));
my $response = $self->ua->request($req);
PTDEBUG && _d('Response', Dumper($response));
if ( uc($method) eq 'DELETE' ) {
$self->ua->default_header('Content-Length' => undef);
}
if ( !($res->code >= 200 && $res->code < 400) ) {
if ( !($response->code >= 200 && $response->code < 400) ) {
die Percona::WebAPI::Exception::Request->new(
method => $method,
url => $url,
content => $content,
status => $res->code,
error => $res->content,
status => $response->code,
error => $response->content,
);
}
$self->response($res);
$self->response($response);
return;
}
sub update_links {
my ($self, $new_links) = @_;
while (my ($svc, $links) = each %$new_links) {
while (my ($rel, $link) = each %$links) {
$self->links->{$svc}->{$rel} = $link;
}
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;