Added clean_label, like rrdlabel, but without truncation

5 files changed, 33 insertions, 15 deletions

diff --git a/Changes b/Changes
index 78382e1..90a1e0c 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,8 @@
 Revision history for Perl module Nagios::Plugin.
 
+0.29 2nd December 2008
+  - clean_label, for cleaning up a label for RRD, but without truncation
+
 0.28 21st November 2008
   - Fixed test problems when run against Test::More 0.86
   - Added max_state_* wrappers
diff --git a/lib/Nagios/Plugin.pm b/lib/Nagios/Plugin.pm
index 7299929..eb3ccdc 100644
--- a/lib/Nagios/Plugin.pm
+++ b/lib/Nagios/Plugin.pm
@@ -25,7 +25,7 @@ our @EXPORT_OK = qw(%ERRORS);
 # CPAN stupidly won't index this module without a literal $VERSION here,
 #   so we're forced to duplicate it explicitly
 # Make sure you update $Nagios::Plugin::Functions::VERSION too
-our $VERSION = "0.28";
+our $VERSION = "0.29";
 
 sub new {
         my $class = shift;
diff --git a/lib/Nagios/Plugin/Functions.pm b/lib/Nagios/Plugin/Functions.pm
index 74a7c6b..ffa23f0 100644
--- a/lib/Nagios/Plugin/Functions.pm
+++ b/lib/Nagios/Plugin/Functions.pm
@@ -12,7 +12,7 @@ use Params::Validate qw(:types validate);
 use Math::Calc::Units;
 
 # Remember to update Nagios::Plugins as well
-our $VERSION = "0.28";
+our $VERSION = "0.29";
 
 our @STATUS_CODES = qw(OK WARNING CRITICAL UNKNOWN DEPENDENT);
 
diff --git a/lib/Nagios/Plugin/Performance.pm b/lib/Nagios/Plugin/Performance.pm
index a7655fc..a9f9198 100644
--- a/lib/Nagios/Plugin/Performance.pm
+++ b/lib/Nagios/Plugin/Performance.pm
@@ -70,18 +70,22 @@ sub parse_perfstring {
 
 sub rrdlabel {
         my $self = shift;
+        my $name = $self->clean_label;
+        # Shorten
+        return substr( $name, 0, 19 );
+}
+
+sub clean_label {
+        my $self = shift;
         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
+        # Convert all other characters
         $name =~ s/\W/_/g;
-        # Shorten
-        return substr( $name, 0, 19 );
+        return $name;
 }
 
 # Backward compatibility: create a threshold object on the fly as requested
@@ -212,9 +216,18 @@ 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_].
 
+This calls $self->clean_label and then truncates to 19 characters.
+
 There is no guarantee that multiple N:P:Performance objects will have unique 
 rrdlabels.
 
+=item clean_label
+
+Returns a "clean" label for use as a dataset name in RRD, ie, it converts
+characters that are not [a-zA-Z0-9_] to _.
+
+It also converts "/" to "root" and "/{name}" to "{name}".
+
 =item perfoutput
 
 Outputs the data in Nagios::Plugin perfdata format i.e. 
diff --git a/t/Nagios-Plugin-Performance.t b/t/Nagios-Plugin-Performance.t
index fa36ce0..ceb82c5 100644
--- a/t/Nagios-Plugin-Performance.t
+++ b/t/Nagios-Plugin-Performance.t
@@ -1,6 +1,6 @@
 
 use strict;
-use Test::More tests => 123;
+use Test::More;
 BEGIN { use_ok('Nagios::Plugin::Performance') };
 
 diag "\nusing Nagios::Plugin::Performance revision ". $Nagios::Plugin::Performance::VERSION . "\n" if $ENV{TEST_VERBOSE};
@@ -11,20 +11,20 @@ Nagios::Plugin::Functions::_fake_exit(1);
 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 => "/=382MB;15264;15269;0;32768", label => '/', rrdlabel => 'root', value => 382, uom => 'MB', warning => 15264, critical => 15269, min => 0, max => 32768, clean_label => "root",
   }, {
-    perfoutput => "/var=218MB;9443;9448", label => '/var', rrdlabel => 'var', value => '218', uom => 'MB', warning => 9443, critical => 9448, min => undef, max => undef,
+    perfoutput => "/var=218MB;9443;9448", label => '/var', rrdlabel => 'var', value => '218', uom => 'MB', warning => 9443, critical => 9448, min => undef, max => undef, clean_label => "var",
+  }, {
+    perfoutput => '/var/long@:-/filesystem/name/and/bad/chars=218MB;9443;9448', label => '/var/long@:-/filesystem/name/and/bad/chars', rrdlabel => 'var_long____filesys', value => '218', uom => 'MB', warning => 9443, critical => 9448, min => undef, max => undef, clean_label => 'var_long____filesystem_name_and_bad_chars',
   },
 );
 
+plan tests => (8 * scalar @test) + 94;
+
 # 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);
@@ -33,6 +33,8 @@ for my $t (@test) {
     # 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})");
+    is($p->rrdlabel, $t->{rrdlabel}, "rrdlabel okay");
+    is($p->clean_label, $t->{clean_label}, "clean_label okay" );
 
     # Construct using threshold
     @construct = qw(label value uom min max);