1package JMX::Jmx4Perl::Nagios::SingleCheck;
2
3use strict;
4use warnings;
5use JMX::Jmx4Perl;
6use JMX::Jmx4Perl::Request;
7use JMX::Jmx4Perl::Response;
8use JMX::Jmx4Perl::Alias;
9use Data::Dumper;
10use Nagios::Plugin;
11use Nagios::Plugin::Functions qw(:codes %STATUS_TEXT);
12use Carp;
13use Scalar::Util qw(looks_like_number);
14use URI::Escape;
15use Text::ParseWords;
16use JSON;
17
18our $AUTOLOAD;
19
20=head1 NAME
21
22JMX::Jmx4Perl::Nagios::SingleCheck - A single nagios check
23
24This is an package used internally by
25L<JMX::Jmx4Perl::Nagios::CheckJmx4Perl>. It encapsulates the configuration for
26single checks, which can be combined to a bulk JMX-Request so only a single
27server turnaround is used to obtain multiple checks results at once.
28
29=head1 METHODS
30
31=over
32
33=item $single_check = new $JMX::Jmx4Perl::Nagios::SingleCheck($nagios_plugin,$check_config)
34
35Construct a new single check from a given L<Nagios::Plugin> object
36C<$nagios_plugin> and a parsed check configuration $check_config, which is a
37hash.
38
39=cut
40
41sub new {
42    my $class = shift;
43    my $np = shift || die "No Nagios Plugin given";
44    my $config = shift;
45    my $self = {
46                np => $np,
47                config => $config
48               };
49    bless $self,(ref($class) || $class);
50    return $self;
51}
52
53=item $requests = $single_check->get_requests($jmx,$args)
54
55Called to obtain an arrayref of L<JMX::Jmx4Perl::Request> objects which should
56be send to the server agent. C<$jmx> ist the L<JMX::Jmx4Perl> agent, C<$args>
57are additonal arguments used for exec-operations,
58
59Multiple request object are returned e.g. if a relative check has to be
60performed in order to get the base value as well.
61
62The returned array can contain coderefs which should be executed directly and
63its return value should be used in order to perfoorm the check.
64
65=cut
66
67sub get_requests {
68    my $self = shift;
69    my $jmx = shift;
70    my $args = shift;
71    # If a script is given, extract a subref and return it
72    return [ $self->_extract_script_as_subref($jmx) ] if $self->script;
73
74    my $do_read = $self->attribute || $self->value;
75    my $do_exec = $self->operation;
76    if ($self->alias) {
77        my $alias = JMX::Jmx4Perl::Alias->by_name($self->alias);
78        die "No alias '",$self->alias," known" unless $alias;
79        $do_read = $alias->type eq "attribute";
80    }
81    my @requests = ();
82    my $request;
83    if ($do_read) {
84        $request = JMX::Jmx4Perl::Request->new(READ,$self->_prepare_read_args($jmx));
85    } elsif ($do_exec) {
86        $request = JMX::Jmx4Perl::Request->new(EXEC,$self->_prepare_exec_args($jmx,@$args));
87    } else {
88        die "Neither an attribute/value, an operation or a script given";
89    }
90    my $method = $self->{np}->opts->{method} || $self->{config}->{method};
91    if ($method) {
92        $request->method($method);
93    }
94    push @requests,$request;
95
96    if ($self->base || $self->base_mbean) {
97        if (!looks_like_number($self->base)) {
98            # It looks like a number, so we will use the base literally
99            my $alias;
100
101            if ($self->base) {
102                $alias = JMX::Jmx4Perl::Alias->by_name($self->base);
103            }
104            if ($alias) {
105                push @requests,new JMX::Jmx4Perl::Request(READ,$jmx->resolve_alias($self->base));
106            } else {
107                my ($mbean,$attr,$path) = $self->base_mbean ?
108                  ($self->base_mbean, $self->base_attribute, $self->base_path) :
109                    $self->_split_attr_spec($self->base);
110                die "No MBean given in base name ",$self->base unless $mbean;
111                die "No Attribute given in base name ",$self->base unless $attr;
112
113                $mbean = URI::Escape::uri_unescape($mbean);
114                $attr = URI::Escape::uri_unescape($attr);
115                $path = URI::Escape::uri_unescape($path) if $path;
116                push @requests,new JMX::Jmx4Perl::Request(READ,$mbean,$attr,$path);
117            }
118        }
119    }
120
121    return \@requests;
122}
123
124# Create a subref where all params from the outside are available as closures.
125sub _extract_script_as_subref {
126    my $self = shift;
127    my $jmx = shift;
128    my $script = $self->script || die "No script given";
129    my $full_script = <<"EOT";
130sub {
131  my \$j4p = shift;
132  return sub {
133     $script
134  }
135}
136EOT
137    #print $full_script,"\n";
138    my $sub = eval $full_script;
139    die "Cannot eval script for check ",$self->name,": $@" if $@;
140    return &$sub($jmx);
141}
142
143=item $single_check->exract_responses($responses,$requests,$target)
144
145Extract L<JMX::Jmx4Perl::Response> objects and add the deducted results to
146the nagios plugin (which was given at construction time).
147
148C<$responses> is an arrayref to the returned responses, C<$requests> is an
149arrayref to the original requests. Any response consumed from C<$requests>
150should be removed from the array, as well as the corresponding request.
151The requests/responses for this single request are always a the beginning of
152the arrays.
153
154C<$target> is an optional target configuration if the request was used in
155target proxy mode.
156
157=cut
158
159sub extract_responses {
160    my $self = shift;
161    my $responses = shift;
162    my $requests = shift;
163    my $opts = shift || {};
164    my $np = $self->{np};
165    my $msg_handler = $np->{msg_handler} || $np;
166
167    # Get response/request pair
168    my $resp = shift @{$responses};
169    my $request = shift @{$requests};
170    #print Dumper($resp);
171    my @extra_requests = ();
172    my $value;
173    my $script_mode = undef;
174    if (ref($request) eq "CODE") {
175        # It's a script, so the 'response' is already the value
176        $script_mode = 1;
177        $value = $resp;
178    } else {
179        $self->_verify_response($request,$resp);
180        $value = $self->_extract_value($request,$resp);
181    }
182
183    # Delta handling
184    my $delta = $self->delta;
185    if (defined($delta) && !$script_mode) {
186        $value = $self->_delta_value($request,$resp,$delta);
187        unless (defined($value)) {
188            push @extra_requests,$self->_switch_on_history($request,$opts->{target});
189            $value = 0;
190        }
191    }
192
193    # Normalize value
194    my ($value_conv,$unit) = $self->_normalize_value($value);
195    my $label = $self->_get_name(cleanup => 1);
196    if ( ($self->base || $self->base_mbean) && !$script_mode) {
197        # Calc relative value
198        my $base_value = $self->_base_value($self->base,$responses,$requests);
199        my $rel_value = sprintf "%2.2f",$base_value ? (int((($value / $base_value) * 10000) + 0.5) / 100) : 0;
200
201        # Performance data. Convert to absolute values before
202        if ($self->_include_perf_data) {
203            if ($self->perfdata && $self->perfdata =~ /^\s*\%\s*/) {
204                $np->add_perfdata(label => $label, value => $rel_value, uom => '%',
205                                  critical => $self->critical, warning => $self->warning);
206            } else {
207                my ($critical,$warning) = $self->_convert_relative_to_absolute($base_value,$self->critical,$self->warning);
208                $np->add_perfdata(label => $label,value => $value,
209                                  critical => $critical,warning => $warning,
210                                  min => 0,max => $base_value,
211                                  $self->unit ? (uom => $self->unit) : ());
212            }
213        }
214        # Do the real check.
215        my ($code,$mode) = $self->_check_threshold($rel_value);
216        # For Multichecks, we remember the label of a currently failed check
217        $self->update_error_stats($opts->{error_stat},$code) unless $code == OK;
218        my ($base_conv,$base_unit) = $self->_normalize_value($base_value);
219        $msg_handler->add_message($code,$self->_exit_message(code => $code,mode => $mode,rel_value => $rel_value,
220                                                    value => $value_conv, unit => $unit, base => $base_conv,
221                                                    base_unit => $base_unit, prefix => $opts->{prefix}));
222    } else {
223        # Performance data
224        $value = $self->_sanitize_value($value);
225        if ($self->_include_perf_data) {
226            $np->add_perfdata(label => $label,
227                              critical => $self->critical, warning => $self->warning,
228                              value => $value,$self->unit ? (uom => $self->unit) : ());
229        }
230
231        # Do the real check.
232        my ($code,$mode) = $self->_check_threshold($value);
233        $self->update_error_stats($opts->{error_stat},$code) unless $code == OK;
234        $msg_handler->add_message($code,$self->_exit_message(code => $code,mode => $mode,value => $value_conv, unit => $unit,
235                                                             prefix => $opts->{prefix}));
236    }
237    return @extra_requests;
238}
239
240sub _include_perf_data {
241    my $self = shift;
242    # No perf dara for string based checks by default
243    my $default = not defined($self->string);
244    # If 'PerfData' is set explicitely to false/off/no/0 then no perfdata
245    # will be included
246    return $default unless defined($self->perfdata);
247    return $self->perfdata !~ /^\s*(false|off|no|0)\s*$/i;
248}
249
250sub update_error_stats {
251    my $self = shift;
252    my $error_stat = shift || return;
253    my $code = shift;
254
255    my $label = $self->{config}->{name} || $self->{config}->{key};
256    if ($label) {
257        my $arr = $error_stat->{$code} || [];
258        push @$arr,$label;
259        $error_stat->{$code} = $arr;
260    }
261}
262
263# Extract a single value, which is different, if the request was a pattern read
264# request
265sub _extract_value {
266    my $self = shift;
267    my $req = shift;
268    my $resp = shift;
269    if ($req->get('type') eq READ && $req->is_mbean_pattern) {
270        return $self->_extract_value_from_pattern_request($resp->value);
271    } else {
272        return $self->_null_safe_value($resp->value);
273    }
274}
275
276sub _null_safe_value {
277    my $self = shift;
278    my $value = shift;
279    if (defined($value)) {
280        if (JSON::is_bool($value)) {
281            return "$value";
282        } elsif (ref($value) && $self->string) {
283            # We can deal with complex values withing string comparison
284            if (ref($value) eq "ARRAY") {
285                return join ",",@{$value};
286            } else {
287                return Dumper($value);
288            }
289        } else {
290            return $value;
291        }
292    } else {
293        # Our null value
294        return defined($self->null) ? $self->null : "null";
295    }
296}
297
298sub _extract_value_from_pattern_request {
299    my $self = shift;
300    my $val = shift;
301    my $np = $self->{np};
302    $self->_die("Pattern request does not result in a proper return format: " . Dumper($val))
303      if (ref($val) ne "HASH");
304    $self->_die("More than one MBean found for a pattern request: " . Dumper([keys %$val])) if keys %$val != 1;
305    my $attr_val = (values(%$val))[0];
306    $self->_die("Invalid response for pattern match: " . Dumper($attr_val)) unless ref($attr_val) eq "HASH";
307    $self->_die("Only a single attribute can be used. Given: " . Dumper([keys %$attr_val])) if keys %$attr_val != 1;
308    return $self->_null_safe_value((values(%$attr_val))[0]);
309}
310
311sub _delta_value {
312    my ($self,$req,$resp,$delta) = @_;
313
314    my $history = $resp->history;
315    if (!$history) {
316        # No delta on the first run
317        return undef;
318    } else {
319        my $hist_val;
320        if ($req->is_mbean_pattern) {
321            $hist_val = $self->_extract_value_from_pattern_request($history);
322        } else {
323            $hist_val = $history;
324        }
325        if (!@$hist_val) {
326            # Can happen in some scenarios when requesting the first history entry,
327            # we return 0 here
328            return 0;
329        }
330        my $old_value = $hist_val->[0]->{value};
331        my $old_time = $hist_val->[0]->{timestamp};
332        my $value = $self->_extract_value($req,$resp);
333        if ($delta) {
334            # Time average
335            my $time_delta = $resp->timestamp - $old_time;
336            return (($value - $old_value) / ($time_delta ? $time_delta : 1)) * $delta;
337        } else {
338            return $value - $old_value;
339        }
340    }
341}
342
343sub _switch_on_history {
344    my ($self,$orig_request,$target) = @_;
345    my ($mbean,$operation) = ("jolokia:type=Config","setHistoryEntriesForAttribute");
346    # Set history to 1 (we need only the last)
347    return new JMX::Jmx4Perl::Request
348      (EXEC,$mbean,$operation,
349       $orig_request->get("mbean"),$orig_request->get("attribute"),$orig_request->get("path"),
350       $target ? $target->{url} : undef,1,{target => undef});
351}
352
353
354sub _base_value {
355    my $self = shift;
356    my $np = $self->{np};
357    my $name = shift;
358    my $responses = shift;
359    my $requests = shift;
360
361    if (looks_like_number($name)) {
362        # It looks like a number, so we suppose its the base value itself
363        return $name;
364    }
365    my $resp = shift @{$responses};
366    my $req = shift @{$requests};
367    $self->_die($resp->{error}) if $resp->{error};
368    #print Dumper($req,$resp);
369    return $self->_extract_value($req,$resp);
370}
371
372# Normalize value if a unit-of-measurement is given.
373
374# Units and how to convert from one level to the next
375my @UNITS = ([ qw(ns us ms s m h d) ],[qw(B KB MB GB TB)]);
376my %UNITS =
377  (
378   ns => 1,
379   us => 10**3,
380   ms => 10**3,
381   s => 10**3,
382   m => 60,
383   h => 60,
384   d => 24,
385
386   B => 1,
387   KB => 2**10,
388   MB => 2**10,
389   GB => 2**10,
390   TB => 2**10
391  );
392
393sub _normalize_value {
394    my $self = shift;
395    my $value = shift;
396    my $unit = shift || $self->unit || return ($value,undef);
397
398    for my $units (@UNITS) {
399        for my $i (0 .. $#{$units}) {
400            next unless $units->[$i] eq $unit;
401            my $ret = $value;
402            my $u = $unit;
403            if (abs($ret) > 1) {
404                # Go up the scale ...
405                return ($value,$unit) if $i == $#{$units};
406                for my $j ($i+1 .. $#{$units}) {
407                    if (abs($ret / $UNITS{$units->[$j]}) >= 1) {
408                        $ret /= $UNITS{$units->[$j]};
409                        $u = $units->[$j];
410                    } else {
411                        return ($ret,$u);
412                    }
413                }
414            } else {
415                # Go down the scale ...
416                return ($value,$unit) if $i == 0;
417                for my $j (reverse(0 .. $i-1)) {
418                    if ($ret < 1) {
419                        $ret *= $UNITS{$units->[$j+1]};
420                        $u = $units->[$j];
421                    } else {
422                        return ($ret,$u);
423                    }
424                }
425
426            }
427            return ($ret,$u);
428        }
429    }
430    die "Unknown unit '$unit' for value $value";
431}
432
433sub _sanitize_value {
434    my ($self,$value) = @_;
435    if ($value =~ /\de/i) {
436        $value = sprintf("%f", $value);
437    }
438    return $value;
439}
440
441sub _verify_response {
442    my ($self,$req,$resp) = @_;
443    my $np = $self->{np};
444    if ($resp->is_error) {
445        my $extra = "";
446        if ($np->opts->{verbose}) {
447            my $stacktrace = $resp->stacktrace;
448            $extra = ref($stacktrace) eq "ARRAY" ? join "\n",@$stacktrace : $stacktrace if $stacktrace;
449        }
450        $self->_die("Error: ".$resp->status." ".$resp->error_text.$extra);
451    }
452
453    if (!$req->is_mbean_pattern && (ref($resp->value) && !$self->string) && !JSON::is_bool($resp->value)) {
454        $self->_die("Response value is a " . ref($resp->value) .
455                        ", not a plain value. Did you forget a --path parameter ?". " Value: " .
456                        Dumper($resp->value));
457    }
458}
459
460sub _get_name {
461    my $self = shift;
462    my $args = { @_ };
463    my $name = $args->{name};
464    if (!$name) {
465        if ($self->name) {
466            $name = $self->name;
467        } else {
468            # Default name, tried to be generated from various parts
469            if ($self->alias) {
470                $name = "[".$self->alias.($self->path ? "," . $self->path : "") ."]";
471            } else {
472                my $val = $self->value;
473                if ($val) {
474                    $name = "[" . $val . "]";
475                } else {
476                    my $a_or_o = $self->attribute || $self->operation || "";
477                    my $p = $self->path ? "," . $self->path : "";
478                    $name = "[" . $self->mbean . "," . $a_or_o . $p . "]";
479                }
480            }
481        }
482    }
483    if ($args->{cleanup}) {
484        # Enable this when '=' gets forbidden
485        $name =~ s/=/#/g;
486    }
487    # Prepare label for usage with Nagios::Plugin, which will blindly
488    # add quotes if a space is contained in the label.
489    # We are doing the escape of quotes ourself here
490    $name =~ s/'/''/g;
491    return $name;
492}
493
494sub _prepare_read_args {
495    my $self = shift;
496    my $np = $self->{np};
497    my $jmx = shift;
498
499    if ($self->alias) {
500        my @req_args = $jmx->resolve_alias($self->alias);
501        $self->_die("Cannot resolve attribute alias ",$self->alias()) unless @req_args > 0;
502        if ($self->path) {
503            @req_args == 2 ? $req_args[2] = $self->path : $req_args[2] .= "/" . $self->path;
504        }
505        return @req_args;
506    } elsif ($self->value) {
507        return $self->_split_attr_spec($self->value);
508    } else {
509        return ($self->mbean,$self->attribute,$self->path);
510    }
511}
512
513sub _prepare_exec_args {
514    my $self = shift;
515    my $np = $self->{np};
516    my $jmx = shift;
517
518    # Merge CLI arguments and arguments from the configuration,
519    # with CLI arguments taking precedence
520    my @cli_args = @_;
521    my $config_args = $self->{config}->{argument};
522
523    $config_args = [ $config_args ] if defined($config_args) && !ref($config_args) eq "ARRAY";
524    my @args = ();
525    if ($config_args) {
526        my @c_args = (@$config_args);
527        while (@cli_args || @c_args) {
528            my $cli_arg = shift @cli_args;
529            my $config_arg = shift @c_args;
530            push @args, defined($cli_arg) ? $cli_arg : $config_arg;
531        }
532    } else {
533        @args = @cli_args;
534    }
535    if ($self->alias) {
536        my @req_args = $jmx->resolve_alias($self->alias);
537        $self->_die("Cannot resolve operation alias ",$self->alias()) unless @req_args >= 2;
538        return (@req_args,@args);
539    } else {
540        return ($self->mbean,$self->operation,@args);
541    }
542}
543
544sub _split_attr_spec {
545    my $self = shift;
546    my $name = shift;
547    my @ret = ();
548    # Text:ParseWords is used for split on "/" taking into account
549    # quoting and escaping
550    for my $p (parse_line("/",1,$name)) {
551        # We need to 'unescape' things ourselves
552        # since we want quotes to remain in the names (using '0'
553        # above would kill those quotes, too).
554        $p =~ s|\\(.)|$1|sg;
555        push @ret,$p;
556    }
557    return (shift(@ret),shift(@ret),@ret ? join("/",@ret) : undef);
558}
559
560sub _check_threshold {
561    my $self = shift;
562    my $value = shift;
563    my $np = $self->{np};
564    my $numeric_check;
565    if ($self->numeric || $self->string) {
566        $numeric_check = $self->numeric ? 1 : 0;
567    } else {
568        $numeric_check = looks_like_number($value);
569    }
570    if ($numeric_check) {
571        # Verify numeric thresholds
572        my @ths =
573          (
574           defined($self->critical) ? (critical => $self->critical) : (),
575           defined($self->warning) ? (warning => $self->warning) : ()
576          );
577        #print Dumper({check => $value,@ths});
578        return (@ths ? $np->check_threshold(check => $value,@ths) : OK,"numeric");
579    } else {
580        return
581          ($self->_check_string_threshold($value,CRITICAL,$self->critical) ||
582            $self->_check_string_threshold($value,WARNING,$self->warning) ||
583              OK,
584           $value =~ /^true|false$/i ? "boolean" : "string");
585    }
586}
587
588sub _check_string_threshold {
589    my $self = shift;
590    my ($value,$level,$check_value) = @_;
591    return undef unless $check_value;
592    if ($check_value =~ m|^\s*qr(.)(.*)\1\s*$|) {
593        return $value =~ m/$2/ ? $level : undef;
594    }
595    if ($check_value =~ s/^\!//) {
596        return $value ne $check_value ? $level : undef;
597    } else {
598        return $value eq $check_value ? $level : undef;
599    }
600}
601
602sub _convert_relative_to_absolute {
603    my $self = shift;
604    my ($base_value,@to_convert) = @_;
605    my @ret = ();
606    for my $v (@to_convert) {
607        $v =~ s|([\d\.]+)|($1 / 100) * $base_value|eg if $v;
608        push @ret,$v;
609    }
610    return @ret;
611}
612
613# Prepare an exit message depending on the result of
614# the check itself. Quite evolved, you can overwrite this always via '--label'.
615sub _exit_message {
616    my $self = shift;
617    my $args = { @_ };
618    # Custom label has precedence
619    return $self->_format_label($self->label,$args) if $self->label;
620
621    my $code = $args->{code};
622    my $mode = $args->{mode};
623    if ($code == CRITICAL || $code == WARNING) {
624        if ($self->base || $self->base_mbean) {
625            return $self->_format_label
626              ('%n : Threshold \'%t\' failed for value %.2r% ('. &_placeholder($args,"v") .' %u / '.
627               &_placeholder($args,"b") . ' %u)',$args);
628        } else {
629            if ($mode ne "numeric") {
630                return $self->_format_label('%n : \'%v\' matches threshold \'%t\'',$args);
631            } else {
632                return $self->_format_label
633                  ('%n : Threshold \'%t\' failed for value '.&_placeholder($args,"v").' %u',$args);
634            }
635        }
636    } else {
637        if ($self->base || $self->base_mbean) {
638            return $self->_format_label('%n : In range %.2r% ('. &_placeholder($args,"v") .' %u / '.
639                                        &_placeholder($args,"b") . ' %w)',$args);
640        } else {
641            if ($mode ne "numeric") {
642                return $self->_format_label('%n : \'%v\' as expected',$args);
643            } else {
644                return $self->_format_label('%n : Value '.&_placeholder($args,"v").' %u in range',$args);
645            }
646        }
647
648    }
649}
650
651sub _placeholder {
652    my ($args,$c) = @_;
653    my $val;
654    if ($c eq "v") {
655        $val = $args->{value};
656    } else {
657        $val = $args->{base};
658    }
659    return ($val =~ /\./ ? "%.2" : "%") . $c;
660}
661
662sub _format_label {
663    my $self = shift;
664    my $label = shift;
665    my $args = shift;
666    # %r : relative value (as percent)
667    # %q : relative value (as floating point)
668    # %v : value
669    # %f : value as floating point
670    # %u : unit
671    # %b : base value
672    # %w : base unit
673    # %t : threshold failed ("" for OK or UNKNOWN)
674    # %c : code ("OK", "WARNING", "CRITICAL", "UNKNOWN")
675    # %d : delta
676    #
677    my @parts = split /(\%[\w\.\-]*\w)/,$label;
678    my $ret = "";
679    foreach my $p (@parts) {
680        if ($p =~ /^(\%[\w\.\-]*)(\w)$/) {
681            my ($format,$what) = ($1,$2);
682            if ($what eq "r" || $what eq "q") {
683                my $val = $args->{rel_value} || 0;
684                $val = $what eq "r" ? $val : $val / 100;
685                $ret .= sprintf $format . "f",$val;
686            } elsif ($what eq "b") {
687                $ret .= sprintf $format . &_format_char($args->{base}),($args->{base} || 0);
688            } elsif ($what eq "u" || $what eq "w") {
689                $ret .= sprintf $format . "s",($what eq "u" ? $args->{unit} : $args->{base_unit}) || "";
690                $ret =~ s/\s$//;
691            } elsif ($what eq "f") {
692                $ret .= sprintf $format . "f",$args->{value};
693            } elsif ($what eq "v") {
694                $ret .= &_format_value($format,$args->{mode},$args->{value});
695            } elsif ($what eq "t") {
696                my $code = $args->{code};
697                my $val = $code == CRITICAL ? $self->critical : ($code == WARNING ? $self->warning : "");
698                $ret .= sprintf $format . "s",defined($val) ? $val : "";
699            } elsif ($what eq "c") {
700                $ret .= sprintf $format . "s",$STATUS_TEXT{$args->{code}};
701            } elsif ($what eq "n") {
702                $ret .= sprintf $format . "s",$self->_get_name();
703            } elsif ($what eq "d") {
704                $ret .= sprintf $format . "d",$self->delta;
705            } elsif ($what eq "y") {
706                $ret .= &_format_value($format,$args->{mode},$self->warning);
707            } elsif ($what eq "z") {
708                $ret .= &_format_value($format,$args->{mode},$self->critical);
709            }
710        } else {
711            $ret .= $p;
712        }
713    }
714    if ($args->{prefix}) {
715        my $prefix = $args->{prefix};
716        $prefix =~ s/\%c/$STATUS_TEXT{$args->{code}}/g;
717        return  $prefix . $ret;
718    } else {
719        return $ret;
720    }
721}
722
723sub _format_value {
724    my $format = shift;
725    my $mode = shift;
726    my $value = shift;
727    if ($mode ne "numeric") {
728        return sprintf $format . "s",$value;
729    } else {
730        return sprintf $format . &_format_char($value),$value;
731    }
732}
733sub _format_char {
734    my $val = shift;
735    $val =~ /\./ ? "f" : "d";
736}
737
738sub _die {
739    my $self = shift;
740    my $msg = join("",@_);
741    die $msg,"\n";
742}
743
744my $CHECK_CONFIG_KEYS = {
745                         "critical" => "critical",
746                         "warning" => "warning",
747                         "mbean" => "mbean",
748                         "attribute" => "attribute",
749                         "operation" => "operation",
750                         "alias" => "alias",
751                         "path" => "path",
752                         "delta" => "delta",
753                         "name" => "name",
754                         "base" => "base",
755                         "base-mbean" => "basembean",
756                         "base-attribute" => "baseattribute",
757                         "base-path" => "basepath",
758                         "unit" => "unit",
759                         "numeric" => "numeric",
760                         "string" => "string",
761                         "label" => "label",
762                         "perfdata" => "perfdata",
763                         "value" => "value",
764                         "null" => "null",
765                         "script" => "script"
766                        };
767
768
769# Get the proper configuration values
770
771sub AUTOLOAD {
772    my $self = shift;
773    my $np = $self->{np};
774    my $name = $AUTOLOAD;
775    $name =~ s/.*://;   # strip fully-qualified portion
776    $name =~ s/_/-/g;
777
778    if ($CHECK_CONFIG_KEYS->{$name}) {
779        return $np->opts->{$name} if defined($np->opts->{$name});
780        if ($self->{config}) {
781            return $self->{config}->{$CHECK_CONFIG_KEYS->{$name}};
782        } else {
783            return undef;
784        }
785    } else {
786        $self->_die("No config attribute \"" . $name . "\" known");
787    }
788}
789
790
791# To keep autoload happy
792sub DESTROY {
793
794}
795
796=back
797
798=head1 LICENSE
799
800This file is part of jmx4perl.
801
802Jmx4perl is free software: you can redistribute it and/or modify
803it under the terms of the GNU General Public License as published by
804the Free Software Foundation, either version 2 of the License, or
805(at your option) any later version.
806
807jmx4perl is distributed in the hope that it will be useful,
808but WITHOUT ANY WARRANTY; without even the implied warranty of
809MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
810GNU General Public License for more details.
811
812You should have received a copy of the GNU General Public License
813along with jmx4perl.  If not, see <http://www.gnu.org/licenses/>.
814
815=head1 AUTHOR
816
817roland@cpan.org
818
819=cut
820
8211;
822