File Coverage

blib/lib/Monitoring/Plugin/Getopt.pm
Criterion Covered Total %
statement 222 226 98.2
branch 78 88 88.6
condition 31 47 65.9
subroutine 31 31 100.0
pod 1 3 33.3
total 363 395 91.9


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