Initial revision

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

4 files changed, 406 insertions, 0 deletions

diff --git a/lib/Nagios/Plugin/Base.pm b/lib/Nagios/Plugin/Base.pm
new file mode 100644
index 0000000..f3a7f7c
--- /dev/null
+++ b/lib/Nagios/Plugin/Base.pm
@@ -0,0 +1,65 @@
+# This module holds all exported variables
+# and base functions
+package Nagios::Plugin::Base;
+
+use strict;
+use warnings;
+
+use Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT = qw(%ERRORS);
+
+our %ERRORS=('OK'=>0,'WARNING'=>1,'CRITICAL'=>2,'UNKNOWN'=>3,'DEPENDENT'=>4);
+
+our %STATUS_TEXT = reverse %ERRORS;
+
+my $exit_on_die = 1;
+sub exit_on_die { shift; @_ ? $exit_on_die = shift : $exit_on_die };
+my $print_on_die = 1;
+sub print_on_die { shift; @_ ? $print_on_die = shift : $print_on_die };
+
+sub die {
+        my ($class, $args, $plugin) = @_;
+        my $return_code = $args->{return_code} || 3;
+        my $message = $args->{message} || "Internal error";
+        my $output = join(" ", $STATUS_TEXT{$return_code}, $message);
+        if ($plugin) {
+                $output = $plugin->shortname." $output" if $plugin->shortname;
+                $output .= " | ".$plugin->all_perfoutput if $plugin->perfdata;
+        }
+        if ($print_on_die) {
+                print $output, $/;
+        }
+        if ($exit_on_die) {
+                exit $return_code;
+        } else {
+                return $output;
+        }
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Nagios::Plugin::Base - Base functions for Nagios::Plugins
+
+=head1 DESCRIPTION
+
+See Nagios::Plugin for public interfaces. This module is for Nagios::Plugin developers to incorporate
+common backend functionality.
+
+=head1 AUTHOR
+
+Ton Voon, E<lt>ton.voon@altinity.comE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+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.
+
+
+=cut
diff --git a/lib/Nagios/Plugin/Performance.pm b/lib/Nagios/Plugin/Performance.pm
new file mode 100644
index 0000000..eee1bee
--- /dev/null
+++ b/lib/Nagios/Plugin/Performance.pm
@@ -0,0 +1,119 @@
+package Nagios::Plugin::Performance;
+
+use 5.008004;
+
+use strict;
+use warnings;
+
+use Carp;
+use Nagios::Plugin::Threshold;
+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\.]+)? *//;
+        return undef unless ($1 && $2);
+        $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);
+        return ($p, $string);
+}
+
+sub parse_perfstring {
+        my ($class, $perfstring) = @_;
+        my @perfs;
+        my $obj;
+        while ($perfstring) {
+                ($obj, $perfstring) = $class->_parse($perfstring);
+                return undef unless $obj;
+                push @perfs, $obj;
+        }
+        return undef unless @perfs;
+        return @perfs;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Nagios::Plugin::Performance - Performance information in a perl object
+
+=head1 SYNOPSIS
+
+  use Nagios::Plugin::Performance;
+
+  @p = Nagios::Plugin::Performance->parse_perfstring("/=382MB;15264;15269;; /var=218MB;9443;9448");
+  print "1st label = ", $p[0]->label, $/;
+  print "1st uom   = ", $p[0]->uom, $/;
+  print "2nd crit  = ", $p[1]->threshold->critical, $/;
+
+=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).
+
+Once the performance string has been parsed, you can query the label, value, uom, or thresholds.
+
+=head1 CLASS METHODS
+
+=over 4
+
+=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, undef is returned.
+
+=head1 OBJECT METHODS
+
+=item label, value, uom, min, max
+
+These all return scalars. min and max are not well supported yet.
+
+=item threshold
+
+This returns a Nagios::Plugin::Threshold object.
+
+=back 
+
+=head1 SEE ALSO
+
+Nagios::Plugin for information about versioning.
+
+http://nagiosplug.sourceforge.net
+
+=head1 AUTHOR
+
+Ton Voon, E<lt>ton.voon@altinity.comE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2006 by Altinity Limited
+
+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.
+
+
+=cut
diff --git a/lib/Nagios/Plugin/Range.pm b/lib/Nagios/Plugin/Range.pm
new file mode 100644
index 0000000..3d6f613
--- /dev/null
+++ b/lib/Nagios/Plugin/Range.pm
@@ -0,0 +1,126 @@
+package Nagios::Plugin::Range;
+
+use 5.008004;
+
+use strict;
+use warnings;
+
+use overload
+        '""' => sub { shift->stringify };
+
+use Class::Struct;
+struct "Nagios::Plugin::Range" => {
+        start => '$',
+        end => '$',
+        start_infinity => '$',  # TRUE / FALSE
+        end_infinity => '$',    # TRUE / FALSE
+        alert_on => '$',        # OUTSIDE 0, INSIDE 1
+        };
+
+my $outside = 0;
+my $inside = 1;
+
+sub stringify {
+        my $self = shift;
+        return (($self->alert_on) ? "@" : "") .
+                (($self->start_infinity == 1) ? "~:" : (($self->start == 0)?"":$self->start.":")) . 
+                (($self->end_infinity == 1) ? "" : $self->end);
+}
+
+sub set_range_start {
+        my ($self, $value) = @_;
+        $self->start($value+0); # Force scalar into number
+        $self->start_infinity(0);
+}
+
+sub set_range_end {
+        my ($self, $value) = @_;
+        $self->end($value+0);   # Force scalar into number
+        $self->end_infinity(0);
+}
+
+# Returns a N::P::Range object if the string is a conforms to a Nagios Plugin range string, otherwise null
+sub parse_range_string {
+        my ($class, $string) = @_;
+        my $valid = 0;
+        my $range = $class->new( start => 0, start_infinity => 0, end => 0, end_infinity => 1, alert_on => $outside);
+
+        if ($string =~ s/^\@//) {
+                $range->alert_on($inside);
+        }
+        if ($string =~ s/^~//) {
+                $range->start_infinity(1);
+        }
+        if (($_) = $string =~ /^([-\d\.]+)?:/) {
+                $range->set_range_start($_) if defined $_;
+                $string =~ s/^([-\d\.]+)?://;
+                $valid++
+        }
+        if ($string =~ /^([-\d\.]+)$/) {
+                $range->set_range_end($string);
+                $valid++;
+        }
+
+        if ($valid && ($range->start_infinity == 1 || $range->end_infinity == 1 || $range->start <= $range->end)) {
+                return $range;
+        }
+        return undef;
+}
+
+# Returns 1 if an alert should be raised, otherwise 0
+sub check_range {
+        my ($self, $value) = @_;
+        my $false = 0;
+        my $true = 1;
+        if ($self->alert_on == $inside) {
+                $false = 1;
+                $true = 0;
+        }
+        if ($self->end_infinity == 0 && $self->start_infinity == 0) {
+                if ($self->start <= $value && $value <= $self->end) {
+                        return $false;
+                } else {
+                        return $true;
+                }
+        } elsif ($self->start_infinity == 0 && $self->end_infinity == 1) {
+                if ($self->start <= $value) {
+                        return $false;
+                } else {
+                        return $true;
+                }
+        } elsif ($self->start_infinity == 1 && $self->end_infinity == 0) {
+                if ($value <= $self->end) {
+                        return $false;
+                } else {
+                        return $true;
+                }
+        } else {
+                return $false;
+        }
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Nagios::Plugin::Range - Common range functions for Nagios::Plugin
+
+=head1 DESCRIPTION
+
+Handles common Nagios Plugin range data. See Nagios::Plugin for creation interfaces.
+
+=head1 AUTHOR
+
+Ton Voon, E<lt>ton.voon@altinity.comE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2006 by Altinity Limited
+
+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.
+
+
+=cut
diff --git a/lib/Nagios/Plugin/Threshold.pm b/lib/Nagios/Plugin/Threshold.pm
new file mode 100644
index 0000000..9c5d042
--- /dev/null
+++ b/lib/Nagios/Plugin/Threshold.pm
@@ -0,0 +1,96 @@
+package Nagios::Plugin::Threshold;
+
+use 5.008004;
+
+use strict;
+use warnings;
+
+use Nagios::Plugin::Range;
+use Nagios::Plugin::Base;
+
+use Class::Struct;
+struct "Nagios::Plugin::Threshold" => {
+        warning => 'Nagios::Plugin::Range',
+        critical => 'Nagios::Plugin::Range',
+        };
+
+sub set_thresholds {
+        my ($class, %args) = @_;
+        my $t = $class->new;
+        if (defined $args{warning}) {
+                my $r = Nagios::Plugin::Range->parse_range_string($args{warning});
+                if (defined $r) {
+                        $t->warning($r);
+                } else {
+                        Nagios::Plugin::Base->die( {
+                                return_code => $ERRORS{UNKNOWN}, 
+                                message => "Warning range incorrect: '$args{warning}'"
+                                } );
+                }
+        }
+        if (defined $args{critical}) {
+                my $r = Nagios::Plugin::Range->parse_range_string($args{critical});
+                if (defined $r) {
+                        $t->critical($r);
+                } else {
+                        Nagios::Plugin::Base->die( {
+                                return_code => $ERRORS{UNKNOWN}, 
+                                message => "Critical range incorrect: '$args{critical}'"
+                                } );
+                }
+        }
+        return $t;
+}
+
+sub get_status {
+        my ($self, $value) = @_;
+        if ($self->critical) {
+                if ($self->critical->check_range($value) == 1) {
+                        return $ERRORS{CRITICAL};
+                }
+        }
+        if ($self->warning) {
+                if ($self->warning->check_range($value) == 1) {
+                        return $ERRORS{WARNING};
+                }
+        }
+}
+                
+1;
+__END__
+
+=head1 NAME
+
+Nagios::Plugin::Threshold - Threshold information in a perl object
+
+=head1 DESCRIPTION
+
+Handles common Nagios Plugin threshold data. See Nagios::Plugin or Nagios::Plugin::Performance for 
+creation of this object.
+
+=head1 OBJECT METHODS
+
+=over 4
+
+=item warning, critical
+
+Returns the warning or critical range as a Nagios::Plugin::Range object.
+
+=item get_status($value)
+
+Given a value, will see if the value breeches the critical or the warning range. Returns the status code.
+
+=head1 AUTHOR
+
+Ton Voon, E<lt>ton.voon@altinity.comE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2006 by Altinity Limited
+
+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.
+
+
+=cut