← Back to branch summary

~percona-toolkit-dev/percona-toolkit/pt-stalk-sleep-collect-option

« back to all changes in this revision

Viewing changes to lib/Percona/WebAPI/Client.pm

  • Committer: Daniel Nichter
  • Date: 2013-06-19 21:23:55 UTC
  • mfrom: (582.1.5 release-2.2.3)
  • Revision ID: daniel@percona.com-20130619212355-nf6bmx23j3b76afe
Tags: 2.2.3
Merge release-2.2.3.

Show diffs side-by-side

added added

removed removed

Lines of Context:
lib/Percona/WebAPI/Client.pm
 
1
# This program is copyright 2012 codenode LLC, 2012-2013 Percona Ireland Ltd.
 
2
#
 
3
# THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
 
4
# WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
 
5
# MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
 
6
#
 
7
# This program is free software; you can redistribute it and/or modify it under
 
8
# the terms of the GNU General Public License as published by the Free Software
 
9
# Foundation, version 2; OR the Perl Artistic License.  On UNIX and similar
 
10
# systems, you can issue `man perlgpl' or `man perlartistic' to read these
 
11
# licenses.
 
12
#
 
13
# You should have received a copy of the GNU General Public License along with
 
14
# this program; if not, write to the Free Software Foundation, Inc., 59 Temple
 
15
# Place, Suite 330, Boston, MA  02111-1307  USA.
 
16
# ###########################################################################
 
17
# Percona::WebAPI::Client package
 
18
# ###########################################################################
 
19
{
 
20
package Percona::WebAPI::Client;
 
21
 
 
22
our $VERSION = '0.01';
 
23
 
 
24
use strict;
 
25
use warnings FATAL => 'all';
 
26
use English qw(-no_match_vars);
 
27
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
 
28
 
 
29
eval {
 
30
   require LWP;
 
31
   require JSON;
 
32
};
 
33
 
 
34
use Scalar::Util qw(blessed); 
 
35
 
 
36
use Lmo;
 
37
use Percona::Toolkit;
 
38
use Percona::WebAPI::Representation;
 
39
use Percona::WebAPI::Exception::Request;
 
40
use Percona::WebAPI::Exception::Resource;
 
41
 
 
42
Percona::WebAPI::Representation->import(qw(as_json));
 
43
Percona::Toolkit->import(qw(_d Dumper have_required_args));
 
44
 
 
45
has 'api_key' => (
 
46
   is       => 'ro',
 
47
   isa      => 'Str',
 
48
   required => 1,
 
49
);
 
50
 
 
51
has 'entry_link' => (
 
52
   is       => 'rw',
 
53
   isa      => 'Str',
 
54
   required => 0,
 
55
   default  => sub { return 'https://cloud-api.percona.com' },
 
56
);
 
57
 
 
58
has 'ua' => (
 
59
   is       => 'rw',
 
60
   isa      => 'Object',
 
61
   lazy     => 1,
 
62
   required => 0,
 
63
   builder  => '_build_ua',
 
64
);
 
65
 
 
66
has 'response' => (
 
67
   is       => 'rw',
 
68
   isa      => 'Object',
 
69
   required => 0,
 
70
   default  => undef,
 
71
);
 
72
 
 
73
sub _build_ua {
 
74
   my $self = shift;
 
75
   my $ua = LWP::UserAgent->new;
 
76
   $ua->agent("Percona::WebAPI::Client/$Percona::WebAPI::Client::VERSION");
 
77
   $ua->default_header('Content-Type', 'application/json');
 
78
   $ua->default_header('X-Percona-API-Key', $self->api_key);
 
79
   return $ua;
 
80
}
 
81
 
 
82
sub get {
 
83
   my ($self, %args) = @_;
 
84
   
 
85
   have_required_args(\%args, qw(
 
86
      link
 
87
   )) or die;
 
88
   my ($link) = $args{link};
 
89
 
 
90
   # Get the resources at the link.
 
91
   eval {
 
92
      $self->_request(
 
93
         method => 'GET',
 
94
         link   => $link,
 
95
      );
 
96
   };
 
97
   if ( my $e = $EVAL_ERROR ) {
 
98
      if (blessed($e) && $e->isa('Percona::WebAPI::Exception::Request')) {
 
99
         die $e;
 
100
      }
 
101
      else {
 
102
         die "Unknown error: $e";
 
103
      }
 
104
   }
 
105
 
 
106
   # The resource should be represented as JSON, decode it.
 
107
   my $resource = eval {
 
108
      JSON::decode_json($self->response->content);
 
109
   };
 
110
   if ( $EVAL_ERROR ) {
 
111
      warn sprintf "Error decoding resource: %s: %s",
 
112
         $self->response->content,
 
113
         $EVAL_ERROR;
 
114
      return;
 
115
   }
 
116
 
 
117
   # If the server tells us the resource's type, create a new object
 
118
   # of that type.  Else, if there's no type, there's no resource, so
 
119
   # we should have received links.  This usually only happens for the
 
120
   # entry link.  The returned resource objects ref may be scalar or
 
121
   # an arrayref; the caller should know.
 
122
   my $resource_objects;
 
123
   if ( my $type = $self->response->headers->{'x-percona-resource-type'} ) {
 
124
      eval {
 
125
         $type = "Percona::WebAPI::Resource::$type";
 
126
         if ( ref $resource eq 'ARRAY' ) {
 
127
            PTDEBUG && _d('Got a list of', $type, 'resources');
 
128
            $resource_objects = [];
 
129
            foreach my $attribs ( @$resource ) {
 
130
               my $obj = $type->new(%$attribs);
 
131
               push @$resource_objects, $obj;
 
132
            }
 
133
         }
 
134
         else {
 
135
            PTDEBUG && _d('Got a', $type, 'resource', Dumper($resource));
 
136
            $resource_objects = $type->new(%$resource);
 
137
         }
 
138
      };
 
139
      if ( my $e = $EVAL_ERROR ) {
 
140
         die Percona::WebAPI::Exception::Resource->new(
 
141
            type  => $type,
 
142
            link  => $link,
 
143
            data  => (ref $resource eq 'ARRAY' ? $resource : [ $resource ]),
 
144
            error => $e,
 
145
         );
 
146
      }
 
147
   }
 
148
   elsif ( exists $resource->{links} ) {
 
149
      # Lie to the caller: this isn't an object, but the caller can
 
150
      # treat it like one, e.g. my $links = $api->get(<entry links>);
 
151
      # then access $links->{self}.  A Links object couldn't have
 
152
      # dynamic attribs anyway, so no use having a real Links obj.
 
153
      $resource_objects = $resource->{links};
 
154
   }
 
155
   else {
 
156
      warn "Did not get X-Percona-Resource-Type or links from $link\n";
 
157
   }
 
158
 
 
159
   return $resource_objects;
 
160
}
 
161
 
 
162
# For a successful POST, the server sets the Location header with
 
163
# the URI of the newly created resource.
 
164
sub post {
 
165
   my $self = shift;
 
166
   $self->_set(
 
167
      @_,
 
168
      method => 'POST',
 
169
   );
 
170
   return $self->response->header('Location');
 
171
}
 
172
 
 
173
sub put {
 
174
   my $self = shift;
 
175
   $self->_set(
 
176
      @_,
 
177
      method => 'PUT',
 
178
   );
 
179
   return $self->response->header('Location');
 
180
}
 
181
 
 
182
sub delete {
 
183
   my ($self, %args) = @_;
 
184
   have_required_args(\%args, qw(
 
185
      link 
 
186
   )) or die;
 
187
   my ($link) = $args{link};
 
188
 
 
189
   eval {
 
190
      $self->_request(
 
191
         method  => 'DELETE',
 
192
         link    => $link,
 
193
         headers => { 'Content-Length' => 0 },
 
194
      ); 
 
195
   };
 
196
   if ( my $e = $EVAL_ERROR ) {
 
197
      if (blessed($e) && $e->isa('Percona::WebAPI::Exception::Request')) {
 
198
         die $e;
 
199
      }
 
200
      else {
 
201
         die "Unknown error: $e";
 
202
      }
 
203
   }
 
204
 
 
205
   return;
 
206
}
 
207
 
 
208
# Low-level POST and PUT handler.
 
209
sub _set {
 
210
   my ($self, %args) = @_;
 
211
   have_required_args(\%args, qw(
 
212
      method
 
213
      resources
 
214
      link
 
215
   )) or die;
 
216
   my $method = $args{method};
 
217
   my $res    = $args{resources};
 
218
   my $link   = $args{link};
 
219
 
 
220
   # Optional args
 
221
   my $headers = $args{headers};
 
222
 
 
223
   my $content = '';
 
224
   if ( ref($res) eq 'ARRAY' ) {
 
225
      PTDEBUG && _d('List of resources');
 
226
      $content = '[' . join(",\n", map { as_json($_) } @$res) . ']';
 
227
   }
 
228
   elsif ( ref($res) ) {
 
229
      PTDEBUG && _d('Resource object');
 
230
      $content = as_json($res);
 
231
   }
 
232
   elsif ( $res !~ m/\n/ && -f $res ) {
 
233
      PTDEBUG && _d('List of resources in file', $res);
 
234
      $content = '[';
 
235
      my $data = do {
 
236
         local $INPUT_RECORD_SEPARATOR = undef;
 
237
         open my $fh, '<', $res
 
238
            or die "Error opening $res: $OS_ERROR";
 
239
         <$fh>;
 
240
      };
 
241
      $data =~ s/,?\s*$/]/;
 
242
      $content .= $data;
 
243
   }
 
244
   else {
 
245
      PTDEBUG && _d('Resource text');
 
246
      $content = $res;
 
247
   }
 
248
 
 
249
   eval {
 
250
      $self->_request(
 
251
         method  => $method,
 
252
         link    => $link,
 
253
         content => $content,
 
254
         headers => $headers,
 
255
      );
 
256
   };
 
257
   if ( my $e = $EVAL_ERROR ) {
 
258
      if (blessed($e) && $e->isa('Percona::WebAPI::Exception::Request')) {
 
259
         die $e;
 
260
      }
 
261
      else {
 
262
         die "Unknown error: $e";
 
263
      }
 
264
   }
 
265
 
 
266
   return;
 
267
}
 
268
 
 
269
# Low-level HTTP request handler for all methods.  Sets $self->response
 
270
# from the request.  Returns nothing on success (HTTP status 2xx-3xx),
 
271
# else throws an Percona::WebAPI::Exception::Request.
 
272
sub _request {
 
273
   my ($self, %args) = @_;
 
274
 
 
275
   have_required_args(\%args, qw(
 
276
      method
 
277
      link 
 
278
   )) or die;
 
279
   my $method = $args{method};
 
280
   my $link   = $args{link};
 
281
   
 
282
   # Optional args
 
283
   my $content = $args{content};
 
284
   my $headers = $args{headers};
 
285
 
 
286
   my $req = HTTP::Request->new($method => $link);
 
287
   if ( $content ) {
 
288
      $req->content($content);
 
289
   }
 
290
   if ( $headers ) {
 
291
      map { $req->header($_ => $headers->{$_}) } keys %$headers;
 
292
   }
 
293
   PTDEBUG && _d('Request', $method, $link, Dumper($req));
 
294
 
 
295
   my $response = $self->ua->request($req);
 
296
   PTDEBUG && _d('Response', Dumper($response));
 
297
 
 
298
   $self->response($response);
 
299
 
 
300
   if ( !($response->code >= 200 && $response->code < 400) ) {
 
301
      die Percona::WebAPI::Exception::Request->new(
 
302
         method  => $method,
 
303
         url     => $link,
 
304
         content => $content,
 
305
         status  => $response->code,
 
306
         error   => "Failed to $method $link",
 
307
      );
 
308
   }
 
309
 
 
310
   return;
 
311
}
 
312
 
 
313
no Lmo;
 
314
1;
 
315
}
 
316
# ###########################################################################
 
317
# End Percona::WebAPI::Client package
 
318
# ###########################################################################