File Coverage

blib/lib/Monitoring/Plugin/Getopt.pm
Criterion Covered Total %
statement 224 228 98.2
branch 81 92 88.0
condition 31 47 65.9
subroutine 31 31 100.0
pod 1 3 33.3
total 368 401 91.7


line stmt bran cond sub pod time code
1             package Monitoring::Plugin::Getopt;
2              
3             #
4             # Monitoring::Plugin::Getopt - OO perl module providing standardised argument
5             # processing for nagios plugins
6             #
7              
8 6     6   220890 use 5.006;
  6         52  
9 6     6   27 use strict;
  6         10  
  6         119  
10 6     6   24 use warnings;
  6         8  
  6         150  
11              
12 6     6   28 use File::Basename;
  6         19  
  6         416  
13 6     6   3352 use Getopt::Long qw(:config no_ignore_case bundling);
  6         54832  
  6         21  
14 6     6   921 use Carp;
  6         10  
  6         328  
15 6     6   1519 use Params::Validate qw(:all);
  6         27227  
  6         748  
16 6     6   32 use base qw(Class::Accessor);
  6         8  
  6         1754  
17              
18 6     6   6851 use Monitoring::Plugin::Functions;
  6         12  
  6         354  
19 6     6   2136 use Monitoring::Plugin::Config;
  6         15  
  6         154  
20 6     6   32 use vars qw($VERSION);
  6         9  
  6         12985  
21             $VERSION = $Monitoring::Plugin::Functions::VERSION;
22              
23             # Standard defaults
24             my %DEFAULT = (
25             timeout => 15,
26             verbose => 0,
27             license =>
28             "This nagios plugin is free software, and comes with ABSOLUTELY NO WARRANTY.
29             It may be used, redistributed and/or modified under the terms of the GNU
30             General Public Licence (see http://www.fsf.org/licensing/licenses/gpl.txt).",
31             );
32             # Standard arguments
33             my @ARGS = ({
34             spec => 'usage|?',
35             help => "-?, --usage\n Print usage information",
36             }, {
37             spec => 'help|h',
38             help => "-h, --help\n Print detailed help screen",
39             }, {
40             spec => 'version|V',
41             help => "-V, --version\n Print version information",
42             }, {
43             spec => 'extra-opts:s@',
44             help => "--extra-opts=[section][\@file]\n Read options from an ini file. See https://www.monitoring-plugins.org/doc/extra-opts.html\n for usage and examples.",
45             }, {
46             spec => 'timeout|t=i',
47             help => "-t, --timeout=INTEGER\n Seconds before plugin times out (default: %s)",
48             default => $DEFAULT{timeout},
49             }, {
50             spec => 'verbose|v+',
51             help => "-v, --verbose\n Show details for command-line debugging (can repeat up to 3 times)",
52             default => $DEFAULT{verbose},
53             },
54             );
55             # Standard arguments we traditionally display last in the help output
56             my %DEFER_ARGS = map { $_ => 1 } qw(timeout verbose);
57              
58             # -------------------------------------------------------------------------
59             # Private methods
60              
61             sub _die
62             {
63 14     14   46 my $self = shift;
64 14         25 my ($msg) = @_;
65 14 100       43 $msg .= "\n" unless substr($msg, -1) eq "\n";
66 14         45 Monitoring::Plugin::Functions::_plugin_exit(3, $msg);
67             }
68              
69             # Return the given attribute, if set, including a final newline
70             sub _attr
71             {
72 24     24   28 my $self = shift;
73 24         52 my ($item, $extra) = @_;
74 24 100       40 $extra = '' unless defined $extra;
75 24 100       48 return '' unless $self->{_attr}->{$item};
76 19         56 $self->{_attr}->{$item} . "\n" . $extra;
77             }
78              
79             # Turn argument spec into help-style output
80             sub _spec_to_help
81             {
82 38     38   53 my ($self, $spec, $label) = @_;
83              
84 38         114 my ($opts, $type) = split /=|:|!/, $spec, 2;
85 38         57 my $optional = ($spec =~ m/:/);
86 38         49 my $boolean = ($spec =~ m/!/);
87 38         38 my (@short, @long);
88 38         60 for (split /\|/, $opts) {
89 64 100       77 if (length $_ == 1) {
90 24         38 push @short, "-$_";
91             } else {
92 40 100       81 push @long, $boolean ? "--[no-]$_" : "--$_";
93             }
94             }
95              
96 38         58 my $help = join(', ', @short, @long);
97 38 100       51 if ($type) {
    50          
98 32 100       42 if (!$label) {
99 22 100 100     61 if ($type eq 'i' || $type eq '+' || $type =~ /\d+/) {
      100        
100 14         17 $label = 'INTEGER';
101             }
102             else {
103 8         10 $label = 'STRING';
104             }
105             }
106              
107 32 100       41 if ($optional) {
108 8         12 $help .= '[=' . $label . ']';
109             }
110             else {
111 24         31 $help .= '=' . $label;
112             }
113             }
114             elsif ($label) {
115 0         0 carp "Label specified, but there's no type in spec '$spec'";
116             }
117 38         41 $help .= "\n ";
118 38         90 return $help;
119             }
120              
121             # Options output for plugin -h
122             sub _options
123             {
124 8     8   13 my $self = shift;
125              
126 8         12 my @args = ();
127 8         8 my @defer = ();
128 8         11 for (@{$self->{_args}}) {
  8         20  
129 84 100       109 if (exists $DEFER_ARGS{$_->{name}}) {
130 16         20 push @defer, $_;
131             } else {
132 68         76 push @args, $_;
133             }
134             }
135              
136 8         12 my @options = ();
137 8         11 for my $arg (@args, @defer) {
138 84 100 66     179 my $help_array = ref $arg->{help} && ref $arg->{help} eq 'ARRAY' ? $arg->{help} : [ $arg->{help} ];
139 84 100 66     189 my $label_array = $arg->{label} && ref $arg->{label} && ref $arg->{label} eq 'ARRAY' ? $arg->{label} : [ $arg->{label} ];
140 84         85 my $help_string = '';
141 84         120 for (my $i = 0; $i <= $#$help_array; $i++) {
142 90         96 my $help = $help_array->[$i];
143             # Add spec arguments to help if not already there
144 90 100       163 if ($help =~ m/^\s*-/) {
145 52         111 $help_string .= $help;
146             }
147             else {
148 38         57 $help_string .= $self->_spec_to_help($arg->{spec}, $label_array->[$i]) . $help;
149 38 100       85 $help_string .= "\n " if $i < $#$help_array;
150             }
151             }
152              
153             # Add help_string to @options
154 84 100       129 if ($help_string =~ m/%s/) {
155 12 50       21 my $default = defined $arg->{default} ? $arg->{default} : '';
156             # We only handle '%s' formats here
157 12         13 my $replaced = $help_string;
158 12         28 $replaced =~ s|%s|$default|gmx;
159 12         24 push @options, $replaced;
160             } else {
161 72         127 push @options, $help_string;
162             }
163             }
164              
165 8         76 return ' ' . join("\n ", @options);
166             }
167              
168             # Output for plugin -? (or missing/invalid args)
169             sub _usage {
170 12     12   15 my $self = shift;
171 12         19 my $usage = $self->_attr('usage');
172 12         51 $usage =~ s|%s|$self->{_attr}->{plugin}|gmx;
173 12         38 return($usage);
174             }
175              
176             # Output for plugin -V
177             sub _revision
178             {
179 6     6   10 my $self = shift;
180 6         27 my $revision = sprintf "%s %s", $self->{_attr}->{plugin}, $self->{_attr}->{version};
181 6 100       22 $revision .= sprintf " [%s]", $self->{_attr}->{url} if $self->{_attr}->{url};
182 6         11 $revision .= "\n";
183 6         15 $revision;
184             }
185              
186             # Output for plugin -h
187             sub _help
188             {
189 4     4   7 my $self = shift;
190 4         7 my $help = '';
191 4         11 $help .= $self->_revision . "\n";
192 4         14 $help .= $self->_attr('license', "\n");
193 4         9 $help .= $self->_attr('blurb', "\n");
194 4 50       33 $help .= $self->_usage ? $self->_usage . "\n" : '';
195 4 50       12 $help .= $self->_options ? $self->_options . "\n" : '';
196 4         17 $help .= $self->_attr('extra', "\n");
197 4         14 return $help;
198             }
199              
200             # Return a Getopt::Long-compatible option array from the current set of specs
201             sub _process_specs_getopt_long
202             {
203 36     36   44 my $self = shift;
204              
205 36         47 my @opts = ();
206 36         39 for my $arg (@{$self->{_args}}) {
  36         62  
207 429         544 push @opts, $arg->{spec};
208             # Setup names and defaults
209 429         474 my $spec = $arg->{spec};
210             # Use first arg as name (like Getopt::Long does)
211 429         847 $spec =~ s/[=:!].*$//;
212 429         926 my $name = (split /\s*\|\s*/, $spec)[0];
213 429         556 $arg->{name} = $name;
214 429 100       573 if (defined $self->{$name}) {
215 36         60 $arg->{default} = $self->{$name};
216             } else {
217 393         631 $self->{$name} = $arg->{default};
218             }
219             }
220              
221 36         113 return @opts;
222             }
223              
224             # Check for existence of required arguments
225             sub _check_required_opts
226             {
227 25     25   44 my $self = shift;
228              
229 25         34 my @missing = ();
230 25         28 for my $arg (@{$self->{_args}}) {
  25         75  
231 303 100 100     481 if ($arg->{required} && ! defined $self->{$arg->{name}}) {
232 2         3 push @missing, $arg->{name};
233             }
234             }
235 25 100       65 if (@missing) {
236             $self->_die($self->_usage . "\n" .
237 2         4 join("\n", map { sprintf "Missing argument: %s", $_ } @missing) . "\n");
  2         16  
238             }
239             }
240              
241             # Process and handle any immediate options
242             sub _process_opts
243             {
244 33     33   42 my $self = shift;
245              
246             # Print message and exit for usage, version, help
247 33 100       96 $self->_die($self->_usage) if $self->{usage};
248 31 100       57 $self->_die($self->_revision) if $self->{version};
249 29 100       70 $self->_die($self->_help) if $self->{help};
250             }
251              
252             # -------------------------------------------------------------------------
253             # Default opts methods
254              
255             sub _load_config_section
256             {
257 15     15   37 my $self = shift;
258 15         22 my ($section, $file, $flags) = @_;
259 15   33     24 $section ||= $self->{_attr}->{plugin};
260              
261 15         13 my $Config;
262 15         33 eval { $Config = Monitoring::Plugin::Config->read($file); };
  15         63  
263 15 50       24 $self->_die($@) if ($@);
264 15 50       23 defined $Config
265             or $self->_die(Monitoring::Plugin::Config->errstr);
266              
267             # TODO: is this check sane? Does --extra-opts=foo require a [foo] section?
268             ## Nevertheless, if we die as UNKNOWN here we should do the same on default
269             ## file *added eval/_die above*.
270 15   33     47 $file ||= $Config->mp_getfile();
271             $self->_die("Invalid section '$section' in config file '$file'")
272 15 100       35 unless exists $Config->{$section};
273              
274 12         83 return $Config->{$section};
275             }
276              
277             # Helper method to setup a hash of spec definitions for _cmdline
278             sub _setup_spec_index
279             {
280 25     25   38 my $self = shift;
281 25 100       40 return if defined $self->{_spec};
282 13         13 $self->{_spec} = { map { $_->{name} => $_->{spec} } @{$self->{_args}} };
  208         346  
  13         27  
283             }
284              
285             # Quote values that require it
286             sub _cmdline_value
287             {
288 65     65   65 my $self = shift;
289 65         76 local $_ = shift;
290 65 50 33     152 if (m/\s/ && (m/^[^"']/ || m/[^"']$/)) {
    100 66        
291 0         0 return qq("$_");
292             }
293             elsif ($_ eq '') {
294 1         2 return q("");
295             }
296             else {
297 64         97 return $_;
298             }
299             }
300              
301             # Helper method to format key/values in $hash in a quasi-commandline format
302             sub _cmdline
303             {
304 25     25   183 my $self = shift;
305 25         44 my ($hash) = @_;
306 25   66     62 $hash ||= $self;
307              
308 25         45 $self->_setup_spec_index;
309              
310 25         44 my @args = ();
311 25         118 for my $key (sort keys %$hash) {
312             # Skip internal keys
313 268 100       381 next if $key =~ m/^_/;
314              
315             # Skip defaults and internals
316 229 100 66     363 next if exists $DEFAULT{$key} && $hash->{$key} eq $DEFAULT{$key};
317 203 100       218 next if grep { $key eq $_ } qw(help usage version extra-opts);
  812         1004  
318 151 100       222 next unless defined $hash->{$key};
319              
320             # Render arg
321 49   50     83 my $spec = $self->{_spec}->{$key} || '';
322 49 100       128 if ($spec =~ m/[=:].+$/) {
323             # Arg takes value - may be a scalar or an arrayref
324 47 100       77 for my $value (ref $hash->{$key} eq 'ARRAY' ? @{$hash->{$key}} : ( $hash->{$key} )) {
  30         47  
325 65         92 $value = $self->_cmdline_value($value);
326 65 100       90 if (length($key) > 1) {
327 33         94 push @args, sprintf "--%s=%s", $key, $value;
328             }
329             else {
330 32         60 push @args, "-$key", $value;
331             }
332             }
333             }
334              
335             else {
336             # Flag - render long or short based on option length
337 2 50       5 push @args, (length($key) > 1 ? '--' : '-') . $key;
338             }
339             }
340              
341 25 100       121 return wantarray ? @args : join(' ', @args);
342             }
343              
344             # Process and load extra-opts sections
345             sub _process_extra_opts
346             {
347 36     36   49 my $self = shift;
348 36         48 my ($args) = @_;
349              
350 36         47 my $extopts_list = $args->{'extra-opts'};
351              
352 36         43 my @sargs = ();
353 36         71 for my $extopts (@$extopts_list) {
354 15   66     38 $extopts ||= $self->{_attr}->{plugin};
355 15         18 my $section = $extopts;
356 15         16 my $file = '';
357              
358             # Parse section@file
359 15 50       29 if ($extopts =~ m/^([^@]*)@(.*?)\s*$/) {
360 0         0 $section = $1;
361 0         0 $file = $2;
362             }
363              
364             # Load section args
365 15         26 my $shash = $self->_load_config_section($section, $file);
366              
367             # Turn $shash into a series of commandline-like arguments
368 12         27 push @sargs, $self->_cmdline($shash);
369             }
370              
371             # Reset ARGV to extra-opts + original
372 33         45 @ARGV = ( @sargs, @{$self->{_attr}->{argv}} );
  33         78  
373              
374             printf "[extra-opts] %s %s\n", $self->{_attr}->{plugin}, join(' ', @ARGV)
375 33 100 100     178 if $args->{verbose} && $args->{verbose} >= 3;
376             }
377              
378             # -------------------------------------------------------------------------
379             # Public methods
380              
381             # Define plugin argument
382             sub arg
383             {
384 213     213 0 3808 my $self = shift;
385 213         210 my %args;
386              
387             # Param name to required boolean
388 213         358 my %params = (
389             spec => 1,
390             help => 1,
391             default => 0,
392             required => 0,
393             label => 0,
394             );
395              
396             # Named args
397 213 100 66     548 if (exists $params{$_[0]} && @_ % 2 == 0) {
398 195         1513 %args = validate( @_, \%params );
399             }
400              
401             # Positional args
402             else {
403 18         33 my @order = qw(spec help default required label);
404 18         159 @args{@order} = validate_pos(@_, @params{@order});
405             }
406              
407             # Add to private args arrayref
408 213         497 push @{$self->{_args}}, \%args;
  213         495  
409             }
410              
411             # Process the @ARGV array using the current _args list (possibly exiting)
412             sub getopts
413             {
414 36     36 0 3817 my $self = shift;
415              
416             # Collate spec arguments for Getopt::Long
417 36         73 my @opt_array = $self->_process_specs_getopt_long;
418              
419             # Capture original @ARGV (for extra-opts games)
420 36         89 $self->{_attr}->{argv} = [ @ARGV ];
421              
422             # Call GetOptions using @opt_array
423 36         56 my $args1 = {};
424 36         99 my $ok = GetOptions($args1, @opt_array);
425             # Invalid options - give usage message and exit
426 36 50       24910 $self->_die($self->_usage) unless $ok;
427              
428             # Process extra-opts
429 36         96 $self->_process_extra_opts($args1);
430              
431             # Call GetOptions again, this time including extra-opts
432 33         122 $ok = GetOptions($self, @opt_array);
433             # Invalid options - give usage message and exit
434 33 50       23309 $self->_die($self->_usage) unless $ok;
435              
436             # Process immediate options (possibly exiting)
437 33         83 $self->_process_opts;
438              
439             # Required options (possibly exiting)
440 25         61 $self->_check_required_opts;
441              
442             # Setup accessors for options
443 23         223 $self->mk_ro_accessors(grep ! /^_/, keys %$self);
444              
445             # Setup default alarm handler for alarm($ng->timeout) in plugin
446             $SIG{ALRM} = sub {
447 1     1   2000532 my $plugin = uc $self->{_attr}->{plugin};
448 1         7 $plugin =~ s/^CHECK[-_]//i;
449 1         10 $self->_die(
450             sprintf("%s UNKNOWN - plugin timed out (timeout %ss)",
451             $plugin, $self->timeout));
452 23         7563 };
453             }
454              
455             # -------------------------------------------------------------------------
456             # Constructor
457              
458             sub _init
459             {
460 36     36   45 my $self = shift;
461              
462             # Check params
463 36   33     1122 my $plugin = basename($ENV{PLUGIN_NAME} || $ENV{NAGIOS_PLUGIN} || $0);
464             my %attr = validate( @_, {
465             usage => 1,
466             version => 0,
467             url => 0,
468             plugin => { default => $plugin },
469             blurb => 0,
470             extra => 0,
471             'extra-opts' => 0,
472             license => { default => $DEFAULT{license} },
473             timeout => { default => $DEFAULT{timeout} },
474 36         905 });
475              
476             # Add attr to private _attr hash (except timeout)
477 36         244 $self->{timeout} = delete $attr{timeout};
478 36         111 $self->{_attr} = { %attr };
479             # Chomp _attr values
480 36         58 chomp foreach values %{$self->{_attr}};
  36         129  
481              
482             # Setup initial args list
483 36         89 $self->{_args} = [ @ARGS ];
484              
485 36         121 $self
486             }
487              
488             sub new
489             {
490 36     36 1 16938 my $class = shift;
491 36         73 my $self = bless {}, $class;
492 36         84 $self->_init(@_);
493             }
494              
495             # -------------------------------------------------------------------------
496              
497             1;
498              
499             __END__