Finished initial --extra-opts support; added Getopt spec-to-help and multiline help support.

git-svn-id: https://nagiosplug.svn.sourceforge.net/svnroot/nagiosplug/Nagios-Plugin/trunk@1643 f882894a-f735-0410-b71e-b25c423dba1c

3 files changed, 372 insertions, 71 deletions

diff --git a/lib/Nagios/Plugin/Config.pm b/lib/Nagios/Plugin/Config.pm
new file mode 100644
index 0000000..92193c2
--- /dev/null
+++ b/lib/Nagios/Plugin/Config.pm
@@ -0,0 +1,170 @@
+package Nagios::Plugin::Config;
+
+use strict;
+use Carp;
+use File::Spec;
+use base qw(Config::Tiny);
+
+my $FILENAME1 = 'plugins.ini';
+my $FILENAME2 = 'nagios-plugins.ini';
+
+# Config paths ending in nagios (search for $FILENAME1)
+my @NAGIOS_CONFIG_PATH = qw(/etc/nagios /usr/local/nagios/etc /usr/local/etc/nagios /etc/opt/nagios);
+# Config paths not ending in nagios (search for $FILENAME2)
+my @CONFIG_PATH = qw(/etc /usr/local/etc /etc/opt);
+
+# Override Config::Tiny::read to default the filename, if not given
+sub read
+{
+        my $class = shift;
+
+        unless ($_[0]) {
+                SEARCH: {
+                       if ($ENV{NAGIOS_CONFIG_PATH}) {
+                               for (split /:/, $ENV{NAGIOS_CONFIG_PATH}) {
+                                       my $file = File::Spec->catfile($_, $FILENAME1);
+                                       unshift(@_, $file), last SEARCH if -f $file;
+                                       $file = File::Spec->catfile($_, $FILENAME2);
+                                       unshift(@_, $file), last SEARCH if -f $file;
+                               }
+                       }
+                       for (@NAGIOS_CONFIG_PATH) {
+                               my $file = File::Spec->catfile($_, $FILENAME1);
+                               unshift(@_, $file), last SEARCH if -f $file;
+                       }
+                       for (@CONFIG_PATH) {
+                               my $file = File::Spec->catfile($_, $FILENAME2);
+                               unshift(@_, $file), last SEARCH if -f $file;
+                       }
+                }
+
+                croak "Cannot find '$FILENAME1' or '$FILENAME2' in any standard location." unless $_[0];
+        }
+
+        $class->SUPER::read( @_ );
+}
+
+# Straight from Config::Tiny - only changes are repeated property key support
+# Would be nice if we could just override the per-line handling ...
+sub read_string
+{
+        my $class = ref $_[0] ? ref shift : shift;
+        my $self  = bless {}, $class;
+        return undef unless defined $_[0];
+
+        # Parse the file
+        my $ns      = '_';
+        my $counter = 0;
+        foreach ( split /(?:\015{1,2}\012|\015|\012)/, shift ) {
+                $counter++;
+
+                # Skip comments and empty lines
+                next if /^\s*(?:\#|\;|$)/;
+
+                # Handle section headers
+                if ( /^\s*\[\s*(.+?)\s*\]\s*$/ ) {
+                        # Create the sub-hash if it doesn't exist.
+                        # Without this sections without keys will not
+                        # appear at all in the completed struct.
+                        $self->{$ns = $1} ||= {};
+                        next;
+                }
+
+                # Handle properties
+                if ( /^\s*([^=]+?)\s*=\s*(.*?)\s*$/ ) {
+                        $self->{$ns}->{$1} = defined $self->{$ns}->{$1} ?
+                                [ $self->{$ns}->{$1}, $2 ] : 
+                                $2;
+                        next;
+                }
+
+                return $self->_error( "Syntax error at line $counter: '$_'" );
+        }
+
+        $self;
+}
+
+sub write { croak "Write access not permitted" }
+
+1;
+
+=head1 NAME
+
+Nagios::Plugin::Config - read nagios plugin .ini style config files
+
+=head1 SYNOPSIS
+
+    # Read given nagios plugin config file
+    $Config = Nagios::Plugin::Config->read( '/etc/nagios/plugins.ini' );
+
+    # Search for and read default nagios plugin config file
+    $Config = Nagios::Plugin::Config->read();
+
+    # Access sections and properties (returns scalars or arrayrefs)
+    $rootproperty =  $Config->{_}->{rootproperty};
+    $one = $Config->{section}->{one};
+    $Foo = $Config->{section}->{Foo};
+
+=head1 DESCRIPTION
+
+Nagios::Plugin::Config is a subclass of the excellent Config::Tiny,
+with the following changes:
+
+=over 4
+
+=item 
+
+Repeated keys are allowed within sections, returning lists instead of scalars
+
+=item 
+
+Write functionality has been removed i.e. access is read only
+
+=item 
+
+Nagios::Plugin::Config searches for a default nagios plugins file if no explicit 
+filename is given to C<read()>. The current standard locations checked are:
+
+=over 4
+
+=item /etc/nagios/plugins.ini
+
+=item /usr/local/nagios/etc/plugins.ini
+
+=item /usr/local/etc/nagios /etc/opt/nagios/plugins.ini
+
+=item /etc/nagios-plugins.ini 
+
+=item /usr/local/etc/nagios-plugins.ini 
+
+=item /etc/opt/nagios-plugins.ini
+
+=back
+
+To use a custom location, set a C<NAGIOS_CONFIG_PATH> environment variable 
+to the set of directories that should be checked. The first C<plugins.ini> or
+C<nagios-plugins.ini> file found will be used.
+
+=back
+
+
+=head1 SEE ALSO
+
+L<Config::Tiny>, L<Nagios::Plugin>
+
+
+=head1 AUTHORS
+
+This code is maintained by the Nagios Plugin Development Team: 
+L<http://nagiosplug.sourceforge.net>.
+
+
+=head1 COPYRIGHT and LICENCE
+
+Copyright (C) 2006-2007 by Nagios Plugin Development Team
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
+
diff --git a/lib/Nagios/Plugin/Functions.pm b/lib/Nagios/Plugin/Functions.pm
index 526dbed..751251f 100644
--- a/lib/Nagios/Plugin/Functions.pm
+++ b/lib/Nagios/Plugin/Functions.pm
@@ -46,6 +46,13 @@ our %STATUS_TEXT = reverse %ERRORS;
 my $_fake_exit = 0;
 sub _fake_exit { @_ ? $_fake_exit = shift : $_fake_exit };
 
+# Tweak default die handling: die is cool because it allows capturing both return codes and 
+# output via eval, but the Nagios Plugin Guidelines like STDOUT over STDERR
+$SIG{__DIE__} = sub {
+    print STDOUT shift;
+    exit $!;
+};
+
 sub get_shortname {
     my %arg = @_;
 
@@ -390,7 +397,6 @@ This code is maintained by the Nagios Plugin Development Team: http://nagiosplug
 Copyright (C) 2006 by Nagios Plugin Development Team
 
 This library is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself, either Perl version 5.8.4 or,
-at your option, any later version of Perl 5 you may have available.
+it under the same terms as Perl itself.
 
 =cut
diff --git a/lib/Nagios/Plugin/Getopt.pm b/lib/Nagios/Plugin/Getopt.pm
index 806a6a0..743bf7e 100644
--- a/lib/Nagios/Plugin/Getopt.pm
+++ b/lib/Nagios/Plugin/Getopt.pm
@@ -10,15 +10,13 @@ use File::Basename;
 use Getopt::Long qw(:config no_ignore_case bundling);
 use Carp;
 use Params::Validate qw(:all);
-use Config::Tiny;
 use base qw(Class::Accessor);
 
 use Nagios::Plugin::Functions;
-use vars qw($VERSION $DEFAULT_CONFIG_FILE);
+use Nagios::Plugin::Config;
+use vars qw($VERSION);
 $VERSION = $Nagios::Plugin::Functions::VERSION;
 
-$DEFAULT_CONFIG_FILE = '/etc/nagios/plugins.cfg';
-
 # Standard defaults
 my %DEFAULT = (
   timeout => 15,
@@ -39,8 +37,8 @@ my @ARGS = ({
     spec => 'version|V',
     help => "-V, --version\n   Print version information",
   }, {
-    spec => 'default-opts:s@',
-    help => "--default-opts=[<section>[@<config_file>]]\n   Section and/or config_file from which to load default options (may repeat)",
+    spec => 'extra-opts:s@',
+    help => "--extra-opts=[<section>[@<config_file>]]\n   Section and/or config_file from which to load extra options (may repeat)",
   }, {
     spec => 'timeout|t=i',
     help => "-t, --timeout=INTEGER\n   Seconds before plugin times out (default: %s)",
@@ -77,6 +75,37 @@ sub _attr
   $self->{_attr}->{$item} . "\n" . $extra;
 }
 
+# Turn argument spec into help-style output
+sub _spec_to_help
+{
+  my ($self, $spec, $label) = @_;
+
+  my ($opts, $type) = split /=/, $spec, 2;
+  my (@short, @long);
+  for (split /\|/, $opts) {
+    if (length $_ == 1) {
+      push @short, "-$_";
+    } else {
+      push @long, "--$_";
+    }
+  }
+
+  my $help = join(', ', @short, @long);
+  if ($type) {
+    if ($label) {
+      $help .= '=' . $label;
+    }
+    else {
+      $help .= $type eq 'i' ? '=INTEGER' : '=STRING';
+    }
+  }
+  elsif ($label) {
+    carp "Label specified, but there's no type in spec '$spec'";
+  }
+  $help .= "\n   ";
+  return $help;
+}
+
 # Options output for plugin -h
 sub _options
 {
@@ -94,10 +123,29 @@ sub _options
 
   my @options = ();
   for my $arg (@args, @defer) {
-    if ($arg->{help} =~ m/%s/) {
-      push @options, sprintf($arg->{help}, $arg->{default} || '');
+    my $help_array = ref $arg->{help} && ref $arg->{help} eq 'ARRAY' ? $arg->{help} : [ $arg->{help} ];
+    my $label_array = $arg->{label} && ref $arg->{label} && ref $arg->{label} eq 'ARRAY' ? $arg->{label} : [ $arg->{label} ];
+    my $help_string = '';
+    for (my $i = 0; $i <= $#$help_array; $i++) {
+      my $help = $help_array->[$i];
+      # Add spec arguments to help if not already there
+      if ($help =~ m/^\s*-/) {
+        $help_string .= $help;
+      }
+      else {
+        $help_string .= $self->_spec_to_help($arg->{spec}, $label_array->[$i]) . $help;
+        $help_string .= "\n " if $i < $#$help_array;
+      }
+    }
+
+    # Add help_string to @options
+    if ($help_string =~ m/%s/) {
+      my $default = defined $arg->{default} ? $arg->{default} : '';
+      # We only handle '%s' formats here, so escape everything else
+      $help_string =~ s/%(?!s)/%%/g;
+      push @options, sprintf($help_string, $default, $default, $default, $default);
     } else {
-      push @options, $arg->{help};
+      push @options, $help_string;
     }
   }
 
@@ -195,15 +243,12 @@ sub _load_config_section
   my $self = shift;
   my ($section, $file, $flags) = @_;
   $section ||= $self->{_attr}->{plugin};
-  $file ||= $DEFAULT_CONFIG_FILE;
-
-  $self->_die("Cannot find config file '$file'") if $flags->{fatal} && ! -f $file;
 
-  my $Config = Config::Tiny->read($file);
-  $self->_die("Cannot read config file '$file'") unless defined $Config;
+  my $Config = Nagios::Plugin::Config->read($file);
 
+  # TODO: is this check sane? Does --extra-opts=foo require a [foo] section?
   $self->_die("Invalid section '$section' in config file '$file'")
-    if $flags->{fatal} && ! exists $Config->{$section};
+    unless exists $Config->{$section};
 
   return $Config->{$section};
 }
@@ -248,7 +293,7 @@ sub _cmdline
 
     # Skip defaults and internals
     next if exists $DEFAULT{$key} && $hash->{$key} eq $DEFAULT{$key}; 
-    next if grep { $key eq $_ } qw(help usage version default-opts);
+    next if grep { $key eq $_ } qw(help usage version extra-opts);
     next unless defined $hash->{$key};
 
     # Render arg
@@ -275,44 +320,37 @@ sub _cmdline
   return wantarray ? @args : join(' ', @args);
 }
 
-# Process and load default-opts sections
-sub _process_default_opts
+# Process and load extra-opts sections
+sub _process_extra_opts
 {
   my $self = shift;
   my ($args) = @_;
 
-  my $defopts_list = $args->{'default-opts'};
-  my $defopts_explicit = 1;
-
-  # If no default_opts defined, force one implicitly
-  if (! $defopts_list) {
-    $defopts_list = [ '' ];
-    $defopts_explicit = 0;
-  }
+  my $extopts_list = $args->{'extra-opts'};
 
   my @sargs = ();
-  for my $defopts (@$defopts_list) {
-    $defopts ||= $self->{_attr}->{plugin};
-    my $section = $defopts;
+  for my $extopts (@$extopts_list) {
+    $extopts ||= $self->{_attr}->{plugin};
+    my $section = $extopts;
     my $file = '';
 
     # Parse section@file
-    if ($defopts =~ m/^(\w*)@(.*?)\s*$/) {
+    if ($extopts =~ m/^(\w*)@(.*?)\s*$/) {
       $section = $1;
       $file = $2;
     }
 
     # Load section args
-    my $shash = $self->_load_config_section($section, $file, { fatal => $defopts_explicit });
+    my $shash = $self->_load_config_section($section, $file);
 
     # Turn $shash into a series of commandline-like arguments
     push @sargs, $self->_cmdline($shash);
   }
 
-  # Reset ARGV to default-opts + original
+  # Reset ARGV to extra-opts + original
   @ARGV = ( @sargs, @{$self->{_attr}->{argv}} );
 
-  printf "[default-opts] %s %s\n", $self->{_attr}->{plugin}, join(' ', @ARGV)
+  printf "[extra-opts] %s %s\n", $self->{_attr}->{plugin}, join(' ', @ARGV)
     if $args->{verbose} && $args->{verbose} >= 3;
 }
 
@@ -332,17 +370,19 @@ sub arg
       help => 1,
       default => 0,
       required => 0,
+      label => 0,
     });
   }
 
   # Positional args
   else {
-    my @args = validate_pos(@_, 1, 1, 0, 0);
+    my @args = validate_pos(@_, 1, 1, 0, 0, 0);
     %args = (
       spec      => $args[0],
       help      => $args[1],
       default   => $args[2],
       required  => $args[3],
+      label     => $args[4],
     );
   }
 
@@ -358,7 +398,7 @@ sub getopts
   # Collate spec arguments for Getopt::Long
   my @opt_array = $self->_process_specs_getopt_long;
 
-  # Capture original @ARGV (for default-opts games)
+  # Capture original @ARGV (for extra-opts games)
   $self->{_attr}->{argv} = [ @ARGV ];
 
   # Call GetOptions using @opt_array
@@ -367,10 +407,10 @@ sub getopts
   # Invalid options - give usage message and exit
   $self->_die($self->_usage) unless $ok;
 
-  # Process default-opts
-  $self->_process_default_opts($args1);
+  # Process extra-opts
+  $self->_process_extra_opts($args1);
 
-  # Call GetOptions again, this time including default-opts
+  # Call GetOptions again, this time including extra-opts
   $ok = GetOptions($self, @opt_array);
   # Invalid options - give usage message and exit
   $self->_die($self->_usage) unless $ok;
@@ -410,7 +450,7 @@ sub _init
     plugin => { default => $plugin },
     blurb => 0,
     extra => 0,
-    'default-opts' => 0,
+    'extra-opts' => 0,
     license => { default => $DEFAULT{license} },
     timeout => { default => $DEFAULT{timeout} },
   });
@@ -452,17 +492,16 @@ processing for Nagios plugins
 
   # Instantiate object (usage is mandatory)
   $ng = Nagios::Plugin::Getopt->new(
-    usage => "Usage: %s -H <host> -w <warning_threshold> 
-  -c <critical threshold>",
-    version => '0.01',
+    usage => "Usage: %s -H <host> -w <warning> -c <critical>",
+    version => '0.1',
     url => 'http://www.openfusion.com.au/labs/nagios/',
     blurb => 'This plugin tests various stuff.', 
   );
 
   # Add argument - named parameters (spec and help are mandatory)
   $ng->arg(
-    spec => 'critical|c=s',
-    help => qq(-c, --critical=INTEGER\n   Exit with CRITICAL status if fewer than INTEGER foobars are free),
+    spec => 'critical|c=i',
+    help => q(Exit with CRITICAL status if fewer than INTEGER foobars are free),
     required => 1,
     default => 10,
   );
@@ -470,8 +509,8 @@ processing for Nagios plugins
   # Add argument - positional parameters - arg spec, help text, 
   #   default value, required? (first two mandatory)
   $ng->arg(
-    'warning|w=s',
-    qq(-w, --warning=INTEGER\n   Exit with WARNING status if fewer than INTEGER foobars are free),
+    'warning|w=i',
+    q(Exit with WARNING status if fewer than INTEGER foobars are free),
     5,
     1);
 
@@ -545,9 +584,10 @@ License text, included in the longer --help output (see below for an
 example). By default, this is set to the standard nagios plugins
 GPL license text:
 
-  This nagios plugin is free software, and comes with ABSOLUTELY NO WARRANTY. 
-  It may be used, redistributed and/or modified under the terms of the GNU 
-  General Public Licence (see http://www.fsf.org/licensing/licenses/gpl.txt).
+  This nagios plugin is free software, and comes with ABSOLUTELY 
+  NO WARRANTY. It may be used, redistributed and/or modified under 
+  the terms of the GNU General Public Licence (see 
+  http://www.fsf.org/licensing/licenses/gpl.txt).
 
 Provide your own to replace this text in the help output.
 
@@ -603,8 +643,8 @@ example:
    -H, --hostname=ADDRESS
      Host name or IP address
    -p, --ports=STRING
-     Port numbers to check. Format: comma-separated, colons or hyphens for ranges,
-     no spaces e.g. 8700:8705,8710-8715,8760 
+     Port numbers to check. Format: comma-separated, colons for ranges,
+     no spaces e.g. 8700:8705,8710:8715,8760 
    -t, --timeout=INTEGER
      Seconds before plugin times out (default: 15)
    -v, --verbose
@@ -615,21 +655,25 @@ example:
 
 You can define arguments for your plugin using the arg() method, which 
 supports both named and positional arguments. In both cases
-the 'spec' and 'help' arguments are required, while the 'default' 
-and 'required' arguments are optional:
+the C<spec> and C<help> arguments are required, while the C<label>, 
+C<default>, and C<required> arguments are optional:
 
   # Define --hello argument (named parameters)
   $ng->arg(
-    spec => 'hello=s', 
-    help => "--hello\n   Hello string",
+    spec => 'hello|h=s', 
+    help => "Hello string",
     required => 1,
   );
 
   # Define --hello argument (positional parameters)
-  #   Parameter order is 'spec', 'help', 'default', 'required?'
-  $ng->arg('hello=s', "--hello\n   Hello string", undef, 1);
+  #   Parameter order is 'spec', 'help', 'default', 'required?', 'label'
+  $ng->arg('hello|h=s', "Hello parameter (default %s)", 5, 1);
+
+=over 4
 
-The 'spec' argument (the first argument in the positional variant) is a
+=item spec
+
+The C<spec> argument (the first argument in the positional variant) is a
 L<Getopt::Long> argument specification. See L<Getopt::Long> for the details,
 but basically it is a series of one or more argument names for this argument
 (separated by '|'), suffixed with an '=<type>' indicator if the argument
@@ -651,24 +695,105 @@ and so on. The following are some examples:
 
 =back
 
-The 'help' argument is a string displayed in the --help option list output. 
-If the string contains a '%s' it will be formatted via L<sprintf> with the
-'default' as the argument i.e.
+=item help
+
+The C<help> argument is a string displayed in the --help option list output,
+or it can be a list (an arrayref) of such strings, for multi-line help (see
+below).
+
+The help string is munged in two ways:
+
+=over 4
+
+=item
+
+First, if the help string does NOT begins with a '-' sign, it is prefixed 
+by an expanded form of the C<spec> argument. For instance, the following 
+hello argument:
+
+  $ng->arg(
+    spec => 'hello|h=s', 
+    help => "Hello string",
+  );
+
+would be displayed in the help output as:
+
+  -h, --hello=STRING
+    Hello string
+
+where the '-h, --hello=STRING' part is derived from the spec definition
+(by convention with short args first, then long, then label/type, if any).
+
+=item 
+
+Second, if the string contains a '%s' it will be formatted via 
+C<sprintf> with the 'default' as the argument i.e.
 
   sprintf($help, $default)
 
-A gotcha is that standard percentage signs also need to be escaped 
-(i.e. '%%') in this case.
+=back
+
+Multi-line help is useful in cases where an argument can be of different types
+and you want to make this explicit in your help output e.g.
+
+  $ng->arg(
+    spec => 'warning|w=s',
+    help => [
+      'Exit with WARNING status if less than BYTES bytes of disk are free',
+      'Exit with WARNING status if less than PERCENT of disk is free',
+    ],
+    label => [ 'BYTES', 'PERCENT%' ],
+  );
+
+would be displayed in the help output as:
+
+ -w, --warning=BYTES
+    Exit with WARNING status if less than BYTES bytes of disk are free
+ -w, --warning=PERCENT%
+    Exit with WARNING status if less than PERCENT of disk space is free
+
+Note that in this case we've also specified explicit labels in another
+arrayref corresponding to the C<help> one - if this had been omitted 
+the types would have defaulted to 'STRING', instead of 'BYTES' and 
+'PERCENT%'.
+
+
+=item label
+
+The C<label> argument is a scalar or an arrayref (see 'Multi-line help' 
+description above) that overrides the standard type expansion when generating
+help text from the spec definition. By default, C<spec=i> arguments are 
+labelled as C<=INTEGER> in the help text, and C<spec=s> arguments are labelled 
+as C<=STRING>. By supplying your own C<label> argument you can override these 
+standard 'INTEGER' and 'STRING' designations.
+
+For multi-line help, you can supply an ordered list (arrayref) of labels to
+match the list of help strings e.g.
+
+  label => [ 'BYTES', 'PERCENT%' ]
 
-The 'default' argument is the default value to be given to this parameter
+Any labels that are left as undef (or just omitted, if trailing) will just
+use the default 'INTEGER' or 'STRING' designations e.g.
+
+  label => [ undef, 'PERCENT%' ]
+
+
+=item default
+
+The C<default> argument is the default value to be given to this parameter
 if none is explicitly supplied.
 
-The 'required' argument is a boolean used to indicate that this argument 
+
+=item required
+
+The C<required> argument is a boolean used to indicate that this argument 
 is mandatory (Nagios::Plugin::Getopt will exit with your usage message and 
 a 'Missing argument' indicator if any required arguments are not supplied).
 
+=back
+
 Note that --help lists your arguments in the order they are defined, so 
-you might want to order your arg() calls accordingly.
+you should order your C<arg()> calls accordingly.
 
 
 =head2 GETOPTS
@@ -703,14 +828,14 @@ using their long variant names.
 
 =head2 BUILTIN PROCESSING
 
-The getopts() method also handles processing of the immediate builtin 
+The C<getopts()> method also handles processing of the immediate builtin 
 arguments, namely --usage, --version, --help, as well as checking all
 required arguments have been supplied, so you don't have to handle
 those yourself. This means that your plugin will exit from the getopts()
 call in these cases - if you want to catch that you can run getopts()
 within an eval{}.
 
-getopts() also sets up a default ALRM timeout handler so you can use an
+C<getopts()> also sets up a default ALRM timeout handler so you can use an
 
   alarm $ng->timeout;
 
@@ -730,7 +855,7 @@ Gavin Carr <gavin@openfusion.com.au>
 
 =head1 COPYRIGHT AND LICENSE
 
-Copyright (C) 2006 by the Nagios Plugin Development Team.
+Copyright (C) 2006-2007 by the Nagios Plugin Development Team.
 
 This module is free software. It may be used, redistributed
 and/or modified under either the terms of the Perl Artistic