Refactor N::P::Performance; cleanups to Threshold and Range (mostly perldocs).

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

7 files changed, 233 insertions, 96 deletions

diff --git a/MANIFEST b/MANIFEST
index 67bb306..1d4f532 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -16,9 +16,7 @@ t/Nagios-Plugin-Getopt-03.t
 t/Nagios-Plugin-Performance.t
 t/Nagios-Plugin-Range.t
 t/Nagios-Plugin-Threshold.t
-t/npg03/
 t/npg03/README
-t/npg03/expected/
 t/npg03/expected/00_basic
 t/npg03/expected/01_override1
 t/npg03/expected/02_override2
@@ -27,7 +25,6 @@ t/npg03/expected/06_singlechar2
 t/npg03/expected/07_singlechar3
 t/npg03/expected/09_funnystuff
 t/npg03/expected/12_nosection_implicit
-t/npg03/input/
 t/npg03/input/00_basic
 t/npg03/input/01_override1
 t/npg03/input/02_override2
diff --git a/lib/Nagios/Plugin/Functions.pm b/lib/Nagios/Plugin/Functions.pm
index 43f371c..513501b 100644
--- a/lib/Nagios/Plugin/Functions.pm
+++ b/lib/Nagios/Plugin/Functions.pm
@@ -343,8 +343,6 @@ If join_all is supplied, however, it will be used as a string to
 join the resultant critical, warning, and ok messages together i.e.
 all messages are joined and returned.
 
-=back
-
 =item get_shortname
 
 Return the default shortname used for this plugin i.e. the first
@@ -357,8 +355,6 @@ with any leading 'CHECK_' and trailing file suffixes removed.
 get_shortname is not exported by default, so must be explicitly
 imported.
 
-=back
-
 =item max_state(@a)
 
 Returns the worst state in the array. Order is: CRITICAL, WARNING, OK, UNKNOWN,
diff --git a/lib/Nagios/Plugin/Performance.pm b/lib/Nagios/Plugin/Performance.pm
index fc1c0bc..1f036f2 100644
--- a/lib/Nagios/Plugin/Performance.pm
+++ b/lib/Nagios/Plugin/Performance.pm
@@ -6,41 +6,49 @@ use strict;
 use warnings;
 
 use Carp;
-use Nagios::Plugin::Threshold;
+use base qw(Class::Accessor::Fast);
+Nagios::Plugin::Performance->mk_ro_accessors(
+    qw(label value uom warning critical min max)
+);
+
 use Nagios::Plugin::Functions;
+use Nagios::Plugin::Threshold;
+use Nagios::Plugin::Range;
 our ($VERSION) = $Nagios::Plugin::Functions::VERSION;
 
-use Class::Struct;
-struct "Nagios::Plugin::Performance" => {
-        label => '$',
-        value => '$',
-        uom   => '$',
-        threshold => 'Nagios::Plugin::Threshold',
-        min  => '$',
-        max  => '$',
-        };
-
-sub perfoutput {
-        my $self = shift;
-        my $output = $self->label."=".$self->value. ($self->uom || "") .";".$self->threshold->warning.";".$self->threshold->critical;
-        return $output;
-}
-
 sub _parse {
         my $class = shift;
         my $string = shift;
-        my $p = $class->new;
         $string =~ s/^([^=]+)=([\d\.]+)(\w*);?([\d\.]+)?;?([\d\.]+)?;?([\d\.]+)?;?([\d\.]+)?\s*//;
         return undef unless ((defined $1 && $1 ne "") && (defined $2 && $2 ne ""));
-        $p->label($1);
-        $p->value($2+0);
-        $p->uom($3);
-        $p->threshold(Nagios::Plugin::Threshold->set_thresholds(warning => $4, critical => $5));
-        $p->min($6);
-        $p->max($7);
+    my $p = $class->new(
+        label => $1, value => $2+0, uom => $3, warning => $4, critical => $5, 
+        min => $6, max => $7
+    );
         return ($p, $string);
 }
 
+# Map undef to ''
+sub _nvl {
+    my ($self, $value) = @_;
+    defined $value ? $value : ''
+}
+
+sub perfoutput {
+        my $self = shift;
+    my $out = sprintf "%s=%s%s;%s;%s;%s;%s",
+        $self->label,
+        $self->value,
+        $self->_nvl($self->uom),
+        $self->_nvl($self->warning),
+        $self->_nvl($self->critical),
+        $self->_nvl($self->min),
+        $self->_nvl($self->max);
+    # Previous implementation omitted trailing ;; - do we need this?
+    $out =~ s/;;$//;
+    return $out;
+}
+
 sub parse_perfstring {
         my ($class, $perfstring) = @_;
         my @perfs;
@@ -58,8 +66,9 @@ sub rrdlabel {
         my $name = $self->label;
         if ($name eq "/") {
                 $name = "root";
+    }
         # If filesystem name, remove initial / and convert subsequent "/" to "_"
-        } elsif ($name =~ s/^\///) {
+        elsif ($name =~ s/^\///) {
                 $name =~ s/\//_/g;
         }
         # Convert bad chars
@@ -68,84 +77,150 @@ sub rrdlabel {
         return substr( $name, 0, 19 );
 }
 
+# Backward compatibility: create a threshold object on the fly as requested
+sub threshold
+{
+    my $self = shift;
+    return Nagios::Plugin::Threshold->set_thresholds(
+        warning => $self->warning, critical => $self->critical
+    );
+}
+
+# Constructor - unpack thresholds, map args to hashref
+sub new 
+{
+    my $class = shift;
+    my %arg = @_;
+
+    # Convert thresholds
+    if (my $threshold = delete $arg{threshold}) {
+        $arg{warning}  ||= $threshold->warning  . "";
+        $arg{critical} ||= $threshold->critical . "";
+    }
+
+    $class->SUPER::new(\%arg);
+}
+
 1;
+
 __END__
 
 =head1 NAME
 
-Nagios::Plugin::Performance - Performance information in a perl object
+Nagios::Plugin::Performance - class for handling Nagios::Plugin
+performance data.
 
 =head1 SYNOPSIS
 
   use Nagios::Plugin::Performance;
 
-  @p = Nagios::Plugin::Performance->parse_perfstring("/=382MB;15264;15269;; /var=218MB;9443;9448");
-  if (@p) {
-        print "1st label = ", $p[0]->label, $/;
-        print "1st uom   = ", $p[0]->uom, $/;
-        print "2nd crit  = ", $p[1]->threshold->critical, $/;
-  } else {
-        print "Cannot parse",$/;
+  # Constructor (also accepts a 'threshold' obj instead of warning/critical)
+  $p = Nagios::Plugin::Performance->new(
+      label     => 'size',
+      value     => $value,
+      uom       => "kB",
+      warning   => $warning,
+      critical  => $critical,
+      min       => $min,
+      max       => $max,
+  );
+
+  # Parser
+  @perf = Nagios::Plugin::Performance->parse_perfstring(
+      "/=382MB;15264;15269;; /var=218MB;9443;9448"
+  ) 
+  or warn("Failed to parse perfstring");
+
+  # Accessors
+  for $p (@perf) {
+    printf "label:    %s\n",   $p->label;
+    printf "value:    %s\n",   $p->value;
+    printf "uom:      %s\n",   $p->uom;
+    printf "warning:  %s\n",   $p->warning;
+    printf "critical: %s\n",   $p->critical;
+    printf "min:      %s\n",   $p->min;
+    printf "max:      %s\n",   $p->max;
+    # Special accessor returning a threshold obj containing warning/critical
+    $threshold = $p->threshold;
   }
 
+  # Perfdata output format i.e. label=value[uom];[warn];[crit];[min];[max]
+  print $p->perfoutput;
+
+
 =head1 DESCRIPTION
 
-Handles common Nagios Plugin performance data. This has a public interface because it could be
-used by performance graphing routines, such as nagiostat (http://nagiostat.sourceforge.net),
-perfparse (http://perfparse.sourceforge.net), nagiosgraph (http://nagiosgraph.sourceforge.net) or
-NagiosGrapher (http://www.nagiosexchange.org/NagiosGrapher.84.0.html).
+Nagios::Plugin class for handling performance data. This is a public 
+interface because it could be used by performance graphing routines, 
+such as nagiostat (http://nagiostat.sourceforge.net), perfparse 
+(http://perfparse.sourceforge.net), nagiosgraph 
+(http://nagiosgraph.sourceforge.net) or NagiosGrapher 
+(http://www.nagiosexchange.org/NagiosGrapher.84.0.html).
 
-Once the performance string has been parsed, you can query the label, value, uom, or thresholds.
+Nagios::Plugin::Performance offers both a parsing interface (via 
+parse_perfstring), for turning nagios performance output strings into
+their components, and a composition interface (via new), for turning
+components into perfdata strings.
 
 =head1 CLASS METHODS
 
 =over 4
 
+=item Nagios::Plugin::Performance->new(%attributes)
+
+Instantiates a new Nagios::Plugin::Performance object with the given 
+attributes.
+
 =item Nagios::Plugin::Performance->parse_perfstring($string)
 
-Returns an array of Nagios::Plugin::Performance objects based on the string entered. 
-If there is an error parsing the string, an empty array is returned.
+Returns an array of Nagios::Plugin::Performance objects based on the string 
+entered. If there is an error parsing the string, an empty array is returned.
 
 =back
 
-=head1 OBJECT METHODS
+=head1 OBJECT METHODS (ACCESSORS)
 
 =over 4
 
-=item label, value, uom, min, max
+=item label, value, uom, warning, critical, min, max
 
 These all return scalars. min and max are not well supported yet.
 
+=item threshold
+
+Returns a Nagios::Plugin::Threshold object holding the warning and critical 
+ranges for this performance data (if any).
+
 =item rrdlabel
 
-Returns a label that can be used for the dataset name of an RRD, ie, between 1-19
-characters long with characters [a-zA-Z0-9_].
+Returns a string based on 'label' that is suitable for use as dataset name of 
+an RRD i.e. munges label to be 1-19 characters long with only characters 
+[a-zA-Z0-9_].
 
-There is no guarantee that multiple N:P:Performance objects will have unique rrdlabels.
+There is no guarantee that multiple N:P:Performance objects will have unique 
+rrdlabels.
 
-=item threshold
+=item perfoutput
 
-This returns a Nagios::Plugin::Threshold object.
+Outputs the data in Nagios::Plugin perfdata format i.e. 
+label=value[uom];[warn];[crit];[min];[max].
 
 =back 
 
 =head1 SEE ALSO
 
-Nagios::Plugin for information about versioning.
-
-http://nagiosplug.sourceforge.net
+Nagios::Plugin, Nagios::Plugin::Threshold, http://nagiosplug.sourceforge.net.
 
 =head1 AUTHOR
 
-This code is maintained by the Nagios Plugin Development Team: http://nagiosplug.sourceforge.net
+This code is maintained by the Nagios Plugin Development Team: see
+http://nagiosplug.sourceforge.net.
 
 =head1 COPYRIGHT AND LICENSE
 
-Copyright (C) 2006 Nagios Plugin Development Team
+Copyright (C) 2006-2007 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/Range.pm b/lib/Nagios/Plugin/Range.pm
index 691506f..dbb637c 100644
--- a/lib/Nagios/Plugin/Range.pm
+++ b/lib/Nagios/Plugin/Range.pm
@@ -10,7 +10,7 @@ use Nagios::Plugin::Functions;
 our ($VERSION) = $Nagios::Plugin::Functions::VERSION;
 
 use overload
-        '""' => sub { shift->stringify };
+        '""' => sub { shift->_stringify };
 
 use Class::Struct;
 struct "Nagios::Plugin::Range" => {
@@ -24,7 +24,7 @@ struct "Nagios::Plugin::Range" => {
 use constant OUTSIDE => 0;
 use constant INSIDE => 1;
 
-sub stringify {
+sub _stringify {
         my $self = shift;
         return "" unless $self->is_set;
         return (($self->alert_on) ? "@" : "") .
@@ -37,13 +37,13 @@ sub is_set {
         (! defined $self->alert_on) ? 0 : 1;
 }
 
-sub set_range_start {
+sub _set_range_start {
         my ($self, $value) = @_;
         $self->start($value+0); # Force scalar into number
         $self->start_infinity(0);
 }
 
-sub set_range_end {
+sub _set_range_end {
         my ($self, $value) = @_;
         $self->end($value+0);   # Force scalar into number
         $self->end_infinity(0);
@@ -71,13 +71,13 @@ sub parse_range_string {
         }
         if ( $string =~ m/^([\d\.-]+)?:/ ) {     # '10:'
                 my $start = $1;
-            $range->set_range_start($start) if defined $start;
+            $range->_set_range_start($start) if defined $start;
                 $range->end_infinity(1);  # overridden below if there's an end specified
             $string =~ s/^([-\d\.]+)?://;
             $valid++;
         }
         if ($string =~ /^([-\d\.]+)$/) {   # 'x:10' or '10'
-            $range->set_range_end($string);
+            $range->_set_range_end($string);
             $valid++;
         }
 
@@ -124,23 +124,41 @@ __END__
 
 =head1 NAME
 
-Nagios::Plugin::Range - Common range functions for Nagios::Plugin
+Nagios::Plugin::Range - class for handling Nagios::Plugin range data.
+
+=head1 SYNOPSIS
+
+    # NB: This is an internal Nagios::Plugin class. 
+    # See Nagios::Plugin itself for public interfaces.
+
+    # Instantiate an empty range object
+    $r = Nagios::Plugin::Range->new; 
+
+    # Instantiate by parsing a standard nagios range string
+    $r = Nagios::Plugin::Range->parse_range_string;
+
+    # Returns true if the range is defined/non-empty
+    $r->is_set;
+
+    # Returns true if $value matches range, false otherwise
+    $r->check_range($value);
+
 
 =head1 DESCRIPTION
 
-Handles common Nagios Plugin range data. See Nagios::Plugin for creation interfaces.
+Internal Nagios::Plugin class for handling common range data. See 
+Nagios::Plugin for public interfaces.
 
 =head1 AUTHOR
 
-This code is maintained by the Nagios Plugin Development Team: http://nagiosplug.sourceforge.net
+This code is maintained by the Nagios Plugin Development Team: see
+http://nagiosplug.sourceforge.net.
 
 =head1 COPYRIGHT AND LICENSE
 
-Copyright (C) 2006 Nagios Plugin Development Team
+Copyright (C) 2006-2007 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/Threshold.pm b/lib/Nagios/Plugin/Threshold.pm
index b2afd8e..0c4805a 100644
--- a/lib/Nagios/Plugin/Threshold.pm
+++ b/lib/Nagios/Plugin/Threshold.pm
@@ -58,38 +58,49 @@ __END__
 
 =head1 NAME
 
-Nagios::Plugin::Threshold - Threshold information in a perl object
+Nagios::Plugin::Threshold - class for handling Nagios::Plugin thresholds.
 
-=head1 DESCRIPTION
+=head1 SYNOPSIS
 
-Handles common Nagios Plugin threshold data. See Nagios::Plugin or Nagios::Plugin::Performance for 
-creation of this object.
+    # NB: This is an internal Nagios::Plugin class.
+    # See Nagios::Plugin itself for public interfaces.
+  
+    # Constructor
+    $t = Nagios::Plugin::Threshold->set_thresholds(
+        warning  => $warning_range_string,
+        critical => $critical_range_string,
+    );
 
-=head1 OBJECT METHODS
+    # Value checking - returns CRITICAL if in the critical range,
+    # WARNING if in the warning range, and OK otherwise
+    $status = $t->get_status($value);
 
-=over 4
+    # Accessors - return the associated N::P::Range object
+    $warning_range  = $t->warning;
+    $critical_range = $t->critical;
 
-=item warning, critical
 
-Returns the warning or critical range as a Nagios::Plugin::Range object.
+=head1 DESCRIPTION
 
-=item get_status($value)
+Internal Nagios::Plugin class for handling threshold data. See 
+Nagios::Plugin for public interfaces.
 
-Given a value, will see if the value breaches the critical or the warning range. Returns the status code.
+A threshold object contains (typically) a pair of ranges, associated 
+with a particular severity e.g.
 
-=back
+  warning  => range1
+  critical => range2
 
 =head1 AUTHOR
 
-This code is maintained by the Nagios Plugin Development Team: http://nagiosplug.sourceforge.net
+This code is maintained by the Nagios Plugin Development Team: see
+http://nagiosplug.sourceforge.net.
 
 =head1 COPYRIGHT AND LICENSE
 
-Copyright (C) 2006 Nagios Plugin Development Team
+Copyright (C) 2006-2007 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/t/Nagios-Plugin-Performance.t b/t/Nagios-Plugin-Performance.t
index 1ae330a..0dcb800 100644
--- a/t/Nagios-Plugin-Performance.t
+++ b/t/Nagios-Plugin-Performance.t
@@ -1,6 +1,6 @@
 
 use strict;
-use Test::More tests => 49;
+use Test::More tests => 77;
 BEGIN { use_ok('Nagios::Plugin::Performance') };
 
 diag "\nusing Nagios::Plugin::Performance revision ". $Nagios::Plugin::Performance::VERSION . "\n" if $ENV{TEST_VERBOSE};
@@ -8,15 +8,55 @@ diag "\nusing Nagios::Plugin::Performance revision ". $Nagios::Plugin::Performan
 use Nagios::Plugin::Functions;
 Nagios::Plugin::Functions::_fake_exit(1);
 
-my @p = Nagios::Plugin::Performance->parse_perfstring("/=382MB;15264;15269;; /var=218MB;9443;9448");
+my (@p, $p);
+my @test = (
+  { 
+    perfoutput => "/=382MB;15264;15269;0;32768", label => '/', rrdlabel => 'root', value => 382, uom => 'MB', warning => 15264, critical => 15269, min => 0, max => 32768, 
+  }, {
+    perfoutput => "/var=218MB;9443;9448", label => '/var', rrdlabel => 'var', value => '218', uom => 'MB', warning => 9443, critical => 9448, min => undef, max => undef,
+  },
+);
+
+# Round-trip tests
+for my $t (@test) {
+    # Parse to components
+    ($p) = Nagios::Plugin::Performance->parse_perfstring($t->{perfoutput});
+    for (sort keys %$t) {
+        next if m/^perfoutput$/;
+        is($p->$_(), $t->{$_}, "$_ okay (" . (defined $t->{$_} ? $t->{$_} : 'undef')  . ")");
+    }
+
+    # Construct from components
+    my @construct = qw(label value uom warning critical min max);
+    $p = Nagios::Plugin::Performance->new(map { $_ => $t->{$_} } @construct);
+    is($p->perfoutput, $t->{perfoutput}, "perfoutput okay ($t->{perfoutput})");
+    # Check threshold accessor
+    is($p->threshold->warning->end, $t->{warning}, "threshold warning okay ($t->{warning})");
+    is($p->threshold->critical->end, $t->{critical}, "threshold critical okay ($t->{critical})");
+
+    # Construct using threshold
+    @construct = qw(label value uom min max);
+    $p = Nagios::Plugin::Performance->new(
+        map({ $_ => $t->{$_} } @construct), 
+        threshold => Nagios::Plugin::Threshold->set_thresholds(warning => $t->{warning}, critical => $t->{critical}),
+    );
+    is($p->perfoutput, $t->{perfoutput}, "perfoutput okay ($t->{perfoutput})");
+    # Check warning/critical accessors
+    is($p->warning, $t->{warning}, "warning okay ($t->{warning})");
+    is($p->critical, $t->{critical}, "critical okay ($t->{critical})");
+}
+
+
+# Test multiple parse_perfstrings
+@p = Nagios::Plugin::Performance->parse_perfstring("/=382MB;15264;15269;; /var=218MB;9443;9448");
 cmp_ok( $p[0]->label, 'eq', "/", "label okay");
 cmp_ok( $p[0]->rrdlabel, 'eq', "root", "rrd label okay");
 cmp_ok( $p[0]->value, '==', 382, "value okay");
 cmp_ok( $p[0]->uom, 'eq', "MB", "uom okay");
 cmp_ok( $p[0]->threshold->warning->end, "==", 15264, "warn okay");
 cmp_ok( $p[0]->threshold->critical->end, "==", 15269, "crit okay");
-ok( ! defined $p[0]->min, "min okay");
-ok( ! defined $p[0]->max, "max okay");
+ok(! defined $p[0]->min, "min undef");
+ok(! defined $p[0]->max, "max undef");
 
 cmp_ok( $p[1]->label, 'eq', "/var", "label okay");
 cmp_ok( $p[1]->rrdlabel, 'eq', "var", "rrd label okay");
diff --git a/t/Nagios-Plugin-Threshold.t b/t/Nagios-Plugin-Threshold.t
index cdb8d77..ccb53eb 100644
--- a/t/Nagios-Plugin-Threshold.t
+++ b/t/Nagios-Plugin-Threshold.t
@@ -113,7 +113,7 @@ SKIP_DEATH:
 
 diag "threshold: critical if > 25 " if $ENV{TEST_VERBOSE};
 $t = Nagios::Plugin::Threshold->set_thresholds( critical => "~:25" );
-ok( defined $t, "Threshold ('', '~:25') set (".$t->critical->stringify().")" );
+ok( defined $t, "Threshold ('', '~:25') set (".$t->critical.")" );
 ok( ! $t->warning->is_set, "Warning not set");
 cmp_ok( $t->critical->end, '==',25, "Critical end set");
 ok $t->critical->start_infinity, "Critical starts at negative infinity";