File Coverage

blib/lib/JMX/Jmx4Perl/Request.pm
Criterion Covered Total %
statement 97 126 76.9
branch 33 72 45.8
condition 7 18 38.8
subroutine 17 19 89.4
pod 4 5 80.0
total 158 240 65.8


line stmt bran cond sub pod time code
1             #!/usr/bin/perl
2              
3             =head1 NAME
4              
5             JMX::Jmx4Perl::Request - A jmx4perl request
6              
7             =head1 SYNOPSIS
8              
9             $req = JMX::Jmx4Perl::Request->new(READ,$mbean,$attribute);
10              
11             =head1 DESCRIPTION
12              
13             A L encapsulates a request for various operational
14             types.
15              
16             The following attributes are available:
17              
18             =over
19              
20             =item mbean
21              
22             Name of the targetted mbean in its canonical format.
23              
24             =item type
25              
26             Type of request, which should be one of the constants
27              
28             =over
29              
30             =item READ
31              
32             Get the value of a attribute
33              
34             =item WRITE
35              
36             Write an attribute
37              
38             =item EXEC
39              
40             Execute an JMX operation
41              
42             =item LIST
43              
44             List all MBeans available
45              
46             =item SEARCH
47              
48             Search for MBeans
49              
50             =item AGENT_VERSION
51              
52             Get the agent's version and extra runtime information of the serverside.
53              
54             =item REGISTER_NOTIFICATION
55              
56             Register for a JMX notification (not supported yet)
57              
58             =item REMOVE_NOTIFICATION
59              
60             Remove a JMX notification (not supported yet)
61              
62             =back
63              
64             =item attribute
65              
66             If type is C or C this specifies the requested
67             attribute
68              
69             =item value
70              
71             For C this specifies the value to set
72              
73             =item arguments
74              
75             List of arguments of C operations
76              
77             =item path
78              
79             This optional parameter can be used to specify a nested value in an complex
80             mbean attribute or nested return value from a JMX operation. For example, the
81             MBean C's attribute C is a complex
82             value, which looks in the JSON representation like
83              
84             "value":{"init":0,"max":518979584,"committed":41381888,"used":33442568}
85              
86             So, to fetch the C<"used"> value only, specify C as path within the
87             request. You can access deeper nested values by building up a path with "/" as
88             separator. This looks a bit like a simplified form of XPath.
89              
90             =item maxDepth, maxObjects, maxCollectionSize, ignoreErrors
91              
92             With these number you can restrict the size of the JSON structure
93             returned. C gives the maximum nesting level of the JSON
94             object,C returns the maximum number of objects to be returned in
95             total and C restrict the number of all arrays and
96             collections (maps, lists) in the answer. Note, that you should use this
97             restrictions if you are doing massive bulk operations. C is
98             useful for read requests with multiple attributes to skip errors while reading
99             attribute values on the errors side (the error text will be set as value).
100              
101             =item target
102              
103             If given, the request is processed by the agent in proxy mode, i.e. it will
104             proxy to another server exposing via a JSR-160 connector. C is a hash
105             which contains information how to reach the target service via the proxy. This
106             hash knows the following keys:
107              
108             =over
109              
110             =item url
111              
112             JMX service URL as specified in JSR-160 pointing to the target server.
113              
114             =item env
115              
116             Further context information which is another hash.
117              
118             =back
119              
120             =back
121              
122             =head1 METHODS
123              
124             =over
125              
126             =cut
127              
128             package JMX::Jmx4Perl::Request;
129              
130 4     4   38566 use strict;
  4         10  
  4         121  
131 4     4   19 use vars qw(@EXPORT);
  4         9  
  4         195  
132 4     4   20 use Carp;
  4         6  
  4         455  
133 4     4   1886 use Data::Dumper;
  4         19463  
  4         248  
134              
135 4     4   33 use base qw(Exporter);
  4         7  
  4         504  
136             @EXPORT = (
137             "READ","WRITE","EXEC","LIST", "SEARCH",
138             "REGNOTIF","REMNOTIF", "AGENT_VERSION"
139             );
140              
141 4     4   21 use constant READ => "read";
  4         6  
  4         258  
142 4     4   19 use constant WRITE => "write";
  4         8  
  4         184  
143 4     4   19 use constant EXEC => "exec";
  4         7  
  4         174  
144 4     4   19 use constant LIST => "list";
  4         7  
  4         195  
145 4     4   27 use constant SEARCH => "search";
  4         9  
  4         176  
146 4     4   19 use constant REGNOTIF => "regnotif";
  4         11  
  4         162  
147 4     4   18 use constant REMNOTIF => "remnotif";
  4         7  
  4         329  
148 4     4   18 use constant AGENT_VERSION => "version";
  4         8  
  4         6686  
149              
150             my $TYPES =
151             { map { $_ => 1 } (READ, WRITE, EXEC, LIST, SEARCH,
152             REGNOTIF, REMNOTIF, AGENT_VERSION) };
153              
154             =item $req = new JMX::Jmx4Perl::Request(....);
155              
156             $req = new JMX::Jmx4Perl::Request(READ,$mbean,$attribute,$path, { ... options ... } );
157             $req = new JMX::Jmx4Perl::Request(READ,{ mbean => $mbean,... });
158             $req = new JMX::Jmx4Perl::Request({type => READ, mbean => $mbean, ... });
159              
160             The constructor can be used in various way. In the simplest form, you provide
161             the type as first argument and depending on the type one or more additional
162             attributes which specify the request. The second form uses the type as first
163             parameter and a hashref containing named parameter for the request parameters
164             (for the names, see above). Finally you can specify the arguments completely as
165             a hashref, using 'type' for the entry specifying the request type.
166              
167             For the options C, C and C, you can mix
168             them in into the hashref if using the hashed argument format. For the first
169             format, these options are given as a final hashref.
170              
171             The option C can be used to suggest a HTTP request method to use. By
172             default, the agent decides automatically which HTTP method to use depending on
173             the number of requests and whether an extended format should be used (which is
174             only possible with an HTTP POST request). The value of this option can be
175             either C or C, dependening on your preference.
176              
177             If the request should be proxied through this request, a target configuration
178             needs to be given as optional parameter. The target configuration consists of a
179             JMX service C and a optional environment, which is given as a key-value
180             map. For example
181              
182             $req = new JMX::Jmx4Perl::Request(..., {
183             target => {
184             url => "",
185             env => { ..... }
186             }
187             } );
188              
189             Note, depending on the type, some parameters are mandatory. The mandatory
190             parameters and the order of the arguments for the constructor variant without
191             named parameters are:
192              
193             =over
194              
195             =item C
196              
197             Order : $mbean, $attribute, $path
198             Mandatory: $mbean, $attribute
199              
200             Note that C<$attribute> can be either a single name or a reference to a list
201             of attribute names.
202              
203             =item C
204              
205             Order : $mbean, $attribute, $value, $path
206             Mandatory: $mbean, $attribute, $value
207              
208             =item C
209              
210             Order : $mbean, $operation, $arg1, $arg2, ...
211             Mandatory: $mbean, $operation
212              
213              
214             =item C
215            
216             Order : $path
217              
218             =item C
219              
220             Order : $pattern
221             Mandatory: $pattern
222              
223             =back
224              
225             =cut
226              
227             sub new {
228 20     20 1 7978 my $class = shift;
229 20         24 my $type = shift;
230 20         24 my $self;
231             # Hash as argument
232 20 50       47 if (ref($type) eq "HASH") {
233 0         0 $self = $type;
234 0         0 $type = $self->{type};
235             }
236 20 50       53 croak "Invalid type '",$type,"' given (should be one of ",join(" ",keys %$TYPES),")" unless $TYPES->{$type};
237            
238             # Hash comes after type
239 20 50       41 if (!$self) {
240 20 50       39 if (ref($_[0]) eq "HASH") {
241 0         0 $self = $_[0];
242 0         0 $self->{type} = $type;
243             } else {
244             # Unnamed arguments
245 20         46 $self = {type => $type};
246              
247             # Options are given as last part
248 20         35 my $opts = $_[scalar(@_)-1];
249 20 100       41 if (ref($opts) eq "HASH") {
250 2         4 pop @_;
251 2         5 map { $self->{$_} = $opts->{$_} } keys %$opts;
  2         7  
252 2 50       6 if ($self->{method}) {
253             # Canonicalize and verify
254 2         5 method($self,$self->{method});
255             }
256             }
257 20 50       68 if ($type eq READ) {
    0          
    0          
    0          
    0          
    0          
258 20         35 $self->{mbean} = shift;
259 20         31 $self->{attribute} = shift;
260 20         27 $self->{path} = shift;
261             # Use post for complex read requests
262 20 100       53 if (ref($self->{attribute}) eq "ARRAY") {
263 2         5 my $method = method($self);
264 2 100 66     9 if (defined($method) && $method eq "GET") {
265             # Was already explicitely set
266 1         13 die "Cannot query for multiple attributes " . join(",",@{$self->{attributes}}) . " with a GET request"
267 1 50       5 if ref($self->{attribute}) eq "ARRAY";
268             }
269 1         3 method($self,"POST");
270             }
271             } elsif ($type eq WRITE) {
272 0         0 $self->{mbean} = shift;
273 0         0 $self->{attribute} = shift;
274 0         0 $self->{value} = shift;
275 0         0 $self->{path} = shift;
276             } elsif ($type eq EXEC) {
277 0         0 $self->{mbean} = shift;
278 0         0 $self->{operation} = shift;
279 0         0 $self->{arguments} = [ @_ ];
280             } elsif ($type eq LIST) {
281 0         0 $self->{path} = shift;
282             } elsif ($type eq SEARCH) {
283 0         0 $self->{mbean} = shift;
284             #No check here until now, is done on the server side as well.
285             #die "MBean name ",$self->{mbean}," is not a pattern" unless is_mbean_pattern($self);
286             } elsif ($type eq AGENT_VERSION) {
287             # No extra parameters required
288             } else {
289 0         0 croak "Type ",$type," not supported yet";
290             }
291             }
292             }
293 19   33     72 bless $self,(ref($class) || $class);
294 19         57 $self->_validate();
295 19         39 return $self;
296             }
297              
298             =item $req->method()
299              
300             =item $req->method("POST")
301              
302             Set the HTTP request method for this requst excplicitely. If not provided
303             either during construction time (config key 'method') a prefered request
304             method is determined dynamically based on the request contents.
305              
306             =cut
307              
308             sub method {
309 8     8 1 20 my $self = shift;
310 8         12 my $value = shift;
311 8 100       18 if (defined($value)) {
312 3 50 33     26 die "Unknown request method ",$value if length($value) && uc($value) !~ /^(POST|GET)$/i;
313 3         6 $self->{method} = uc($value);
314             }
315 8 100       28 return defined($self->{method}) ? $self->{method} : undef;
316             }
317              
318             =item $req->is_mbean_pattern
319              
320             Returns true, if the MBean name used in this request is a MBean pattern (which
321             can be used in C or for C) or not
322              
323             =cut
324              
325             sub is_mbean_pattern {
326 16     16 1 52 my $self = shift;
327 16   33     43 my $mbean = shift || $self->{mbean};
328 16 50       27 return 1 unless $mbean;
329 16         42 my ($domain,$rest) = split(/:/,$mbean,2);
330 16 100       49 return 1 if $domain =~ /[*?]/;
331 12 100       34 return 1 if $rest =~ /\*$/;
332              
333 9         18 while ($rest) {
334             #print "R: $rest\n";
335 12         47 $rest =~ s/([^=]+)\s*=\s*//;
336 12         23 my $key = $1;
337 12         12 my $value;
338 12 100       25 if ($rest =~ /^"/) {
339 6         43 $rest =~ s/("(\\"|[^"])+")(\s*,\s*|$)//;
340 6         11 $value = $1;
341             # Pattern in quoted values must not be preceded by a \
342 6 100       29 return 1 if $value =~ /(?
343             } else {
344 6         18 $rest =~ s/([^,]+)(\s*,\s*|$)//;
345 6         10 $value = $1;
346 6 100       27 return 1 if $value =~ /[\*\?]/;
347             }
348             #print "K: $key V: $value\n";
349             }
350 5         12 return 0;
351             }
352              
353             =item $request->get("type")
354              
355             Get a request parameter
356              
357             =cut
358              
359             sub get {
360 0     0 1 0 my $self = shift;
361 0         0 my $name = shift;
362 0         0 return $self->{$name};
363             }
364              
365             # Internal check for validating that all arguments are given
366             sub _validate {
367 19     19   25 my $self = shift;
368 19 50 33     60 if ($self->{type} eq READ || $self->{type} eq WRITE) {
369 19 50       36 die $self->{type} . ": No mbean name given\n",Dumper($self) unless $self->{mbean};
370 19 0 33     41 die $self->{type} . ": No attribute name but path is given\n" if (!$self->{attribute} && $self->{path});
371             }
372 19 50       38 if ($self->{type} eq WRITE) {
373 0 0       0 die $self->{type} . ": No value given\n" unless defined($self->{value});
374             }
375 19 50       50 if ($self->{type} eq EXEC) {
376 0 0         die $self->{type} . ": No mbean name given\n" unless $self->{mbean};
377 0 0         die $self->{type} . ": No operation name given\n" unless $self->{operation};
378             }
379             }
380              
381             # Called for post requests
382             sub TO_JSON {
383 0     0 0   my $self = shift;
384             my $ret = {
385 0 0         type => $self->{type} ? uc($self->{type}) : undef,
386             };
387 0           for my $k (qw(mbean attribute path value operation arguments target)) {
388 0 0         $ret->{$k} = $self->{$k} if defined($self->{$k});
389             }
390 0           my %config;
391 0           for my $k (qw(maxDepth maxObjects maxCollectionSize ignoreErrors)) {
392 0 0         $config{$k} = $self->{$k} if defined($self->{$k});
393             }
394 0 0         $ret->{config} = \%config if keys(%config);
395 0           return $ret;
396             }
397              
398             =back
399              
400             =head1 LICENSE
401              
402             This file is part of jmx4perl.
403              
404             Jmx4perl is free software: you can redistribute it and/or modify
405             it under the terms of the GNU General Public License as published by
406             the Free Software Foundation, either version 2 of the License, or
407             (at your option) any later version.
408              
409             jmx4perl is distributed in the hope that it will be useful,
410             but WITHOUT ANY WARRANTY; without even the implied warranty of
411             MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
412             GNU General Public License for more details.
413              
414             You should have received a copy of the GNU General Public License
415             along with jmx4perl. If not, see .
416              
417             A commercial license is available as well. Please contact roland@cpan.org for
418             further details.
419              
420             =head1 AUTHOR
421              
422             roland@cpan.org
423              
424             =cut
425              
426             1;