Monitoring-Plugin-0.39/0000755000175000017500000000000012512177466013551 5ustar svensvenMonitoring-Plugin-0.39/notes0000644000175000017500000000055412267222710014616 0ustar svensvenRELEASING Change version number in lib/Monitoring/Plugin.pm and lib/Monitoring/Plugin/Functions.pm Add date to Changes file git commit perl Makefile.PL make make test make dist Upload file to CPAN Send announcement to announce@monitoring-plugins.org, help@monitoring-plugins.org and devel@monitoring-plugins.org Add news item to https://monitoring-plugins.org Monitoring-Plugin-0.39/MANIFEST0000644000175000017500000000370512267224536014705 0ustar svensvenChanges inc/Module/Install.pm inc/Module/Install/Base.pm inc/Module/Install/Can.pm inc/Module/Install/Fetch.pm inc/Module/Install/Makefile.pm inc/Module/Install/Metadata.pm inc/Module/Install/Win32.pm inc/Module/Install/WriteAll.pm lib/Monitoring/Plugin.pm lib/Monitoring/Plugin/Config.pm lib/Monitoring/Plugin/ExitResult.pm lib/Monitoring/Plugin/Functions.pm lib/Monitoring/Plugin/Getopt.pm lib/Monitoring/Plugin/Performance.pm lib/Monitoring/Plugin/Range.pm lib/Monitoring/Plugin/Threshold.pm Makefile.PL MANIFEST This list of files META.yml notes README t/check_stuff.pl t/check_stuff.t t/Monitoring-Plugin-01.t t/Monitoring-Plugin-02.t t/Monitoring-Plugin-03.t t/Monitoring-Plugin-04.t t/Monitoring-Plugin-05.t t/Monitoring-Plugin-Functions-01.t t/Monitoring-Plugin-Functions-02.t t/Monitoring-Plugin-Functions-03.t t/Monitoring-Plugin-Functions-04.t t/Monitoring-Plugin-Getopt-01.t t/Monitoring-Plugin-Getopt-02.t t/Monitoring-Plugin-Getopt-03.t t/Monitoring-Plugin-Getopt-04.t t/Monitoring-Plugin-Performance-02.t t/Monitoring-Plugin-Performance.t t/Monitoring-Plugin-Range.t t/Monitoring-Plugin-Threshold.t t/npg03/expected/00_basic t/npg03/expected/00_noextra t/npg03/expected/01_override1 t/npg03/expected/02_override2 t/npg03/expected/05_disk1 t/npg03/expected/05_disk2 t/npg03/expected/05_disk3 t/npg03/expected/05_disk4 t/npg03/expected/05_disk5 t/npg03/expected/05_disk6 t/npg03/expected/05_disk7 t/npg03/expected/09_funnystuff t/npg03/expected/12_nosection_implicit t/npg03/expected/15_badsection_catch t/npg03/input/00_basic t/npg03/input/00_noextra t/npg03/input/01_override1 t/npg03/input/02_override2 t/npg03/input/05_disk1 t/npg03/input/05_disk2 t/npg03/input/05_disk3 t/npg03/input/05_disk4 t/npg03/input/05_disk5 t/npg03/input/05_disk6 t/npg03/input/05_disk7 t/npg03/input/09_funnystuff t/npg03/input/12_nosection_implicit t/npg03/input/13_nosection_explicit_dies t/npg03/input/14_badsection_dies t/npg03/input/15_badsection_catch t/npg03/plugins.ini t/npg03/README Monitoring-Plugin-0.39/META.yml0000644000175000017500000000150612512177301015010 0ustar svensven--- abstract: ~ author: - 'This code is maintained by the Monitoring Plugin Development Team: see' - 'Monitoring Plugin Team ' build_requires: ExtUtils::MakeMaker: 6.59 Test::More: 0.62 configure_requires: ExtUtils::MakeMaker: 6.59 distribution_type: module dynamic_config: 1 generated_by: 'Module::Install version 1.06' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Monitoring-Plugin no_index: directory: - inc - t requires: Carp: 0 Class::Accessor: 0 Config::Tiny: 0 File::Basename: 0 File::Spec: 0 IO::File: 0 Math::Calc::Units: 0 Params::Validate: 0 perl: 5.6.0 resources: license: http://dev.perl.org/licenses/ repository: https://github.com/monitoring-plugins/monitoring-plugin-perl version: 0.39 Monitoring-Plugin-0.39/Changes0000644000175000017500000001045112512177202015031 0ustar svensvenRevision history for Perl module Monitoring::Plugin. 0.39 11th April 2015 - fix help formating when using colons (Evgeni Golov) - fix "Redundant argument in sprintf" in perl 5.21 (RT #103214) 0.38 28th December 2014 - fix getopt test on windows system 0.37 20nd January 2014 - renamed module due to trademark issues 0.36 22nd December 2011 - Updated check_threshold to allow multiple check values to be checked at once 0.35 3rd December 2010 - Fixed test failures with Test::More 0.96 (Slaven Rezic and Peter John Edwards - RT57709) 0.34 15th April 2010 - Amended standard --extra-opts help - pod fix (Frank Wiegand - RT51872) - Added %STATUS_TEXT to valid possible exports (Andrew Ford - RT46048) 0.33 5th June 2009 - Fixed infinite loop when invalid performance data with multiple = were present 0.32 3rd March 2009 - Handle performance data with quotes in the label (thanks to Kang) - Die if default config file is not available and --extra-opts is set 0.31 5th January 2009 - Check for valid numerical value before returning perfdata object 0.30 13th December 2008 - Fixed performance parsing when numeric fields had commas instead of periods due to locale settings - If a performance set is not parseable, instead of returning an empty array, will return all the successfully parsed sets - Fixed test plan for Nagios-Plugin-Performance.t 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 0.27 14th May 2008 - Fixed parsing of performance data with scientific notation 0.26 28th March 2008 - Fixed test failure in t/Nagios-Plugin-Getopt-03.t (Thomas Guyot-Sionnest) 0.25 17th March 2008 - Fixed parsing of performance data with negative values and full range definitions 0.24 1st February 2008 - Fixed a test failure which highlighted a precision rounding within hashes 0.23 18th December 2007 - Use $^X for perl in check_stuff.t test, due to lots of failing in CPAN Testers 0.22 13th December 2007 - Fixed handling of repeated ini arguments 0.21 24th September 2007 - Help, usage and version output now goes to stdout, not stderr 0.20 5th September 2007 - Version bump because of CPAN permission problems 0.19 4th September 2007 - Fix test failures due to bad MANIFEST file - Fixed performance parsing where uom = % - Fixed version numbering 0.18 31st August 2007 - Fix error when parsing performance data where warn or crit are 0 - Optional _use_die flag to force nagios_die to call die instead of exit, so exceptions can be caught with an eval - Convenience function to set use_die so you can run 'use Nagios::Plugin::Performance use_die => 1' 0.17 23rd March 2007 - bump version number again due to cpan indexing stupidity (Gavin) 0.16 23rd March 2007 - added support for multi-entry help output (e.g. two separate help entries for --warning) (Gavin) - added automatic spec-to-help-text support to N::P::Getopt (Gavin) - added initial --extra-opts support to N::P::Getopt (Gavin) - removed default use of Threshold from N::P::Performance (Gavin) - removed remaining Class::Struct usages from Performance, Threshold, and Range (Gavin) - fixed warnings when no uom specified for add_perfdata (Ton) - added max_state function in N::P::Functions (Ton) 0.15 19th December 2006 - exposed Getopt and Threshold functionality from top level Nagios::Plugin - exchanged Class::Struct for Class::Accessor 0.14 18th October 2006 - Fixed version number due to CPAN upload 0.13 18th October 2006 - Lots of extra tests and fixes from Nathan Vonnahme - Nagios::Plugin::Getopt, Functions and ExitResult added by Gavin Carr 0.12 15th June 2006 - rrdlabel method available to get a performance label, converted to something rrd can use - fixes to parse_perfstring routine if values are 0 - is_set method for range object to see if warning/critical range is set 0.11 14th June 2006 - Interface changed for parse_perfstring, returning empty array if not parseable - Fixed problem when parsing nagiosgraph data (linefeed at end of perfdata) 0.10 8th June 2006 First release to CPAN 0.01 Fri Jun 2 14:10:58 2006 - original version; created by h2xs 1.23 with options -X -n Nagios::Plugin Monitoring-Plugin-0.39/t/0000755000175000017500000000000012512177466014014 5ustar svensvenMonitoring-Plugin-0.39/t/Monitoring-Plugin-Functions-03.t0000644000175000017500000000120112267053414021733 0ustar svensven# max_state tests use strict; use Test::More tests => 8; BEGIN { use_ok("Monitoring::Plugin::Functions", ":all") } my $new_state = max_state( OK, WARNING ); is( $new_state, WARNING, "Moved up to WARNING" ); is( max_state( $new_state, UNKNOWN ), WARNING, "Still at WARNING" ); $new_state = max_state( $new_state, CRITICAL ); is( $new_state, CRITICAL, "Now at CRITICAL" ); is( max_state( OK, OK ), OK, "This is OK" ); is( max_state( OK, UNKNOWN ), OK, "This is still OK, not UNKNOWN" ); is( max_state( OK, OK, OK, OK, OK, WARNING ), WARNING, "Use WARNING in this list" ); is( max_state(), UNKNOWN, "Return UNKNOWN if no parameters" ); Monitoring-Plugin-0.39/t/Monitoring-Plugin-02.t0000644000175000017500000001372212267062417020002 0ustar svensven# Monitoring::Plugin test set 2, testing MP::Functions wrapping use strict; use Test::More tests => 103; BEGIN { use_ok("Monitoring::Plugin") } require Monitoring::Plugin::Functions; Monitoring::Plugin::Functions::_fake_exit(1); # Hardcoded checks of constants my %ERRORS = %Monitoring::Plugin::Functions::ERRORS; is(OK, $ERRORS{OK}, "OK => $ERRORS{OK}"); is(WARNING, $ERRORS{WARNING}, "WARNING => $ERRORS{WARNING}"); is(CRITICAL, $ERRORS{CRITICAL}, "CRITICAL => $ERRORS{CRITICAL}"); is(UNKNOWN, $ERRORS{UNKNOWN}, "UNKNOWN => $ERRORS{UNKNOWN}"); is(DEPENDENT, $ERRORS{DEPENDENT}, "DEPENDENT => $ERRORS{DEPENDENT}"); my $plugin = 'TEST_PLUGIN'; my $np = Monitoring::Plugin->new( shortname => $plugin ); is($np->shortname, $plugin, "shortname() is $plugin"); # Test plugin_exit( CONSTANT, $msg ), plugin_exit( $string, $msg ) my $r; my @ok = ( [ OK, "OK", 'test the first', ], [ WARNING, "WARNING", 'test the second', ], [ CRITICAL, "CRITICAL", 'test the third', ], [ UNKNOWN, "UNKNOWN", 'test the fourth', ], [ DEPENDENT, "DEPENDENT", 'test the fifth', ], ); for (@ok) { # CONSTANT $r = $np->plugin_exit($_->[0], $_->[2]); is($r->return_code, $_->[0], sprintf('plugin_exit(%s, $msg) returned %s', $_->[1], $_->[0])); like($r->message, qr/$plugin\b.*$_->[1]\b.*\b$_->[2]$/, sprintf('plugin_exit(%s, $msg) output matched "%s"', $_->[1], $plugin . ' ' . $_->[1] . '.*' . $_->[2])); # $string $r = $np->plugin_exit($_->[1], $_->[2]); is($r->return_code, $_->[0], sprintf('plugin_exit("%s", $msg) returned %s', $_->[1], $_->[0])); like($r->message, qr/$plugin\b.*$_->[1]\b.*\b$_->[2]$/, sprintf('plugin_exit("%s", $msg) output matched "%s"', $_->[1], $plugin . ' ' . $_->[1] . '.*' . $_->[2])); like($r, qr/$plugin\b.*$_->[1]\b.*\b$_->[2]$/, sprintf('plugin_exit("%s", $msg) stringified matched "%s"', $_->[1], $plugin . ' ' . $_->[1] . '.*' . $_->[2])); } # plugin_exit code corner cases my @ugly1 = ( [ -1, 'testing code -1' ], [ 7, 'testing code 7' ], [ undef, 'testing code undef' ], [ '', qq(testing code '') ], [ 'string', qq(testing code 'string') ], ); for (@ugly1) { $r = $np->plugin_exit($_->[0], $_->[1]); my $display = defined $_->[0] ? "'$_->[0]'" : 'undef'; is($r->return_code, UNKNOWN, "plugin_exit($display, \$msg) returned ". UNKNOWN); like($r->message, qr/UNKNOWN\b.*\b$_->[1]$/, sprintf('plugin_exit(%s, $msg) output matched "%s"', $display, 'UNKNOWN.*' . $_->[1])); } # plugin_exit message corner cases my @ugly2 = ( [ '' ], [ undef ], [ UNKNOWN ], ); for (@ugly2) { $r = $np->plugin_exit(CRITICAL, $_->[0]); my $display1 = defined $_->[0] ? "'$_->[0]'" : "undef"; my $display2 = defined $_->[0] ? $_->[0] : ''; like($r->message, qr/CRITICAL\b.*\b$display2$/, sprintf('plugin_exit(%s, $msg) output matched "%s"', $display1, "CRITICAL.*$display2")); } # Test plugin_die( $msg ) my @msg = ( [ 'die you dog' ], [ '' ], [ undef ], ); for (@msg) { $r = $np->plugin_die($_->[0]); my $display1 = defined $_->[0] ? "'$_->[0]'" : "undef"; my $display2 = defined $_->[0] ? $_->[0] : ''; is($r->return_code, UNKNOWN, sprintf('plugin_die(%s) returned UNKNOWN', $display1)); like($r->message, qr/UNKNOWN\b.*\b$display2$/, sprintf('plugin_die(%s) output matched "%s"', $display1, "UNKNOWN.*$display2")); } # Test plugin_die( CONSTANT, $msg ), plugin_die( $msg, CONSTANT ), # plugin_die( $string, $msg ), and plugin_die( $msg, $string ) @ok = ( [ OK, "OK", 'test the first', ], [ WARNING, "WARNING", 'test the second', ], [ CRITICAL, "CRITICAL", 'test the third', ], [ UNKNOWN, "UNKNOWN", 'test the fourth', ], [ DEPENDENT, "DEPENDENT", 'test the fifth', ], ); for (@ok) { # CONSTANT, $msg $r = $np->plugin_die($_->[0], $_->[2]); is($r->return_code, $_->[0], sprintf('plugin_die(%s, $msg) returned %s', $_->[1], $_->[0])); like($r->message, qr/$_->[1]\b.*\b$_->[2]$/, sprintf('plugin_die(%s, $msg) output matched "%s"', $_->[1], $_->[1] . '.*' . $_->[2])); # $msg, CONSTANT $r = $np->plugin_die($_->[2], $_->[0]); is($r->return_code, $_->[0], sprintf('plugin_die($msg, %s) returned %s', $_->[1], $_->[0])); like($r->message, qr/$_->[1]\b.*\b$_->[2]$/, sprintf('plugin_die($msg, %s) output matched "%s"', $_->[1], $_->[1] . '.*' . $_->[2])); # $string, $msg $r = $np->plugin_die($_->[1], $_->[2]); is($r->return_code, $_->[0], sprintf('plugin_die("%s", $msg) returned %s', $_->[1], $_->[0])); like($r->message, qr/$_->[1]\b.*\b$_->[2]$/, sprintf('plugin_die("%s", $msg) output matched "%s"', $_->[1], $_->[1] . '.*' . $_->[2])); like($r, qr/$_->[1]\b.*\b$_->[2]$/, sprintf('plugin_die("%s", $msg) stringified matched "%s"', $_->[1], $_->[1] . '.*' . $_->[2])); # $string, $msg $r = $np->plugin_die($_->[2], $_->[1]); is($r->return_code, $_->[0], sprintf('plugin_die($msg, "%s") returned %s', $_->[1], $_->[0])); like($r->message, qr/$_->[1]\b.*\b$_->[2]$/, sprintf('plugin_die($msg, "%s") output matched "%s"', $_->[1], $_->[1] . '.*' . $_->[2])); like($r, qr/$_->[1]\b.*\b$_->[2]$/, sprintf('plugin_die($msg, "%s") stringified matched "%s"', $_->[1], $_->[1] . '.*' . $_->[2])); } # shortname testing SKIP: { skip "requires File::Basename", 2 unless eval { require File::Basename }; $np = Monitoring::Plugin->new( version => "1"); $plugin = uc File::Basename::basename($0); $plugin =~ s/\..*$//; is($np->shortname, $plugin, "shortname() is '$plugin'"); $r = $np->plugin_exit(OK, "foobar"); like($r->message, qr/^$plugin OK/, "message begins with '$plugin OK'"); } Monitoring-Plugin-0.39/t/Monitoring-Plugin-Functions-01.t0000644000175000017500000001372112506345036021743 0ustar svensven use strict; use Test::More tests => 113; BEGIN { use_ok("Monitoring::Plugin::Functions", ":all"); } Monitoring::Plugin::Functions::_fake_exit(1); my $this_version=$Monitoring::Plugin::Functions::VERSION; foreach my $m ("", qw(::Threshold ::Getopt ::Performance ::Range)) { my $mod = "Monitoring::Plugin$m"; use_ok($mod); # Lots of hackery below. Easier to say $mod->VERSION, but this is probably a recent perl thing my $v = "$mod"."::VERSION"; my $a = eval "\$$v"; is($a, $this_version, "Version number for $mod the same as Functions: $this_version"); } # check get_shortname is(get_shortname, "MONITORING-PLUGIN-FUNCTIONS-01", "get_shortname ok"); # Hardcoded checks of constants ok(%ERRORS, '%ERRORS defined'); is(OK, $ERRORS{OK}, "OK => $ERRORS{OK}"); is(WARNING, $ERRORS{WARNING}, "WARNING => $ERRORS{WARNING}"); is(CRITICAL, $ERRORS{CRITICAL}, "CRITICAL => $ERRORS{CRITICAL}"); is(UNKNOWN, $ERRORS{UNKNOWN}, "UNKNOWN => $ERRORS{UNKNOWN}"); is(DEPENDENT, $ERRORS{DEPENDENT}, "DEPENDENT => $ERRORS{DEPENDENT}"); # Test plugin_exit( CONSTANT, $msg ), plugin_exit( $string, $msg ) my $r; my @ok = ( [ OK, "OK", 'test the first', ], [ WARNING, "WARNING", 'test the second', ], [ CRITICAL, "CRITICAL", 'test the third', ], [ UNKNOWN, "UNKNOWN", 'test the fourth', ], [ DEPENDENT, "DEPENDENT", 'test the fifth', ], ); for (@ok) { # CONSTANT $r = plugin_exit($_->[0], $_->[2]); is($r->return_code, $_->[0], sprintf('plugin_exit(%s, $msg) returned %s', $_->[1], $_->[0])); like($r->message, qr/$_->[1]\b.*\b$_->[2]$/, sprintf('plugin_exit(%s, $msg) output matched "%s"', $_->[1], $_->[1] . '.*' . $_->[2])); # $string $r = plugin_exit($_->[1], $_->[2]); is($r->return_code, $_->[0], sprintf('plugin_exit("%s", $msg) returned %s', $_->[1], $_->[0])); like($r->message, qr/$_->[1]\b.*\b$_->[2]$/, sprintf('plugin_exit("%s", $msg) output matched "%s"', $_->[1], $_->[1] . '.*' . $_->[2])); like($r, qr/$_->[1]\b.*\b$_->[2]$/, sprintf('plugin_exit("%s", $msg) stringified matched "%s"', $_->[1], $_->[1] . '.*' . $_->[2])); } # plugin_exit code corner cases my @ugly1 = ( [ -1, 'testing code -1' ], [ 7, 'testing code 7' ], [ undef, 'testing code undef' ], [ '', qq(testing code '') ], [ 'string', qq(testing code 'string') ], ); for (@ugly1) { $r = plugin_exit($_->[0], $_->[1]); my $display = defined $_->[0] ? "'$_->[0]'" : 'undef'; is($r->return_code, UNKNOWN, "plugin_exit($display, \$msg) returned ". UNKNOWN); like($r->message, qr/UNKNOWN\b.*\b$_->[1]$/, sprintf('plugin_exit(%s, $msg) output matched "%s"', $display, 'UNKNOWN.*' . $_->[1])); } # plugin_exit message corner cases my @ugly2 = ( [ '' ], [ undef ], [ UNKNOWN ], ); for (@ugly2) { $r = plugin_exit(CRITICAL, $_->[0]); my $display1 = defined $_->[0] ? "'$_->[0]'" : "undef"; my $display2 = defined $_->[0] ? $_->[0] : ''; like($r->message, qr/CRITICAL\b.*\b$display2$/, sprintf('plugin_exit(%s, $msg) output matched "%s"', $display1, "CRITICAL.*$display2")); } # Test plugin_die( $msg ) my @msg = ( [ 'die you dog' ], [ '' ], [ undef ], ); for (@msg) { $r = plugin_die($_->[0]); my $display1 = defined $_->[0] ? "'$_->[0]'" : "undef"; my $display2 = defined $_->[0] ? $_->[0] : ''; is($r->return_code, UNKNOWN, sprintf('plugin_die(%s) returned UNKNOWN', $display1)); like($r->message, qr/UNKNOWN\b.*\b$display2$/, sprintf('plugin_die(%s) output matched "%s"', $display1, "UNKNOWN.*$display2")); } # Test plugin_die( CONSTANT, $msg ), plugin_die( $msg, CONSTANT ), # plugin_die( $string, $msg ), and plugin_die( $msg, $string ) @ok = ( [ OK, "OK", 'test the first', ], [ WARNING, "WARNING", 'test the second', ], [ CRITICAL, "CRITICAL", 'test the third', ], [ UNKNOWN, "UNKNOWN", 'test the fourth', ], [ DEPENDENT, "DEPENDENT", 'test the fifth', ], ); for (@ok) { # CONSTANT, $msg $r = plugin_die($_->[0], $_->[2]); is($r->return_code, $_->[0], sprintf('plugin_die(%s, $msg) returned %s', $_->[1], $_->[0])); like($r->message, qr/$_->[1]\b.*\b$_->[2]$/, sprintf('plugin_die(%s, $msg) output matched "%s"', $_->[1], $_->[1] . '.*' . $_->[2])); # $msg, CONSTANT $r = plugin_die($_->[2], $_->[0]); is($r->return_code, $_->[0], sprintf('plugin_die($msg, %s) returned %s', $_->[1], $_->[0])); like($r->message, qr/$_->[1]\b.*\b$_->[2]$/, sprintf('plugin_die($msg, %s) output matched "%s"', $_->[1], $_->[1] . '.*' . $_->[2])); # $string, $msg $r = plugin_die($_->[1], $_->[2]); is($r->return_code, $_->[0], sprintf('plugin_die("%s", $msg) returned %s', $_->[1], $_->[0])); like($r->message, qr/$_->[1]\b.*\b$_->[2]$/, sprintf('plugin_die("%s", $msg) output matched "%s"', $_->[1], $_->[1] . '.*' . $_->[2])); like($r, qr/$_->[1]\b.*\b$_->[2]$/, sprintf('plugin_die("%s", $msg) stringified matched "%s"', $_->[1], $_->[1] . '.*' . $_->[2])); # $string, $msg $r = plugin_die($_->[2], $_->[1]); is($r->return_code, $_->[0], sprintf('plugin_die($msg, "%s") returned %s', $_->[1], $_->[0])); like($r->message, qr/$_->[1]\b.*\b$_->[2]$/, sprintf('plugin_die($msg, "%s") output matched "%s"', $_->[1], $_->[1] . '.*' . $_->[2])); like($r, qr/$_->[1]\b.*\b$_->[2]$/, sprintf('plugin_die($msg, "%s") stringified matched "%s"', $_->[1], $_->[1] . '.*' . $_->[2])); } # Check that _use_die set to 1 will catch exceptions correctly Monitoring::Plugin::Functions::_fake_exit(0); Monitoring::Plugin::Functions::_use_die(1); eval { plugin_die("Using die") }; is( $@, "MONITORING-PLUGIN-FUNCTIONS-01 UNKNOWN - Using die\n", "Caught exception"); Monitoring-Plugin-0.39/t/Monitoring-Plugin-Getopt-02.t0000644000175000017500000000271212267053357021242 0ustar svensven# Monitoring::Plugin::Getopt timeout tests use strict; use Test::More tests => 14; BEGIN { use_ok('Monitoring::Plugin::Getopt') }; # Needed to get evals to work in testing Monitoring::Plugin::Functions::_use_die(1); my %PARAM = ( version => '0.01', url => 'http://www.openfusion.com.au/labs/nagios/', blurb => 'This plugin tests various stuff.', usage => "Usage: %s -H -w -c ", plugin => 'test_plugin', timeout => 18, ); sub setup { # Instantiate object my $ng = Monitoring::Plugin::Getopt->new(%PARAM); ok($ng, 'constructor ok'); return $ng; } my $ng; # No args @ARGV = qw(); $ng = setup(); $ng->getopts; is($ng->timeout, 18, 'default timeout set to 18'); # Check help message @ARGV = ( '-h' ); $ng = setup; ok(! defined eval { $ng->getopts }, 'getopts died on help'); like($@, qr/times out.*default: 18\b/i, 'help timeout changed to 18'); # Explicit timeout @ARGV = qw(--timeout=25 --verbose); $ng = setup(); $ng->getopts; is($ng->timeout, 25, 'timeout changed to 25'); # Explicit timeout @ARGV = qw(-t10 --verbose); $ng = setup(); $ng->getopts; is($ng->timeout, 10, 'timeout changed to 10'); # Short timeout, test default timeout handler @ARGV = qw(-t2 --verbose); $ng = setup(); $ng->getopts; is($ng->timeout, 2, 'timeout changed to 2'); alarm($ng->timeout); # Loop ok(! defined eval { 1 while 1 }, 'loop timed out'); like($@, qr/UNKNOWN\b.*\btimed out/, 'default timeout handler ok'); Monitoring-Plugin-0.39/t/npg03/0000755000175000017500000000000012512177466014743 5ustar svensvenMonitoring-Plugin-0.39/t/npg03/plugins.ini0000644000175000017500000000054412267046307017124 0ustar svensven[check_mysql] username=tonvoon password=secret [more_options] username=altinity warning=10 critical=15 [check_disk] p=/tmp [check_2_disks] p=/tmp p=/var [check_2_disks_reprise] p=/var p=/tmp [check_disk2] path=/var path=/home units=GB [funny_stuff] username="Ton Voon" p= expect=" space in front" # Test 3 parameters [check_disk3] p=/ p=/var p=/tmp Monitoring-Plugin-0.39/t/npg03/expected/0000755000175000017500000000000012512177466016544 5ustar svensvenMonitoring-Plugin-0.39/t/npg03/expected/05_disk70000644000175000017500000000005612267046307020011 0ustar svensvencheck_disk3 -p / -p /var -p /tmp --path=/home Monitoring-Plugin-0.39/t/npg03/expected/00_basic0000644000175000017500000000013512267046307020042 0ustar svensvencheck_mysql -H localhost -S --critical=15 --password=secret --username=altinity --warning=10 Monitoring-Plugin-0.39/t/npg03/expected/15_badsection_catch0000644000175000017500000000010312267046307022237 0ustar svensvenInvalid section 'bad_section' in config file 't/npg03/plugins.ini' Monitoring-Plugin-0.39/t/npg03/expected/05_disk10000644000175000017500000000003412267046307017777 0ustar svensvencheck_disk -p /tmp -p /home Monitoring-Plugin-0.39/t/npg03/expected/05_disk50000644000175000017500000000004412267046307020004 0ustar svensvencheck_disk -p /var -p /tmp -p /home Monitoring-Plugin-0.39/t/npg03/expected/05_disk40000644000175000017500000000004412267046307020003 0ustar svensvencheck_disk -p /tmp -p /var -p /home Monitoring-Plugin-0.39/t/npg03/expected/09_funnystuff0000644000175000017500000000010212267046307021173 0ustar svensvencheck_disk --expect=" space in front" -p "" --username="Ton Voon" Monitoring-Plugin-0.39/t/npg03/expected/05_disk60000644000175000017500000000013012267046307020001 0ustar svensvencheck_disk2 --critical=5% --path=/var --path=/home --path=/usr --units=GB --warning=10% Monitoring-Plugin-0.39/t/npg03/expected/05_disk30000644000175000017500000000003312267046307020000 0ustar svensvencheck_disk -p /tmp -p /var Monitoring-Plugin-0.39/t/npg03/expected/01_override10000644000175000017500000000007012267046307020660 0ustar svensvencheck_mysql --critical=15 --username=admin --warning=5 Monitoring-Plugin-0.39/t/npg03/expected/05_disk20000644000175000017500000000004612267046307020003 0ustar svensvencheck_disk -p /tmp -p /home -p /users Monitoring-Plugin-0.39/t/npg03/expected/02_override20000644000175000017500000000005712267046307020667 0ustar svensvencheck_mysql --password=secret --username=admin Monitoring-Plugin-0.39/t/npg03/expected/00_noextra0000644000175000017500000000003412267046307020437 0ustar svensvencheck_mysql -H localhost -S Monitoring-Plugin-0.39/t/npg03/expected/12_nosection_implicit0000644000175000017500000000003612267046307022657 0ustar svensvencheck_no_section -H localhost Monitoring-Plugin-0.39/t/npg03/README0000644000175000017500000000127412267054212015615 0ustar svensvenMonitoring-Plugin-Getopt-03.t automatically tests all cases defined in the 'input' directory and expects the output to match the corresponding file in the 'expected' directory. To define a new test case, just create a new file in the 'input' directory containing the input command line, and a corresponding file in the 'expected' directory containing what you think the expanded command line should be. Note that this expansion is normalised as follows: - command line arguments are reported in alphabetical order - extraneous white space is removed Also, if you use a completely new argument than those currently defined in Monitoring-Plugin-Getopt-03.t you will need to define it there as well. Monitoring-Plugin-0.39/t/npg03/input/0000755000175000017500000000000012512177466016102 5ustar svensvenMonitoring-Plugin-0.39/t/npg03/input/05_disk70000644000175000017500000000004612267046307017346 0ustar svensvencheck_disk3 --extra-opts --path=/home Monitoring-Plugin-0.39/t/npg03/input/00_basic0000644000175000017500000000010412267046307017374 0ustar svensvencheck_mysql -S --extra-opts= --extra-opts=more_options -H localhost Monitoring-Plugin-0.39/t/npg03/input/14_badsection_dies0000644000175000017500000000005212267046307021441 0ustar svensvencheck_no_section --extra-opts=bad_section Monitoring-Plugin-0.39/t/npg03/input/15_badsection_catch0000644000175000017500000000006712267046307021606 0ustar svensvencheck_no_section_default_file --extra-opts=bad_section Monitoring-Plugin-0.39/t/npg03/input/05_disk10000644000175000017500000000004212267046307017334 0ustar svensvencheck_disk --extra-opts= -p /home Monitoring-Plugin-0.39/t/npg03/input/13_nosection_explicit_dies0000644000175000017500000000005412267046307023231 0ustar svensvencheck_no_section --extra-opts= -H localhost Monitoring-Plugin-0.39/t/npg03/input/05_disk50000644000175000017500000000006712267046307017347 0ustar svensvencheck_disk -p /home --extra-opts=check_2_disks_reprise Monitoring-Plugin-0.39/t/npg03/input/05_disk40000644000175000017500000000005712267046307017345 0ustar svensvencheck_disk -p /home --extra-opts=check_2_disks Monitoring-Plugin-0.39/t/npg03/input/09_funnystuff0000644000175000017500000000004412267046307020536 0ustar svensvencheck_disk --extra-opts=funny_stuff Monitoring-Plugin-0.39/t/npg03/input/05_disk60000644000175000017500000000010212267046307017336 0ustar svensvencheck_disk2 --warning=10% --critical=5% --extra-opts= --path=/usr Monitoring-Plugin-0.39/t/npg03/input/05_disk30000644000175000017500000000004612267046307017342 0ustar svensvencheck_disk --extra-opts=check_2_disks Monitoring-Plugin-0.39/t/npg03/input/01_override10000644000175000017500000000010312267046307020213 0ustar svensvencheck_mysql --username=admin --extra-opts=more_options --warning=5 Monitoring-Plugin-0.39/t/npg03/input/05_disk20000644000175000017500000000005412267046307017340 0ustar svensvencheck_disk --extra-opts= -p /home -p /users Monitoring-Plugin-0.39/t/npg03/input/02_override20000644000175000017500000000004312267046307020220 0ustar svensvencheck_mysql --extra-opts= -u admin Monitoring-Plugin-0.39/t/npg03/input/00_noextra0000644000175000017500000000003412267046307017775 0ustar svensvencheck_mysql -S -H localhost Monitoring-Plugin-0.39/t/npg03/input/12_nosection_implicit0000644000175000017500000000003612267046307022215 0ustar svensvencheck_no_section -H localhost Monitoring-Plugin-0.39/t/Monitoring-Plugin-Getopt-04.t0000644000175000017500000000646112450000372021230 0ustar svensven# Monitoring::Plugin::Getopt spec-to-help generation tests use strict; use Test::More tests => 15; BEGIN { use_ok('Monitoring::Plugin::Getopt') }; # Needed to get evals to work in testing Monitoring::Plugin::Functions::_use_die(1); my %PARAM = ( version => '0.01', usage => "Don't use this plugin!", ); sub setup { # Instantiate object my $ng = Monitoring::Plugin::Getopt->new(%PARAM); ok($ng, 'constructor ok'); # Positional args, no short arguments, INTEGER $ng->arg('warning=i' => qq(Exit with WARNING status if less than INTEGER foobars are free), 5); # Named args, long + short arguments, INTEGER $ng->arg( spec => 'critical|c=i', help => qq(Exit with CRITICAL status if less than INTEGER foobars are free), required => 1, ); # Named args, multiple short arguments, STRING, default expansion $ng->arg( spec => 'x|y|z=s', help => qq(Foobar. Default: %s), default => "XYZ", ); # Named args, multiple mixed, no label $ng->arg( spec => 'long|longer|longest|l', help => qq(Long format), ); # Named args, long + short, explicit label $ng->arg( spec => 'hostname|H=s', label => 'ADDRESS', help => qq(Hostname), ); # Positional args, long only, explicit label $ng->arg('avatar=s', 'Avatar', undef, undef, 'AVATAR'); # Multiline help test, named args $ng->arg( spec => 'disk=s', label => [ qw(BYTES PERCENT%), undef ], help => [ qq(Disk limit in BYTES), qq(Disk limit in PERCENT), qq(Disk limit in FOOBARS (Default: %s)), ], default => 1024, ); # Multiline help test, positional args $ng->arg( 'limit=s', [ qq(Limit in BYTES), qq(Limit in PERCENT), ], undef, undef, [ undef, 'PERCENT%' ], ); # Named args with *optional* but pre-set value $ng->arg( spec => 'dirport|d:9030', help => 'dirport', ); # Named args with *optional* string value $ng->arg( spec => 'enablesomething|s:s', help => 'something', ); # Named args with *optional* integer value (same as ":0") $ng->arg( spec => 'testtimeout|T:i', help => 'testtimeout', ); # Named args with *optional* but increasing integer value $ng->arg( spec => 'verbosity|v:+', help => 'verbosity', ); return $ng; } my $ng; @ARGV = ( '--help' ); $ng = setup; ok(! defined eval { $ng->getopts }, 'getopts died on help'); like($@, qr/\n --warning=INTEGER/, 'warning ok'); like($@, qr/\n -c, --critical=INTEGER/, 'critical ok'); like($@, qr/\n -x, -y, -z=STRING\n Foobar. Default: XYZ\n/, 'x|y|z ok'); like($@, qr/\n -l, --long, --longer, --longest\n Long format\n/, 'long ok'); like($@, qr/\n -H, --hostname=ADDRESS\n Hostname\n/, 'hostname ok'); like($@, qr/\n --avatar=AVATAR\n Avatar\n/, 'avatar ok'); like($@, qr/\n --disk=BYTES\n Disk limit in BYTES\n --disk=PERCENT%\n Disk limit in PERCENT\n --disk=STRING\n Disk limit in FOOBARS \(Default: 1024\)\n/, 'disk multiline ok'); like($@, qr/\n --limit=STRING\n Limit in BYTES\n --limit=PERCENT%\n Limit in PERCENT\n/, 'limit multiline ok'); like($@, qr/\n -d, --dirport\[=INTEGER\]/, 'dirport ok'); like($@, qr/\n -s, --enablesomething\[=STRING\]/, 'enablesomething ok'); like($@, qr/\n -T, --testtimeout\[=INTEGER\]/, 'testtimeout ok'); like($@, qr/\n -v, --verbosity\[=INTEGER\]/, 'verbosity ok'); #print $@; Monitoring-Plugin-0.39/t/check_stuff.t0000755000175000017500000000303112267053745016465 0ustar svensven#!/usr/local/bin/perl # use strict; use warnings; #use Test::More qw(no_plan); use Test::More tests => 14; my ($r,$args); my $s = 't/check_stuff.pl'; $s = "$^X -Ilib $s"; my $n = 'STUFF'; # Monitoring status strings and exit codes my %e = qw( OK 0 WARNING 1 CRITICAL 2 UNKNOWN 3 ); $r = `$s`; is $?>>8 , $e{UNKNOWN}, "exits($e{UNKNOWN}) with no args"; like $r, qr/^$n UNKNOWN/, "UNKNOWN with no args"; $r = `$s -V`; is $?>>8 , $e{UNKNOWN}, "exits($e{UNKNOWN}) with -V arg"; like $r, qr/^[\w\.]+ \d+/i, "looks like there's a version"; $r = `$s -h`; is $?>>8 , $e{UNKNOWN}, "exits($e{UNKNOWN}) with -h arg"; like $r, qr/usage/i, "looks like there's something helpful"; # broken $args = " -r 99 "; diag "running `$s $args`" if $ENV{TEST_VERBOSE}; $r = `$s $args`; diag "output: '$r'" if $ENV{TEST_VERBOSE}; is $?>>8 , $e{UNKNOWN}, "exits($e{UNKNOWN}) with $args"; like $r, qr/UNKNOWN.+invalid/i, "UNKNOWN (warning: invalid -r) with $args"; my $expected = { " -w 10:15 -c~:15 -r 0" => 'WARNING', " -w 10:15 -c~:15 -r 11" => 'OK', " -w 10:15 -c~:15 -r 15.8" => 'CRITICAL', }; test_expected( $s, $expected ); sub test_expected { my $s = shift; my $expected = shift; foreach ( keys %$expected ) { diag "running `$s $_`" if $ENV{TEST_VERBOSE}; $r = `$s $_`; diag "output: '$r'" if $ENV{TEST_VERBOSE}; is $?>>8 , $e{$expected->{$_}}, "exits($e{$expected->{$_}}) with $_"; like $r, qr/^$n $expected->{$_}/i, "looks $expected->{$_} with $_"; } } Monitoring-Plugin-0.39/t/Monitoring-Plugin-04.t0000644000175000017500000000613512267053577020013 0ustar svensven # tests for toplevel access to Threshold and GetOpts stuff use strict; #use Test::More 'no_plan'; use Test::More tests=>30; BEGIN { use_ok('Monitoring::Plugin') }; use Monitoring::Plugin::Functions; Monitoring::Plugin::Functions::_fake_exit(1); eval { Monitoring::Plugin->new(); }; ok(! $@, "constructor DOESN'T die without usage"); my $p = Monitoring::Plugin->new(); eval { $p->add_arg('warning', 'warning') }; ok($@, "add_arg() dies if you haven't instantiated with usage"); eval { $p->getopts }; ok($@, "getopts() dies if you haven't instantiated with usage"); $p = Monitoring::Plugin->new( usage => "dummy usage statement" ); # option accessors work can_ok $p, 'opts'; isa_ok $p->opts, 'Monitoring::Plugin::Getopt', "Getopt object is defined"; $p->add_arg('warning|w=s', "warning"); $p->add_arg('critical|c=s', "critical"); @ARGV = qw(-w 5 -c 10); $p->getopts; is $p->opts->warning, "5", "warning opt is accessible"; is $p->opts->critical, "10", "critical opt is accessible"; can_ok $p, 'perfdata'; #isa_ok $p->perfdata, 'Monitoring::Plugin::Performance', "perfdata object is defined"; can_ok $p, 'threshold'; #isa_ok $p->threshold, 'Monitoring::Plugin::Threshold', "threshold object is defined"; eval { $p->check_threshold() }; ok($@, "check_threshold dies if called with no args"); # thresholds set implicitly is $p->check_threshold(2), OK, "check_threshold OK when called implicitly"; is $p->check_threshold(6), WARNING, "check_threshold WARNING"; is $p->check_threshold(11), CRITICAL, "check_threshold CRITICAL"; is $p->check_threshold(check=>11), CRITICAL, "check_threshold CRITICAL with hash param"; # Check that arrays allowed is $p->check_threshold([2,1]), OK, "check_threshold OK when called implicitly"; is $p->check_threshold([6,2]), WARNING, "check_threshold WARNING"; is $p->check_threshold([1,2,6,11]), CRITICAL, "check_threshold CRITICAL"; is $p->check_threshold(check=>[1,2,6,11]), CRITICAL, "check_threshold CRITICAL with hash param"; # thresholds set explicitly is $p->check_threshold( check => 2, warning => 50, critical => 100 ), OK, "check_threshold explicit OK"; is $p->check_threshold( check => 66, warning => 50, critical => 100 ), WARNING, "check_threshold explicit WARNING"; is $p->check_threshold( check => -1, warning => 5, critical => '0:5', ), CRITICAL, "check_threshold explicit CRITICAL"; # what happens if you forget to define warning or critical thresholds? $p = undef; $p = Monitoring::Plugin->new(); is $p->check_threshold(2), UNKNOWN, "everything is now UNKNOWN"; is $p->check_threshold(-200), UNKNOWN, "everything is now UNKNOWN"; is $p->check_threshold(134098.3124), UNKNOWN, "everything is now UNKNOWN"; is $p->check_threshold("foo bar baz"), UNKNOWN, "everything is now UNKNOWN"; # how about when you define just one? $p->set_thresholds(warning => "10:25"); is $p->check_threshold(2), WARNING, "check_threshold works (WARNING) after explicit set_thresholds"; is $p->check_threshold(-200), WARNING, "and again"; is $p->check_threshold(25.5), WARNING, "and again"; is $p->check_threshold(11), OK, "now OK"; Monitoring-Plugin-0.39/t/Monitoring-Plugin-01.t0000644000175000017500000000370012267053736020000 0ustar svensven# Monitoring::Plugin original test cases use strict; use Test::More tests => 15; BEGIN { use_ok('Monitoring::Plugin') }; use Monitoring::Plugin::Functions; Monitoring::Plugin::Functions::_fake_exit(1); diag "\nusing Monitoring::Plugin revision ". $Monitoring::Plugin::VERSION . "\n" if $ENV{TEST_VERBOSE}; my $p = Monitoring::Plugin->new(); isa_ok( $p, "Monitoring::Plugin"); $p->shortname("PAGESIZE"); is($p->shortname, "PAGESIZE", "shortname explicitly set correctly"); $p = Monitoring::Plugin->new(); is($p->shortname, "MONITORING-PLUGIN-01", "shortname should default on new"); $p = Monitoring::Plugin->new( shortname => "SIZE", () ); is($p->shortname, "SIZE", "shortname set correctly on new"); $p = Monitoring::Plugin->new( plugin => "check_stuff", () ); is($p->shortname, "STUFF", "shortname uses plugin name as default"); $p = Monitoring::Plugin->new( shortname => "SIZE", plugin => "check_stuff", () ); is($p->shortname, "SIZE", "shortname is not overriden by default"); diag "warn if < 10, critical if > 25 " if $ENV{TEST_VERBOSE}; my $t = $p->set_thresholds( warning => "10:25", critical => "~:25" ); use Data::Dumper; #diag "dumping p: ". Dumper $p; #diag "dumping perfdata: ". Dumper $p->perfdata; $p->add_perfdata( label => "size", value => 1, uom => "kB", threshold => $t, ); cmp_ok( $p->all_perfoutput, 'eq', "size=1kB;10:25;~:25", "Perfdata correct"); #diag "dumping perfdata: ". Dumper ($p->perfdata); $p->add_perfdata( label => "time", value => "3.52", threshold => $t, ); is( $p->all_perfoutput, "size=1kB;10:25;~:25 time=3.52;10:25;~:25", "Perfdata correct when no uom specified"); my $expected = {qw( -1 WARNING 1 WARNING 20 OK 25 OK 26 CRITICAL 30 CRITICAL )}; foreach (sort {$a<=>$b} keys %$expected) { like $p->die( return_code => $t->get_status($_), message => "page size at http://... was ${_}kB" ), qr/$expected->{$_}/, "Output okay. $_ = $expected->{$_}" ; } Monitoring-Plugin-0.39/t/Monitoring-Plugin-03.t0000644000175000017500000002266712267062463020014 0ustar svensven# $np->check_messages tests use strict; use Test::More tests => 61; BEGIN { use_ok("Monitoring::Plugin"); use_ok("Monitoring::Plugin::Functions", ":all"); } Monitoring::Plugin::Functions::_fake_exit(1); my $plugin = 'MP_CHECK_MESSAGES_03'; my $np = Monitoring::Plugin->new( shortname => $plugin, () ); is($np->shortname, $plugin, "shortname() is $plugin"); my ($code, $message); # ------------------------------------------------------------------------- # Check codes my @codes = ( [ [ qw(Critical) ], [ qw(Warning) ], CRITICAL ], [ [], [ qw(Warning) ], WARNING ], [ [], [], OK ], ); my $i = 0; for (@codes) { $i++; $code = $np->check_messages( critical => $_->[0], warning => $_->[1] ); is($code, $_->[2], "Code test $i returned $STATUS_TEXT{$_->[2]}"); } # ------------------------------------------------------------------------- # Check messages my %arrays = ( critical => [ qw(A B C) ], warning => [ qw(D E F) ], ok => [ qw(G H I) ], ); my %messages = map { $_ => join(' ', @{$arrays{$_}}) } keys %arrays; # critical, warning ($code, $message) = $np->check_messages( critical => $arrays{critical}, warning => $arrays{warning}, ); is($code, CRITICAL, "(critical, warning) code is $STATUS_TEXT{$code}"); is($message, $messages{critical}, "(critical, warning) message is $message"); # critical, warning, ok ($code, $message) = $np->check_messages( critical => $arrays{critical}, warning => $arrays{warning}, ok => $arrays{ok}, ); is($code, CRITICAL, "(critical, warning, ok) code is $STATUS_TEXT{$code}"); is($message, $messages{critical}, "(critical, warning, ok) message is $message"); # critical, warning, $ok ($code, $message) = $np->check_messages( critical => $arrays{critical}, warning => $arrays{warning}, ok => 'G H I', ); is($code, CRITICAL, "(critical, warning, \$ok) code is $STATUS_TEXT{$code}"); is($message, $messages{critical}, "(critical, warning, \$ok) message is $message"); # warning ($code, $message) = $np->check_messages( critical => [], warning => $arrays{warning}, ); is($code, WARNING, "(warning) code is $STATUS_TEXT{$code}"); is($message, $messages{warning}, "(warning) message is $message"); # warning, ok ($code, $message) = $np->check_messages( critical => [], warning => $arrays{warning}, ok => $arrays{ok}, ); is($code, WARNING, "(warning, ok) code is $STATUS_TEXT{$code}"); is($message, $messages{warning}, "(warning, ok) message is $message"); # ok ($code, $message) = $np->check_messages( critical => [], warning => [], ok => $arrays{ok}, ); is($code, OK, "(ok) code is $STATUS_TEXT{$code}"); is($message, $messages{ok}, "(ok) message is $message"); # $ok ($code, $message) = $np->check_messages( critical => [], warning => [], ok => 'G H I', ); is($code, OK, "(\$ok) code is $STATUS_TEXT{$code}"); is($message, $messages{ok}, "(\$ok) message is $message"); # ------------------------------------------------------------------------- # explicit join my $join = '+'; ($code, $message) = $np->check_messages( critical => $arrays{critical}, warning => $arrays{warning}, join => $join, ); is($message, join($join, @{$arrays{critical}}), "joined '$join' (critical, warning) message is $message"); $join = ''; ($code, $message) = $np->check_messages( critical => [], warning => $arrays{warning}, join => $join, ); is($message, join($join, @{$arrays{warning}}), "joined '$join' (warning) message is $message"); $join = undef; ($code, $message) = $np->check_messages( critical => [], warning => [], ok => $arrays{ok}, join => $join, ); is($message, join(' ', @{$arrays{ok}}), "joined undef (ok) message is $message"); # ------------------------------------------------------------------------- # join_all messages my $join_all = ' :: '; my $msg_all_cwo = join($join_all, map { join(' ', @{$arrays{$_}}) } qw(critical warning ok)); my $msg_all_cw = join($join_all, map { join(' ', @{$arrays{$_}}) } qw(critical warning)); my $msg_all_wo = join($join_all, map { join(' ', @{$arrays{$_}}) } qw(warning ok)); # critical, warning, ok ($code, $message) = $np->check_messages( critical => $arrays{critical}, warning => $arrays{warning}, ok => $arrays{ok}, join_all => $join_all, ); is($code, CRITICAL, "(critical, warning, ok) code is $STATUS_TEXT{$code}"); is($message, $msg_all_cwo, "join_all '$join_all' (critical, warning, ok) message is $message"); # critical, warning, $ok ($code, $message) = $np->check_messages( critical => $arrays{critical}, warning => $arrays{warning}, ok => 'G H I', join_all => $join_all, ); is($code, CRITICAL, "(critical, warning, \$ok) code is $STATUS_TEXT{$code}"); is($message, $msg_all_cwo, "join_all '$join_all' (critical, warning, \$ok) message is $message"); # critical, warning ($code, $message) = $np->check_messages( critical => $arrays{critical}, warning => $arrays{warning}, join_all => $join_all, ); is($code, CRITICAL, "(critical, warning) code is $STATUS_TEXT{$code}"); is($message, $msg_all_cw, "join_all '$join_all' (critical, warning) message is $message"); # warning, ok ($code, $message) = $np->check_messages( critical => [], warning => $arrays{warning}, ok => $arrays{ok}, join_all => $join_all, ); is($code, WARNING, "(warning, ok) code is $STATUS_TEXT{$code}"); is($message, $msg_all_wo, "join_all '$join_all' (critical, warning, ok) message is $message"); # warning, $ok ($code, $message) = $np->check_messages( critical => [], warning => $arrays{warning}, ok => 'G H I', join_all => $join_all, ); is($code, WARNING, "(warning, \$ok) code is $STATUS_TEXT{$code}"); is($message, $msg_all_wo, "join_all '$join_all' (critical, warning, \$ok) message is $message"); # warning ($code, $message) = $np->check_messages( critical => [], warning => $arrays{warning}, join_all => $join_all, ); is($code, WARNING, "(warning) code is $STATUS_TEXT{$code}"); is($message, 'D E F', "join_all '$join_all' (critical, warning) message is $message"); # ------------------------------------------------------------------------- # add_messages # Constant codes $np = Monitoring::Plugin->new(); $np->add_message( CRITICAL, "A B C" ); $np->add_message( WARNING, "D E F" ); ($code, $message) = $np->check_messages(); is($code, CRITICAL, "(CRITICAL, WARNING) code is $STATUS_TEXT{$code}"); is($message, $messages{critical}, "(CRITICAL, WARNING) message is $message"); $np = Monitoring::Plugin->new(); $np->add_message( CRITICAL, "A B C" ); ($code, $message) = $np->check_messages(); is($code, CRITICAL, "(CRITICAL) code is $STATUS_TEXT{$code}"); is($message, $messages{critical}, "(CRITICAL) message is $message"); $np = Monitoring::Plugin->new(); $np->add_message( WARNING, "D E F" ); ($code, $message) = $np->check_messages(); is($code, WARNING, "(WARNING) code is $STATUS_TEXT{$code}"); is($message, $messages{warning}, "(WARNING) message is $message"); $np = Monitoring::Plugin->new(); $np->add_message( WARNING, "D E F" ); $np->add_message( OK, "G H I" ); ($code, $message) = $np->check_messages(); is($code, WARNING, "(WARNING, OK) code is $STATUS_TEXT{$code}"); is($message, $messages{warning}, "(WARNING, OK) message is $message"); $np = Monitoring::Plugin->new(); $np->add_message( OK, "G H I" ); ($code, $message) = $np->check_messages(); is($code, OK, "(OK) code is $STATUS_TEXT{$code}"); is($message, $messages{ok}, "(OK) message is $message"); # String codes $np = Monitoring::Plugin->new(); $np->add_message( critical => "A B C" ); $np->add_message( warning => "D E F" ); ($code, $message) = $np->check_messages(); is($code, CRITICAL, "(critical, warning) code is $STATUS_TEXT{$code}"); is($message, $messages{critical}, "(critical, warning) message is $message"); $np = Monitoring::Plugin->new(); $np->add_message( critical => "A B C" ); ($code, $message) = $np->check_messages(); is($code, CRITICAL, "(critical) code is $STATUS_TEXT{$code}"); is($message, $messages{critical}, "(critical) message is $message"); $np = Monitoring::Plugin->new(); $np->add_message( warning => "D E F" ); ($code, $message) = $np->check_messages(); is($code, WARNING, "(warning) code is $STATUS_TEXT{$code}"); is($message, $messages{warning}, "(warning) message is $message"); $np = Monitoring::Plugin->new(); $np->add_message( warning => "D E F" ); $np->add_message( ok => "G H I" ); ($code, $message) = $np->check_messages(); is($code, WARNING, "(warning, ok) code is $STATUS_TEXT{$code}"); is($message, $messages{warning}, "(warning, ok) message is $message"); $np = Monitoring::Plugin->new(); $np->add_message( ok => "G H I" ); ($code, $message) = $np->check_messages(); is($code, OK, "(ok) code is $STATUS_TEXT{$code}"); is($message, $messages{ok}, "(ok) message is $message"); # No add_message $np = Monitoring::Plugin->new(); ($code, $message) = $np->check_messages(); is($code, OK, "() code is $STATUS_TEXT{$code}"); is($message, '', "() message is ''"); # ------------------------------------------------------------------------- # Error conditions # add_message errors $np = Monitoring::Plugin->new(); ok(! defined eval { $np->add_message( foobar => 'hi mum' ) }, 'add_message dies on invalid code'); ok(! defined eval { $np->add_message( OKAY => 'hi mum' ) }, 'add_message dies on invalid code'); # UNKNOWN and DEPENDENT error codes ok(! defined eval { $np->add_message( unknown => 'hi mum' ) }, 'add_message dies on UNKNOWN code'); ok(! defined eval { $np->add_message( dependent => 'hi mum' ) }, 'add_message dies on DEPENDENT code'); Monitoring-Plugin-0.39/t/check_stuff.pl0000755000175000017500000001025512267224147016637 0ustar svensven#!/usr/local/bin/perl ### check_stuff.pl # an example plugin using the Monitoring::Plugin module. # Originally by Nathan Vonnahme, n8v at users dot sourceforge # dot net, July 19 2006 # Please modify to your heart's content and use as the basis for all # the really cool monitoring scripts you're going to create. # You rock. ############################################################################## # prologue use strict; use warnings; use Monitoring::Plugin; use vars qw($VERSION $PROGNAME $verbose $warn $critical $timeout $result); $VERSION = '1.0'; # get the base name of this script for use in the examples use File::Basename; $PROGNAME = basename($0); ############################################################################## # define and get the command line options. # see the command line option guidelines at # https://www.monitoring-plugins.org/doc/guidelines.html#PLUGOPTIONS # Instantiate Monitoring::Plugin object (the 'usage' parameter is mandatory) my $p = Monitoring::Plugin->new( usage => "Usage: %s [ -v|--verbose ] [-H ] [-t ] [ -c|--critical= ] [ -w|--warning= ] [ -r|--result = ]", version => $VERSION, blurb => 'This plugin is an example of a monitoring plugin written in Perl using the Monitoring::Plugin modules. It will generate a random integer between 1 and 20 (though you can specify the number with the -n option for testing), and will output OK, WARNING or CRITICAL if the resulting number is outside the specified thresholds.', extra => " THRESHOLDs for -w and -c are specified 'min:max' or 'min:' or ':max' (or 'max'). If specified '\@min:max', a warning status will be generated if the count *is* inside the specified range. See more threshold examples at https://www.monitoring-plugins.org/doc/guidelines.html#THRESHOLDFORMAT Examples: $PROGNAME -w 10 -c 18 Returns a warning if the resulting number is greater than 10, or a critical error if it is greater than 18. $PROGNAME -w 10 : -c 4 : Returns a warning if the resulting number is less than 10, or a critical error if it is less than 4. " ); # Define and document the valid command line options # usage, help, version, timeout and verbose are defined by default. $p->add_arg( spec => 'warning|w=s', help => qq{-w, --warning=INTEGER:INTEGER Minimum and maximum number of allowable result, outside of which a warning will be generated. If omitted, no warning is generated.}, # required => 1, # default => 10, ); $p->add_arg( spec => 'critical|c=s', help => qq{-c, --critical=INTEGER:INTEGER Minimum and maximum number of the generated result, outside of which a critical will be generated. }, ); $p->add_arg( spec => 'result|r=f', help => qq{-r, --result=INTEGER Specify the result on the command line rather than generating a random number. For testing.}, ); # Parse arguments and process standard ones (e.g. usage, help, version) $p->getopts; # perform sanity checking on command line options if ( (defined $p->opts->result) && ($p->opts->result < 0 || $p->opts->result > 20) ) { $p->plugin_die( " invalid number supplied for the -r option " ); } unless ( defined $p->opts->warning || defined $p->opts->critical ) { $p->plugin_die( " you didn't supply a threshold argument " ); } ############################################################################## # check stuff. # THIS is where you'd do your actual checking to get a real value for $result # don't forget to timeout after $p->opts->timeout seconds, if applicable. my $result; if (defined $p->opts->result) { # you got a 'result' option from the command line options $result = $p->opts->result; print " using supplied result $result from command line \n " if $p->opts->verbose; } else { $result = int rand(20)+1; print " generated random result $result\n " if $p->opts->verbose; } ############################################################################## # check the result against the defined warning and critical thresholds, # output the result and exit $p->plugin_exit( return_code => $p->check_threshold($result), message => " sample result was $result" ); Monitoring-Plugin-0.39/t/Monitoring-Plugin-Threshold.t0000644000175000017500000001763412267053142021516 0ustar svensven use strict; use Test::More tests => 93; BEGIN { use_ok('Monitoring::Plugin::Threshold'); use_ok('Monitoring::Plugin::Functions', ':all' ); # Silence warnings unless TEST_VERBOSE is set $SIG{__WARN__} = sub { warn $_[0] if $ENV{TEST_VERBOSE} }; } diag "\nusing Monitoring::Plugin::Threshold revision ". $Monitoring::Plugin::Threshold::VERSION . "\n" if $ENV{TEST_VERBOSE}; Monitoring::Plugin::Functions::_fake_exit(1); my $t; $t = Monitoring::Plugin::Threshold->set_thresholds(warning => undef, critical => undef); ok( defined $t, "two undefs" ); ok( ! $t->warning->is_set, "warning not set" ); ok( ! $t->critical->is_set, "critical not set" ); $t = Monitoring::Plugin::Threshold->set_thresholds(warning => "", critical => ""); ok( defined $t, "two empty strings" ); ok( ! $t->warning->is_set, "warning not set" ); ok( ! $t->critical->is_set, "critical not set" ); diag "threshold: critical if > 80" if $ENV{TEST_VERBOSE}; my $t = Monitoring::Plugin::Threshold->set_thresholds(critical => "80"); ok( defined $t, "Threshold ('', '80') set"); ok( ! $t->warning->is_set, "Warning not set"); cmp_ok( $t->critical->start, '==', 0, "Critical strat set correctly"); cmp_ok( $t->critical->end, '==', 80, "Critical end set correctly"); ok ! $t->critical->end_infinity, "not forever"; my $expected = { qw( -1 CRITICAL 4 OK 79.999999 OK 80 OK 80.1 CRITICAL 102321 CRITICAL ) }; sub test_expected_statuses { my $t = shift; my $expected = shift; my $debug = shift; foreach (sort {$a<=>$b} keys %$expected) { is $STATUS_TEXT{$t->get_status($_)}, $expected->{$_}, " $_ - $expected->{$_}"; if ($debug) { diag "val = $_; critical check = ".$t->critical->check_range($_). "; warning check = ".$t->warning->check_range($_); } } use Data::Dumper; diag "thresh dump: ". Dumper $t if $debug; } test_expected_statuses( $t, $expected ); # GMC: this test seems bogus to me - either we've died, in which case internal # state is undefined (and untestable!), or we should be returning a non-fatal error if (0) { diag "threshold: warn if less than 5 or more than 33." if $ENV{TEST_VERBOSE}; eval { $t = Monitoring::Plugin::Threshold->set_thresholds(warning => "5:33", critical => "") }; ok( defined $t, "Threshold ('5:33', '') set"); cmp_ok( $t->warning->start, '==', 5, "Warning start set"); cmp_ok( $t->warning->end, '==', 33, "Warning end set"); ok( ! $t->critical->is_set, "Critical not set"); } # GC: same as previous test, except critical is undef instead of '' diag "threshold: warn if less than 5 or more than 33." if $ENV{TEST_VERBOSE}; $t = Monitoring::Plugin::Threshold->set_thresholds(warning => "5:33", critical => undef); ok( defined $t, "Threshold ('5:33', '') set"); cmp_ok( $t->warning->start, '==', 5, "Warning start set"); cmp_ok( $t->warning->end, '==', 33, "Warning end set"); ok( ! $t->critical->is_set, "Critical not set"); $expected = { qw( -1 WARNING 4 WARNING 4.999999 WARNING 5 OK 14.21 OK 33 OK 33.01 WARNING 10231 WARNING ) }; test_expected_statuses( $t, $expected ); diag "threshold: warn if more than 30; critical if > 60" if $ENV{TEST_VERBOSE}; $t = Monitoring::Plugin::Threshold->set_thresholds(warning => "~:30", critical => "~:60"); ok( defined $t, "Threshold ('~:30', '~:60') set"); cmp_ok( $t->warning->end, '==', 30, "Warning end set"); cmp_ok( $t->critical->end, '==',60, "Critical end set"); ok $t->critical->start_infinity, "Critical starts at negative infinity"; $expected = { qw( -1 OK 4 OK 29.999999 OK 30 OK 30.1 WARNING 50.90 WARNING 59.9 WARNING 60 WARNING 60.00001 CRITICAL 10231 CRITICAL ) }; test_expected_statuses( $t, $expected ); # "I'm going to die homeless, penniless, and 30 pounds overweight." # "...and that's...okay." # TODO: figure out why this doesn't work and fix the test. goto SKIP_DEATH; diag "threshold: test pure crap for arguments - default to OK." if $ENV{TEST_VERBOSE}; diag "you should see one invalid range definition warning and an UNKNOWN line here:\n"; Monitoring::Plugin::Functions->print_on_die(1); Monitoring::Plugin::Functions->exit_on_die(1); dies_ok( sub { $t = Monitoring::Plugin::Threshold->set_thresholds( warning => "total", critical => "rubbish" ) }, "bad thresholds cause death" ); Monitoring::Plugin::Functions->print_on_die(0); Monitoring::Plugin::Functions->exit_on_die(0); SKIP_DEATH: diag "threshold: critical if > 25 " if $ENV{TEST_VERBOSE}; $t = Monitoring::Plugin::Threshold->set_thresholds( critical => "~:25" ); 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"; $expected = { qw( -1 OK 4 OK 10 OK 14.21 OK 25 OK 25.01 CRITICAL 31001 CRITICAL ) }; test_expected_statuses( $t, $expected); diag "threshold: warn if OUTSIDE {10..25} , critical if > 25 " if $ENV{TEST_VERBOSE}; $t = Monitoring::Plugin::Threshold->set_thresholds(warning => "10:25", critical => "~:25"); ok( defined $t, "Threshold ('10:25', '~:25') set"); cmp_ok( $t->warning->start, '==', 10, "Warning start set"); cmp_ok( $t->warning->end, '==', 25, "Warning end set"); cmp_ok( $t->critical->end, '==', 25, "Critical end set"); $expected = { qw( -1 WARNING 4 WARNING 9.999999 WARNING 10 OK 14.21 OK 25 OK 25.01 CRITICAL 31001 CRITICAL ) }; test_expected_statuses( $t, $expected ); diag "warn if INSIDE {10..25} , critical if < 10 " if $ENV{TEST_VERBOSE}; $t = Monitoring::Plugin::Threshold->set_thresholds(warning => "\@10:25", critical => "10:"); $expected = { qw( -1 CRITICAL 4 CRITICAL 9.999999 CRITICAL 10 WARNING 14.21 WARNING 25 WARNING 25.01 OK 31001 OK ) }; test_expected_statuses( $t, $expected ); # GMC: as of 0.16, set_thresholds can also be called as a mutator diag "threshold mutator: warn if more than 30; critical if > 60" if $ENV{TEST_VERBOSE}; my $t1 = $t; $t->set_thresholds(warning => "0:45", critical => "0:90"); is($t1, $t, "same threshold object after \$t->set_thresholds"); ok( defined $t, "Threshold ('0:45', '0:90') set"); is( $t->warning->start, 0, "Warning start ok"); is( $t->warning->end, 45, "Warning end ok"); is( $t->critical->start, 0, "Critical start ok"); is( $t->critical->end, 90, "Critical end ok"); # Also as of 0.16, accepts N::P::Range objects as arguments my $warning = Monitoring::Plugin::Range->parse_range_string("50"); my $critical = Monitoring::Plugin::Range->parse_range_string("70:90"); $t = Monitoring::Plugin::Threshold->set_thresholds(warning => $warning, critical => $critical); ok( defined $t, "Threshold from ranges ('50', '70:90') set"); is( $t->warning->start, 0, "Warning start ok"); is( $t->warning->end, 50, "Warning end ok"); is( $t->critical->start, 70, "Critical start ok"); is( $t->critical->end, 90, "Critical end ok"); $critical = Monitoring::Plugin::Range->parse_range_string("90:"); $t->set_thresholds(warning => "~:20", critical => $critical); ok( defined $t, "Threshold from string + range ('~:20', '90:') set"); ok( $t->warning->start_infinity, "Warning start ok (infinity)"); is( $t->warning->end, 20, "Warning end ok"); is( $t->critical->start, 90, "Critical start ok"); ok( $t->critical->end_infinity, "Critical end ok (infinity)"); ok 1, "sweet, made it to the end."; Monitoring-Plugin-0.39/t/Monitoring-Plugin-Getopt-03.t0000644000175000017500000000570712447775353021261 0ustar svensven# Monitoring::Plugin::Getopt --extra-opts tests use strict; use File::Spec; use File::Basename; use IO::File; use Test::More qw(no_plan); BEGIN { use_ok('Monitoring::Plugin::Getopt') }; # Needed to get evals to work in testing Monitoring::Plugin::Functions::_use_die(1); my $tdir = 'npg03'; if (! -d $tdir) { my $ttdir = File::Spec->catdir('t', $tdir); die "missing '$tdir' directory\n" unless -d $ttdir; $tdir = $ttdir; } # Load expected files my %EXPECTED = (); for my $efile (glob File::Spec->catfile($tdir, 'expected', '*')) { my $fh = IO::File->new($efile, 'r') or die "Cannot open input file '$efile': $!"; if (my $cmd = $fh->getline()) { # First line only! chomp $cmd; $cmd =~ s/^\s+//; $cmd =~ s/\s+$//; $EXPECTED{ basename($efile) } = $cmd; } } # Override MONITORING_CONFIG_PATH to use our test plugins.ini file $ENV{MONITORING_CONFIG_PATH} = "/random/bogus/path:$tdir"; my %PARAM = ( version => '0.01', blurb => 'This plugin tests various stuff.', usage => "Usage: %s -H -w -c ", ); sub ng_setup { my $arg = shift; # Instantiate object my $ng = Monitoring::Plugin::Getopt->new(%PARAM); if (ref $arg eq 'ARRAY' && @$arg) { $ng->arg(%$_) foreach @$arg; } return $ng; } # Setup our Monitoring::Plugin::Getopt object my $ng; my $arg = [ { spec => 'S', help => '-S' }, { spec => 'H=s', help => '-H' }, { spec => 'p=s@', help => '-p' }, { spec => 'path=s@', help => '--path' }, { spec => 'username|u=s', help => '--username' }, { spec => 'password=s', help => '--password' }, { spec => 'critical=s', help => '--critical' }, { spec => 'warning=s', help => '--warning' }, { spec => 'expect=s', help => '--expect' }, { spec => 'units=s', help => '--units' }, ]; #my %SKIP = map { $_ => 1 } qw(05_singlechar1 07_singlechar3); #my %SKIP = map { $_ => 1 } qw(06_singlechar2); my %SKIP = (); # Process all test cases in $tdir/input my $glob = $ARGV[0] || '*'; for my $infile (glob File::Spec->catfile($tdir, 'input', $glob)) { $ng = ng_setup($arg); my $fh = IO::File->new($infile, 'r') or die "Cannot open input file '$infile': $!"; $infile = basename($infile); if (my $cmd = $fh->getline()) { # First line only! $cmd =~ s/^\s+//; my ($plugin, @args) = split /\s+/, $cmd; # Fake out the plugin name $ng->{_attr}->{plugin} = $plugin; # Parse the options SKIP: { skip "Skipping ..." if $SKIP{$infile}; @ARGV = @args; eval { $ng->getopts }; if ($@) { chomp $@; ok($infile =~ m/_(dies?|catch)$/, "$infile ($@)"); my $expect = $EXPECTED{$infile}; # windows expects backslashes fixes rt.cpan #100708 $expect =~ s#/#\\#gmx if $^O =~ m/^MSWin/; is($@, $expect, $infile) if ($infile =~ m/_catch$/); } else { is($plugin . ' ' . $ng->_cmdline, $EXPECTED{$infile}, $infile); } } } } Monitoring-Plugin-0.39/t/Monitoring-Plugin-Getopt-01.t0000644000175000017500000001211612267053377021242 0ustar svensven# Monitoring::Plugin::Getopt basic tests use strict; use Test::More tests => 76; BEGIN { use_ok('Monitoring::Plugin::Getopt') }; # Needed to get evals to work in testing Monitoring::Plugin::Functions::_use_die(1); my %PARAM = ( version => '0.01', url => 'http://www.openfusion.com.au/labs/nagios/', blurb => 'This plugin tests various stuff.', usage => "Usage: %s -H -w -c ", plugin => 'test_plugin', ); sub setup { # Instantiate object my $ng = Monitoring::Plugin::Getopt->new(%PARAM); ok($ng, 'constructor ok'); # Add argument - short form - arg spec, help text, default, required? $ng->arg('warning|w=s' => qq(-w, --warning=INTEGER\n Exit with WARNING status if less than INTEGER foobars are free), 5); # Add argument - named version $ng->arg( spec => 'critical|c=i', help => qq(Exit with CRITICAL status if less than INTEGER foobars are free), required => 1, ); return $ng; } my $ng; # Simple usage (short and long args) @ARGV = qw(-w 3 --critical 10 --timeout=12 --verbose); $ng = setup; $ng->getopts; is($ng->warning, 3, 'warning set to 3'); is($ng->critical, 10, 'critical set to 10'); is($ng->timeout, 12, 'timeout set to 12'); # Check multiple verbose flags @ARGV = qw(-w 3 --critical 10 -v -v -v); $ng = setup; $ng->getopts; is ($ng->verbose, 3, "Verbose set to level 3"); @ARGV = qw(-w 3 --critical 10 --verbose --verbose --verbose); $ng = setup; $ng->getopts; is ($ng->verbose, 3, "Verbose set to level 3 (longhand)"); # Missing args @ARGV = qw(); $ng = setup; ok(! defined eval { $ng->getopts }, 'getopts died on missing args'); like($@, qr/Usage:/, 'usage message'); like($@, qr/Missing arg/, 'missing arguments'); is($ng->verbose, 0, 'verbose set to 0'); # Missing critical @ARGV = qw(-w0 -v); $ng = setup; ok(! defined eval { $ng->getopts }, 'getopts died on missing args'); like($@, qr/Usage:/, 'usage message'); like($@, qr/Missing argument: critical/, 'missing argument: critical'); unlike($@, qr/Missing argument: warning/, 'no missing argument: warning'); is($ng->warning, 0, 'warning set to 0'); is($ng->critical, undef, 'critical undef'); is($ng->timeout, 15, 'timeout set to default'); is($ng->verbose, 1, 'verbose set to true'); # Missing warning @ARGV = qw(--critical=27 --timeout 17 --verbose); $ng = setup; $ng->getopts; is($ng->warning, 5, 'warning 5 (default)'); is($ng->critical, 27, 'critical set to 27'); is($ng->timeout, 17, 'timeout set to 17'); is($ng->verbose, 1, 'verbose set to true'); # -? --usage @ARGV = ( '-?' ); $ng = setup; ok(! defined eval { $ng->getopts }, 'getopts died on usage'); like($@, qr/Usage:/, 'usage message'); unlike($@, qr/Missing arg/, 'no missing arguments'); @ARGV = ( '--usage' ); $ng = setup; ok(! defined eval { $ng->getopts }, 'getopts died on usage'); like($@, qr/Usage:/, 'usage message'); unlike($@, qr/Missing arg/, 'no missing arguments'); # -V --version @ARGV = ( '-V' ); $ng = setup; ok(! defined eval { $ng->getopts }, 'getopts died on version'); like($@, qr/^$PARAM{plugin}/, 'version info includes plugin name'); like($@, qr/$PARAM{version}/, 'version info includes version'); like($@, qr/$PARAM{url}/, 'version info includes url'); unlike($@, qr/Usage:/, 'no usage message'); unlike($@, qr/Missing arg/, 'no missing arguments'); @ARGV = ( '--version' ); $ng = setup; ok(! defined eval { $ng->getopts }, 'getopts died on version'); like($@, qr/^$PARAM{plugin}/, 'version info includes plugin name'); like($@, qr/$PARAM{version}/, 'version info includes version'); like($@, qr/$PARAM{url}/, 'version info includes url'); unlike($@, qr/Usage:/, 'no usage message'); unlike($@, qr/Missing arg/, 'no missing arguments'); # -h --help @ARGV = ( '-h' ); $ng = setup; ok(! defined eval { $ng->getopts }, 'getopts died on help'); like($@, qr/^$PARAM{plugin}/, 'help includes plugin name'); like($@, qr/$PARAM{version}/, 'help includes version'); like($@, qr/$PARAM{url}/, 'help includes url'); like($@, qr/General Public Licence/, 'help includes licence'); like($@, qr/$PARAM{blurb}/, 'help includes blurb'); like($@, qr/Usage:/, 'help includes usage message'); like($@, qr/--version/, 'help includes default options 1'); like($@, qr/--verbose/, 'help includes default options 2'); like($@, qr/--warning/, 'help includes custom option 1'); like($@, qr/--critical/, 'help includes custom option 2'); unlike($@, qr/Missing arg/, 'no missing arguments'); @ARGV = ( '--help' ); $ng = setup; ok(! defined eval { $ng->getopts }, 'getopts died on help'); like($@, qr/^$PARAM{plugin}/, 'help includes plugin name'); like($@, qr/$PARAM{version}/, 'help includes version'); like($@, qr/$PARAM{url}/, 'help includes url'); like($@, qr/General Public Licence/, 'help includes licence'); like($@, qr/$PARAM{blurb}/, 'help includes blurb'); like($@, qr/Usage:/, 'help includes usage message'); like($@, qr/--version/, 'help includes default options 1'); like($@, qr/--verbose/, 'help includes default options 2'); like($@, qr/--warning/, 'help includes custom option 1'); like($@, qr/-c, --critical=INTEGER/, 'help includes custom option 2, with expanded args'); unlike($@, qr/Missing arg/, 'no missing arguments'); Monitoring-Plugin-0.39/t/Monitoring-Plugin-Performance-02.t0000644000175000017500000000073312267053271022235 0ustar svensven use strict; use Test::More tests => 3; use_ok("Monitoring::Plugin::Performance", use_die => 1); eval { Monitoring::Plugin::Functions::plugin_die("Testing") }; is( $@, "MONITORING-PLUGIN-PERFORMANCE-02 UNKNOWN - Testing\n", "use_die correctly set on import"); use_ok("Monitoring::Plugin::Performance"); eval { Monitoring::Plugin::Functions::plugin_die("Test OK exit", 0) }; fail("Should not get here if code works correctly because prior plugin_die should have exited"); Monitoring-Plugin-0.39/t/Monitoring-Plugin-Functions-02.t0000644000175000017500000001456412267053417021755 0ustar svensven# check_messages tests use strict; use Test::More tests => 37; BEGIN { use_ok("Monitoring::Plugin::Functions", ":all") } my ($code, $message); # ------------------------------------------------------------------------- # Check codes my @codes = ( [ [ qw(Critical) ], [ qw(Warning) ], CRITICAL ], [ [], [ qw(Warning) ], WARNING ], [ [], [], OK ], ); my $i = 0; for (@codes) { $i++; $code = check_messages( critical => $_->[0], warning => $_->[1] ); is($code, $_->[2], "Code test $i returned $STATUS_TEXT{$_->[2]}"); } # ------------------------------------------------------------------------- # Check messages my %arrays = ( critical => [ qw(A B C) ], warning => [ qw(D E F) ], ok => [ qw(G H I) ], ); my %messages = map { $_ => join(' ', @{$arrays{$_}}) } keys %arrays; # critical, warning ($code, $message) = check_messages( critical => $arrays{critical}, warning => $arrays{warning}, ); is($code, CRITICAL, "(critical, warning) code is $STATUS_TEXT{$code}"); is($message, $messages{critical}, "(critical, warning) message is $message"); # critical, warning, ok ($code, $message) = check_messages( critical => $arrays{critical}, warning => $arrays{warning}, ok => $arrays{ok}, ); is($code, CRITICAL, "(critical, warning, ok) code is $STATUS_TEXT{$code}"); is($message, $messages{critical}, "(critical, warning, ok) message is $message"); # critical, warning, $ok ($code, $message) = check_messages( critical => $arrays{critical}, warning => $arrays{warning}, ok => 'G H I', ); is($code, CRITICAL, "(critical, warning, \$ok) code is $STATUS_TEXT{$code}"); is($message, $messages{critical}, "(critical, warning, \$ok) message is $message"); # warning ($code, $message) = check_messages( critical => [], warning => $arrays{warning}, ); is($code, WARNING, "(warning) code is $STATUS_TEXT{$code}"); is($message, $messages{warning}, "(warning) message is $message"); # warning, ok ($code, $message) = check_messages( critical => [], warning => $arrays{warning}, ok => $arrays{ok}, ); is($code, WARNING, "(warning, ok) code is $STATUS_TEXT{$code}"); is($message, $messages{warning}, "(warning, ok) message is $message"); # ok ($code, $message) = check_messages( critical => [], warning => [], ok => $arrays{ok}, ); is($code, OK, "(ok) code is $STATUS_TEXT{$code}"); is($message, $messages{ok}, "(ok) message is $message"); # $ok ($code, $message) = check_messages( critical => [], warning => [], ok => 'G H I', ); is($code, OK, "(\$ok) code is $STATUS_TEXT{$code}"); is($message, $messages{ok}, "(\$ok) message is $message"); # ------------------------------------------------------------------------- # explicit join my $join = '+'; ($code, $message) = check_messages( critical => $arrays{critical}, warning => $arrays{warning}, join => $join, ); is($message, join($join, @{$arrays{critical}}), "joined '$join' (critical, warning) message is $message"); $join = ''; ($code, $message) = check_messages( critical => [], warning => $arrays{warning}, join => $join, ); is($message, join($join, @{$arrays{warning}}), "joined '$join' (warning) message is $message"); $join = undef; ($code, $message) = check_messages( critical => [], warning => [], ok => $arrays{ok}, join => $join, ); is($message, join(' ', @{$arrays{ok}}), "joined undef (ok) message is $message"); # ------------------------------------------------------------------------- # join_all messages my $join_all = ' :: '; my $msg_all_cwo = join($join_all, map { join(' ', @{$arrays{$_}}) } qw(critical warning ok)); my $msg_all_cw = join($join_all, map { join(' ', @{$arrays{$_}}) } qw(critical warning)); my $msg_all_wo = join($join_all, map { join(' ', @{$arrays{$_}}) } qw(warning ok)); # critical, warning, ok ($code, $message) = check_messages( critical => $arrays{critical}, warning => $arrays{warning}, ok => $arrays{ok}, join_all => $join_all, ); is($code, CRITICAL, "(critical, warning, ok) code is $STATUS_TEXT{$code}"); is($message, $msg_all_cwo, "join_all '$join_all' (critical, warning, ok) message is $message"); # critical, warning, $ok ($code, $message) = check_messages( critical => $arrays{critical}, warning => $arrays{warning}, ok => 'G H I', join_all => $join_all, ); is($code, CRITICAL, "(critical, warning, \$ok) code is $STATUS_TEXT{$code}"); is($message, $msg_all_cwo, "join_all '$join_all' (critical, warning, \$ok) message is $message"); # critical, warning ($code, $message) = check_messages( critical => $arrays{critical}, warning => $arrays{warning}, join_all => $join_all, ); is($code, CRITICAL, "(critical, warning) code is $STATUS_TEXT{$code}"); is($message, $msg_all_cw, "join_all '$join_all' (critical, warning) message is $message"); # warning, ok ($code, $message) = check_messages( critical => [], warning => $arrays{warning}, ok => $arrays{ok}, join_all => $join_all, ); is($code, WARNING, "(warning, ok) code is $STATUS_TEXT{$code}"); is($message, $msg_all_wo, "join_all '$join_all' (critical, warning, ok) message is $message"); # warning, $ok ($code, $message) = check_messages( critical => [], warning => $arrays{warning}, ok => 'G H I', join_all => $join_all, ); is($code, WARNING, "(warning, \$ok) code is $STATUS_TEXT{$code}"); is($message, $msg_all_wo, "join_all '$join_all' (critical, warning, \$ok) message is $message"); # warning ($code, $message) = check_messages( critical => [], warning => $arrays{warning}, join_all => $join_all, ); is($code, WARNING, "(warning) code is $STATUS_TEXT{$code}"); is($message, 'D E F', "join_all '$join_all' (critical, warning) message is $message"); # ------------------------------------------------------------------------- # Error cases # Test failures without required fields ok(! defined eval { ($code, $message) = check_messages() }, "check_messages dies without message args"); ok(! defined eval { ($code, $message) = check_messages(warning => $arrays{warning}) }, "check_messages dies without 'critical' message"); ok(! defined eval { ($code, $message) = check_messages(critical => $arrays{critical}) }, "check_messages dies without 'warning' message"); ok(defined eval { ($code, $message) = check_messages(critical => $arrays{critical}, warning => $arrays{warning}) }, "check_messages ok with 'critical' and 'warning' messages"); Monitoring-Plugin-0.39/t/Monitoring-Plugin-Functions-04.t0000644000175000017500000000123012267053410021732 0ustar svensven# max_state_alt tests use strict; use Test::More tests => 8; BEGIN { use_ok("Monitoring::Plugin::Functions", ":all") } my $new_state = max_state_alt( OK, WARNING ); is( $new_state, WARNING, "Moved up to WARNING" ); is( max_state_alt( $new_state, UNKNOWN ), WARNING, "Still at WARNING" ); $new_state = max_state_alt( $new_state, CRITICAL ); is( $new_state, CRITICAL, "Now at CRITICAL" ); is( max_state_alt( OK, OK ), OK, "This is OK" ); is( max_state_alt( OK, UNKNOWN ), UNKNOWN, "This is UNKNOWN" ); is( max_state_alt( OK, OK, OK, OK, OK, WARNING ), WARNING, "Use WARNING in this list" ); is( max_state_alt(), UNKNOWN, "Return UNKNOWN if no parameters" ); Monitoring-Plugin-0.39/t/Monitoring-Plugin-05.t0000644000175000017500000000061012267053561017775 0ustar svensven# Check for exported vars # Can't include Monitoring::Plugin::Functions because it also exports %STATUS_TEXT use strict; use Test::More tests=>4; BEGIN { use_ok('Monitoring::Plugin') }; eval ' $_ = $STATUS_TEXT{0} '; like( $@, '/Global symbol "%STATUS_TEXT" requires explicit package name/' ); use_ok("Monitoring::Plugin", qw(%STATUS_TEXT)); eval ' $_ = $STATUS_TEXT{0} '; is( $@, '' ); Monitoring-Plugin-0.39/t/Monitoring-Plugin-Range.t0000644000175000017500000001740512267053207020614 0ustar svensven use strict; #use Test::More qw(no_plan); use Test::More tests => 151; BEGIN { use_ok('Monitoring::Plugin::Range'); # Silence warnings unless TEST_VERBOSE is set $SIG{__WARN__} = sub { warn $_[0] if $ENV{TEST_VERBOSE} }; }; diag "\nusing Monitoring::Plugin::Range revision ". $Monitoring::Plugin::Range::VERSION . "\n" if $ENV{TEST_VERBOSE}; my $r; diag "'garbage in' checks -- you should see 7 invalid range definition warnings here:" if $ENV{TEST_VERBOSE}; foreach (qw( : 1:~ foo 1-10 10:~ 1-10:2.4 ), '1,10' # avoid warning about using , inside qw() ) { $r =Monitoring::Plugin::Range->parse_range_string($_); is $r, undef, "'$_' should not be a valid range" ; } diag "range: 0..6 inclusive" if $ENV{TEST_VERBOSE}; $r = Monitoring::Plugin::Range->parse_range_string("6"); isa_ok( $r, "Monitoring::Plugin::Range"); ok( defined $r, "'6' is valid range"); cmp_ok( $r->start, '==', 0, "Start correct"); cmp_ok( $r->start_infinity, '==', 0, "Not using negative infinity"); cmp_ok( $r->end, '==', 6, "End correct"); cmp_ok( $r->end_infinity, '==', 0, "Not using positive infinity"); cmp_ok( $r, 'eq', "6", "Stringification back to original"); my $expected = { -1 => 1, # 1 means it raises an alert because it's OUTSIDE the range 0 => 0, # 0 means it's inside the range (no alert) 4 => 0, 6 => 0, 6.1 => 1, 79.999999 => 1, }; sub test_expected { my $r = shift; my $expected = shift; foreach (sort {$a<=>$b} keys %$expected) { is $r->check_range($_), $expected->{$_}, " $_ should " . ($expected->{$_} ? 'not ' : '') . "be in the range (line ".(caller)[2].")"; } } test_expected( $r, $expected ); diag "range : -7..23, inclusive" if $ENV{TEST_VERBOSE}; $r = Monitoring::Plugin::Range->parse_range_string("-7:23"); ok( defined $r, "'-7:23' is valid range"); cmp_ok( $r->start, '==', -7, "Start correct"); cmp_ok( $r->start_infinity, '==', 0, "Not using negative infinity"); cmp_ok( $r->end, '==', 23, "End correct"); cmp_ok( $r->end_infinity, '==', 0, "Not using positive infinity"); cmp_ok( $r, 'eq', "-7:23", "Stringification back to original"); $expected = { -23 => 1, -7 => 0, -1 => 0, 0 => 0, 4 => 0, 23 => 0, 23.1 => 1, 79.999999 => 1, }; test_expected( $r, $expected ); diag "range : 0..5.75, inclusive" if $ENV{TEST_VERBOSE}; $r = Monitoring::Plugin::Range->parse_range_string(":5.75"); ok( defined $r, "':5.75' is valid range"); cmp_ok( $r->start, '==', 0, "Start correct"); cmp_ok( $r->start_infinity, '==', 0, "Not using negative infinity"); cmp_ok( $r->end, '==', 5.75, "End correct"); cmp_ok( $r->end_infinity, '==', 0, "Not using positive infinity"); cmp_ok( $r, 'eq', "5.75", "Stringification to simplification"); $expected = { -1 => 1, 0 => 0, 4 => 0, 5.75 => 0, 5.7501 => 1, 6 => 1, 6.1 => 1, 79.999999 => 1, }; test_expected( $r, $expected ); diag "range : negative infinity .. -95.99, inclusive" if $ENV{TEST_VERBOSE}; $r = Monitoring::Plugin::Range->parse_range_string("~:-95.99"); ok( defined $r, "'~:-95.99' is valid range"); cmp_ok( $r->start_infinity, '==', 1, "Using negative infinity"); cmp_ok( $r->end, '==', -95.99, "End correct"); cmp_ok( $r->end_infinity, '==', 0, "Not using positive infinity"); cmp_ok( $r, 'eq', "~:-95.99", "Stringification back to original"); $expected = { -1001341 => 0, -96 => 0, -95.999 => 0, -95.99 => 0, -95.989 => 1, -95 => 1, 0 => 1, 5.7501 => 1, 79.999999 => 1, }; test_expected( $r, $expected ); diag "range 10..infinity , inclusive" if $ENV{TEST_VERBOSE}; test_expected( $r, $expected ); $r = Monitoring::Plugin::Range->parse_range_string("10:"); ok( defined $r, "'10:' is valid range"); cmp_ok( $r->start, '==', 10, "Start correct"); cmp_ok( $r->start_infinity, '==', 0, "Not using negative infinity"); cmp_ok( $r->end_infinity, '==', 1, "Using positive infinity"); cmp_ok( $r, 'eq', "10:", "Stringification back to original"); $expected = { -95.999 => 1, -1 => 1, 0 => 1, 9.91 => 1, 10 => 0, 11.1 => 0, 123456789012346 => 0, }; test_expected( $r, $expected ); diag "range 123456789012345..infinity , inclusive" if $ENV{TEST_VERBOSE}; test_expected( $r, $expected ); $r = Monitoring::Plugin::Range->parse_range_string("123456789012345:"); ok( defined $r, "'123456789012345:' is valid range"); cmp_ok( $r->start, '==', 123456789012345, "Start correct"); cmp_ok( $r->start_infinity, '==', 0, "Not using negative infinity"); cmp_ok( $r->end_infinity, '==', 1, "Using positive infinity"); cmp_ok( $r, 'eq', "123456789012345:", "Stringification back to original"); $expected = { -95.999 => 1, -1 => 1, 0 => 1, # The fractional values needs to be quoted, otherwise the hash rounds it up to ..345 # and there is one less test run. # I think some newer versions of perl use a higher precision value for the hash key. # This doesn't appear to affect the actual plugin though "123456789012344.91" => 1, 123456789012345 => 0, "123456789012345.61" => 0, 123456789012346 => 0, }; test_expected( $r, $expected ); diag "range: <= zero " if $ENV{TEST_VERBOSE}; $r = Monitoring::Plugin::Range->parse_range_string("~:0"); ok( defined $r, "'~:0' is valid range"); cmp_ok( $r->start_infinity, '==', 1, "Using negative infinity"); cmp_ok( $r->end, '==', 0, "End correct"); cmp_ok( $r->end_infinity, '==', 0, "Not using positive infinity"); cmp_ok( $r->alert_on, '==', 0, "Will alert on outside of range"); cmp_ok( $r, 'eq', "~:0", "Stringification back to original"); ok( $r->check_range(0.5) == 1, "0.5 - alert"); ok( $r->check_range(-10) == 0, "-10 - no alert"); ok( $r->check_range(0) == 0, "0 - no alert"); $expected = { -123456789012344.91 => 0, -1 => 0, 0 => 0, .001 => 1, 123456789012345 => 1, }; test_expected( $r, $expected ); diag "range: OUTSIDE 0..657.8210567" if $ENV{TEST_VERBOSE}; $r = Monitoring::Plugin::Range->parse_range_string('@0:657.8210567'); ok( defined $r, '"@0:657.8210567" is a valid range'); cmp_ok( $r->start, '==', 0, "Start correct"); cmp_ok( $r->start_infinity, '==', 0, "Not using negative infinity"); cmp_ok( $r->end, '==', 657.8210567, "End correct"); cmp_ok( $r->end_infinity, '==', 0, "Not using positive infinity"); cmp_ok( $r->alert_on, '==', 1, "Will alert on inside of range"); cmp_ok( $r, 'eq', '@657.8210567', "Stringification to simplified version"); ok( $r->check_range(32.88) == 1, "32.88 - alert"); ok( $r->check_range(-2) == 0, "-2 - no alert"); ok( $r->check_range(657.8210567) == 1, "657.8210567 - alert"); ok( $r->check_range(0) == 1, "0 - alert"); $expected = { -134151 => 0, -1 => 0, 0 => 1, .001 => 1, 657.8210567 => 1, 657.9 => 0, 123456789012345 => 0, }; test_expected( $r, $expected ); diag "range: 1..1 inclusive (equals one)" if $ENV{TEST_VERBOSE}; $r = Monitoring::Plugin::Range->parse_range_string('1:1'); ok( defined $r, '"1:1" is a valid range'); cmp_ok( $r->start, '==', 1, "Start correct"); cmp_ok( $r->start_infinity, '==', 0, "Not using negative infinity"); cmp_ok( $r->end, '==', 1, "End correct"); cmp_ok( $r->end_infinity, '==', 0, "Not using positive infinity"); cmp_ok( $r, 'eq', "1:1", "Stringification to simplified version"); ok( $r->check_range(0.5) == 1, "0.5 - alert"); ok( $r->check_range(1) == 0, "1 - no alert"); ok( $r->check_range(5.2) == 1, "5.2 - alert"); $expected = { -1 => 1, 0 => 1, .5 => 1, 1 => 0, 1.001 => 1, 5.2 => 1, }; test_expected( $r, $expected ); $r = Monitoring::Plugin::Range->parse_range_string('2:1'); ok( ! defined $r, '"2:1" is rejected'); # TODO: Need more tests for invalid data Monitoring-Plugin-0.39/t/Monitoring-Plugin-Performance.t0000644000175000017500000004021712267054147022022 0ustar svensven use warnings; use strict; use Test::More; use Monitoring::Plugin::Functions; Monitoring::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, clean_label => "root", }, { 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', }, { perfoutput => "'page file'=36%;80;90;", expected_perfoutput => "'page file'=36%;80;90", label => 'page file', rrdlabel => 'page_file', value => '36', uom => '%', warning => 80, critical => 90, min => undef, max => undef, clean_label => 'page_file', }, { perfoutput => "'data'=5;;;;", expected_perfoutput => "data=5;;", label => 'data', rrdlabel => 'data', value => 5, uom => "", warning => undef, critical => undef, min => undef, max => undef, clean_label => 'data', }, ); plan tests => (11 * scalar @test) + 176; use_ok('Monitoring::Plugin::Performance'); diag "\nusing Monitoring::Plugin::Performance revision ". $Monitoring::Plugin::Performance::VERSION . "\n" if $ENV{TEST_VERBOSE}; # Round-trip tests for my $t (@test) { # Parse to components ($p) = Monitoring::Plugin::Performance->parse_perfstring($t->{perfoutput}); is ($p->value, $t->{value}, "value okay $t->{value}"); is ($p->label, $t->{label}, "label okay $t->{label}"); is ($p->uom, $t->{uom}, "uom okay $t->{uom}"); # Construct from components my @construct = qw(label value uom warning critical min max); $p = Monitoring::Plugin::Performance->new(map { $_ => $t->{$_} } @construct); my $expected_perfoutput = $t->{perfoutput}; if (exists $t->{expected_perfoutput}) { $expected_perfoutput = $t->{expected_perfoutput}; }; is($p->perfoutput, $expected_perfoutput, "perfoutput okay ($expected_perfoutput)"); # Check threshold accessor foreach my $type (qw(warning critical)) { if (! defined $t->{$type}) { isnt( $p->threshold->$type->is_set, "threshold $type not set"); } else { is($p->threshold->$type->end, $t->{$type}, "threshold $type okay ($t->{$type})"); } } 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); $p = Monitoring::Plugin::Performance->new( map({ $_ => $t->{$_} } @construct), threshold => Monitoring::Plugin::Threshold->set_thresholds(warning => $t->{warning}, critical => $t->{critical}), ); is($p->perfoutput, $expected_perfoutput, "perfoutput okay ($expected_perfoutput)"); # Check warning/critical accessors foreach my $type (qw(warning critical)) { if (! defined $t->{$type}) { isnt( $p->threshold->$type->is_set, "threshold $type not set"); } else { is($p->threshold->$type->end, $t->{$type}, "threshold $type okay ($t->{$type})"); } } } # Test multiple parse_perfstrings @p = Monitoring::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 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"); cmp_ok( $p[1]->value, '==', 218, "value okay"); cmp_ok( $p[1]->uom, 'eq', "MB", "uom okay"); cmp_ok( $p[1]->threshold->warning->end, "==", 9443, "warn okay"); cmp_ok( $p[1]->threshold->critical->end, "==", 9448, "crit okay"); @p = Monitoring::Plugin::Performance->parse_perfstring("rubbish"); ok( ! @p, "Errors correctly"); ok( ! Monitoring::Plugin::Performance->parse_perfstring(""), "Errors on empty string"); # Check 1 bad with 1 good format output @p = Monitoring::Plugin::Performance->parse_perfstring("rta=&391ms;100,200;500,034;0; pl=0%;20;60 "); is( scalar @p, 1, "One bad piece of data - only one returned" ); is( $p[0]->label, "pl", "label okay for different numeric"); is( $p[0]->value, 0, "value okay"); is( $p[0]->uom, "%", "uom okay"); ok( $p[0]->threshold->warning->is_set, "Warning range has been set"); is( $p[0]->threshold->warning, "20", "warn okay"); is( $p[0]->threshold->critical->is_set, 1, "Critical range has been set"); is( $p[0]->threshold->critical, "60", "warn okay"); # Same as above, but order swapped @p = Monitoring::Plugin::Performance->parse_perfstring(" pl=0%;20;60 rta=&391ms;100,200;500,034;0; "); is( scalar @p, 1, "One bad piece of data - only one returned" ); is( $p[0]->label, "pl", "label okay for different numeric"); is( $p[0]->value, 0, "value okay"); is( $p[0]->uom, "%", "uom okay"); ok( $p[0]->threshold->warning->is_set, "Warning range has been set"); is( $p[0]->threshold->warning, "20", "warn okay"); is( $p[0]->threshold->critical->is_set, 1, "Critical range has been set"); is( $p[0]->threshold->critical, "60", "warn okay"); @p = Monitoring::Plugin::Performance->parse_perfstring( "time=0.001229s;0.000000;0.000000;0.000000;10.000000"); cmp_ok( $p[0]->label, "eq", "time", "label okay"); cmp_ok( $p[0]->value, "==", 0.001229, "value okay"); cmp_ok( $p[0]->uom, "eq", "s", "uom okay"); ok( $p[0]->threshold->warning->is_set, "warn okay"); ok( $p[0]->threshold->critical->is_set, "crit okay"); @p = Monitoring::Plugin::Performance->parse_perfstring( "load1=0.000;5.000;9.000;0; load5=0.000;5.000;9.000;0; load15=0.000;5.000;9.000;0;"); cmp_ok( $p[0]->label, "eq", "load1", "label okay"); cmp_ok( $p[0]->value, "eq", "0", "value okay with 0 as string"); cmp_ok( $p[0]->uom, "eq", "", "uom empty"); cmp_ok( $p[0]->threshold->warning, "eq", "5", "warn okay"); cmp_ok( $p[0]->threshold->critical, "eq", "9", "crit okay"); cmp_ok( $p[1]->label, "eq", "load5", "label okay"); cmp_ok( $p[2]->label, "eq", "load15", "label okay"); @p = Monitoring::Plugin::Performance->parse_perfstring( "users=4;20;50;0" ); cmp_ok( $p[0]->label, "eq", "users", "label okay"); cmp_ok( $p[0]->value, "==", 4, "value okay"); cmp_ok( $p[0]->uom, "eq", "", "uom empty"); cmp_ok( $p[0]->threshold->warning, 'eq', "20", "warn okay"); cmp_ok( $p[0]->threshold->critical, 'eq', "50", "crit okay"); @p = Monitoring::Plugin::Performance->parse_perfstring( "users=4;20;50;0\n" ); ok( @p, "parse correctly with linefeed at end (nagiosgraph)"); @p = Monitoring::Plugin::Performance->parse_perfstring( "time=0.215300s;5.000000;10.000000;0.000000 size=426B;;;0" ); cmp_ok( $p[0]->label, "eq", "time", "label okay"); cmp_ok( $p[0]->value, "eq", "0.2153", "value okay"); cmp_ok( $p[0]->uom, "eq", "s", "uom okay"); cmp_ok( $p[0]->threshold->warning, 'eq', "5", "warn okay"); cmp_ok( $p[0]->threshold->critical, 'eq', "10", "crit okay"); cmp_ok( $p[1]->label, "eq", "size", "label okay"); cmp_ok( $p[1]->value, "==", 426, "value okay"); cmp_ok( $p[1]->uom, "eq", "B", "uom okay"); ok( ! $p[1]->threshold->warning->is_set, "warn okay"); ok( ! $p[1]->threshold->critical->is_set, "crit okay"); # Edge cases @p = Monitoring::Plugin::Performance->parse_perfstring("/home/a-m=0;0;0 shared-folder:big=20 12345678901234567890=20"); cmp_ok( $p[0]->rrdlabel, "eq", "home_a_m", "changing / to _"); ok( $p[0]->threshold->warning->is_set, "Warning range has been set"); cmp_ok( $p[1]->rrdlabel, "eq", "shared_folder_big", "replacing bad characters"); cmp_ok( $p[2]->rrdlabel, "eq", "1234567890123456789", "shortening rrd label"); # turn off fake_exit and enable use_die so we pick up on errors via plugin_die Monitoring::Plugin::Functions::_use_die(1); Monitoring::Plugin::Functions::_fake_exit(0); @p = Monitoring::Plugin::Performance->parse_perfstring("time=0.002722s;0.000000;0.000000;0.000000;10.000000"); cmp_ok( $p[0]->label, "eq", "time", "label okay"); cmp_ok( $p[0]->value, "eq", "0.002722", "value okay"); cmp_ok( $p[0]->uom, "eq", "s", "uom okay"); ok( defined $p[0]->threshold->warning->is_set, "Warning range has been set"); ok( defined $p[0]->threshold->critical->is_set, "Critical range has been set"); # The two below used to be cmp_ok, but Test::More 0.86 appears to have a problem with a stringification # of 0. See http://rt.cpan.org/Ticket/Display.html?id=41109 # We need to force stringification for test. See RT 57709 is( $p[0]->threshold->warning."", "0", "warn okay"); is( $p[0]->threshold->critical."", "0", "crit okay"); @p = Monitoring::Plugin::Performance->parse_perfstring("pct_used=73.7%;90;95"); cmp_ok( $p[0]->label, "eq", "pct_used", "label okay"); cmp_ok( $p[0]->value, "eq", "73.7", "value okay"); cmp_ok( $p[0]->uom, "eq", "%", "uom okay"); ok( defined eval { $p[0]->threshold->warning->is_set }, "Warning range has been set"); ok( defined eval { $p[0]->threshold->critical->is_set }, "Critical range has been set"); cmp_ok( $p[0]->threshold->warning, 'eq', "90", "warn okay"); cmp_ok( $p[0]->threshold->critical, 'eq', "95", "crit okay"); # Check ranges are parsed correctly @p = Monitoring::Plugin::Performance->parse_perfstring("availability=93.8%;90:99;"); is( $p[0]->label, "availability", "label okay"); is( $p[0]->value, "93.8", "value okay"); is( $p[0]->uom, "%", "uom okay"); ok( defined eval { $p[0]->threshold->warning->is_set }, "Warning range has been set"); is( $p[0]->threshold->critical->is_set, 0, "Critical range has not been set"); is( $p[0]->threshold->warning, "90:99", "warn okay"); # Check that negative values are parsed correctly in value and ranges @p = Monitoring::Plugin::Performance->parse_perfstring("offset=-0.004476s;-60.000000:-5;-120.000000:-3;"); is( $p[0]->label, "offset", "label okay"); is( $p[0]->value, "-0.004476", "value okay"); is( $p[0]->uom, "s", "uom okay"); ok( defined eval { $p[0]->threshold->warning->is_set }, "Warning range has been set"); ok( defined eval { $p[0]->threshold->critical->is_set }, "Critical range has been set"); is( $p[0]->threshold->warning, "-60:-5", "warn okay"); is( $p[0]->threshold->critical, "-120:-3", "crit okay"); # Check infinity values are okay @p = Monitoring::Plugin::Performance->parse_perfstring("salary=52GBP;~:23.5;45.2:"); is( $p[0]->label, "salary", "label okay"); is( $p[0]->value, "52", "value okay"); is( $p[0]->uom, "GBP", "uom okay"); ok( defined eval { $p[0]->threshold->warning->is_set }, "Warning range has been set"); is( $p[0]->threshold->critical->is_set, 1, "Critical range has been set"); is( $p[0]->threshold->warning, "~:23.5", "warn okay"); is( $p[0]->threshold->critical, "45.2:", "warn okay"); # Check scientific notation @p = Monitoring::Plugin::Performance->parse_perfstring("offset=1.120567322e-05"); is( $p[0]->label, "offset", "label okay for scientific notation"); is( $p[0]->value, 1.120567322e-05, "value okay"); is( $p[0]->uom, "", "uom okay"); ok( ! $p[0]->threshold->warning->is_set, "Warning range has not been set"); ok( ! $p[0]->threshold->critical->is_set, "Critical range has not been set"); # Check scientific notation with warnings and criticals @p = Monitoring::Plugin::Performance->parse_perfstring("offset=-1.120567322e-05unit;-1.1e-05:1.0e-03;4.3e+02:4.3e+25"); is( $p[0]->label, "offset", "label okay for scientific notation in warnings and criticals"); is( $p[0]->value, -1.120567322e-05, "value okay"); is( $p[0]->uom, "unit", "uom okay"); ok( $p[0]->threshold->warning->is_set, "Warning range has been set"); is( $p[0]->threshold->warning, "-1.1e-05:0.001", "warn okay"); is( $p[0]->threshold->critical->is_set, 1, "Critical range has been set"); is( $p[0]->threshold->critical, "430:4.3e+25", "warn okay"); # Check different collation with commas instead of periods @p = Monitoring::Plugin::Performance->parse_perfstring("rta=1,391ms;100,200;500,034;0; pl=0%;20;60;;"); is( $p[0]->label, "rta", "label okay for numeric with commas instead of periods"); is( $p[0]->value, 1.391, "value okay"); is( $p[0]->uom, "ms", "uom okay"); ok( $p[0]->threshold->warning->is_set, "Warning range has been set"); is( $p[0]->threshold->warning, "100.2", "warn okay"); is( $p[0]->threshold->critical->is_set, 1, "Critical range has been set"); is( $p[0]->threshold->critical, "500.034", "warn okay"); is( $p[1]->label, "pl", "label okay for different numeric"); is( $p[1]->value, 0, "value okay"); is( $p[1]->uom, "%", "uom okay"); ok( $p[1]->threshold->warning->is_set, "Warning range has been set"); is( $p[1]->threshold->warning, "20", "warn okay"); is( $p[1]->threshold->critical->is_set, 1, "Critical range has been set"); is( $p[1]->threshold->critical, "60", "warn okay"); # Another set of comma separated stuff @p = Monitoring::Plugin::Performance->parse_perfstring("offset=-0,023545s;60,000000;120,000000;"); is( $p[0]->label, "offset", "label okay for numeric with commas instead of periods"); is( $p[0]->value, -0.023545, "value okay"); is( $p[0]->uom, "s", "uom okay"); is( $p[0]->threshold->warning->is_set, 1, "Warning range has been set"); is( $p[0]->threshold->warning, 60, "warn okay"); is( $p[0]->threshold->critical->is_set, 1, "Critical range has been set"); is( $p[0]->threshold->critical, 120, "warn okay"); # Some values with funny commas @p = Monitoring::Plugin::Performance->parse_perfstring("time=1800,600,300,0,3600 other=45.6"); is( $p[0]->label, "other", "Ignored time=1800,600,300,0,3600, but allowed other=45.6"); is( $p[0]->value, 45.6, "value okay"); is( $p[0]->uom, "", "uom okay"); # Test labels with spaces (returned by nsclient++) @p = Monitoring::Plugin::Performance->parse_perfstring("'C:\ Label: Serial Number bc22aa2e'=8015MB;16387;18435;0;20484 'D:\ Label: Serial Number XA22aa2e'=8015MB;16388;18436;1;2048"); is( $p[0]->label, "C:\ Label: Serial Number bc22aa2e"); is( $p[0]->rrdlabel, "C__Label___Serial_N"); is( $p[0]->value, 8015, "value okay"); is( $p[0]->uom, "MB", "uom okay"); is( $p[0]->threshold->warning->end, 16387, "warn okay"); is( $p[0]->threshold->critical->end, 18435, "crit okay"); is( $p[0]->min, 0, "min ok"); is( $p[0]->max, 20484, "max ok"); is( $p[1]->label, "D:\ Label: Serial Number XA22aa2e", "label okay"); is( $p[1]->rrdlabel, "D__Label__Serial_Nu", "rrd label okay"); is( $p[1]->value, 8015, "value okay"); is( $p[1]->uom, "MB", "uom okay"); is( $p[1]->threshold->warning->end, 16388, "warn okay"); is( $p[1]->threshold->critical->end, 18436, "crit okay"); is( $p[1]->min, 1, "min ok"); is( $p[1]->max, 2048, "max ok"); # Mix labels with and without quotes @p = Monitoring::Plugin::Performance->parse_perfstring(" short=4 'C:\ Label: Serial Number bc22aa2e'=8015MB;16387;18435;0;20484 end=5 "); is( $p[0]->label, "short" ); is( $p[0]->rrdlabel, "short"); is( $p[0]->value, 4, "value okay"); is( $p[0]->uom, "", "uom okay"); isnt( $p[0]->threshold->warning->is_set, "warn okay"); isnt( $p[0]->threshold->critical->is_set, "crit okay"); is( $p[0]->min, undef, "min ok"); is( $p[0]->max, undef, "max ok"); is( $p[1]->label, "C:\ Label: Serial Number bc22aa2e", "label okay"); is( $p[1]->rrdlabel, "C__Label___Serial_N", "rrd label okay"); is( $p[1]->value, 8015, "value okay"); is( $p[1]->uom, "MB", "uom okay"); is( $p[1]->threshold->warning->end, 16387, "warn okay"); is( $p[1]->threshold->critical->end, 18435, "crit okay"); is( $p[1]->min, 0, "min ok"); is( $p[1]->max, 20484, "max ok"); is( $p[2]->label, "end" ); is( $p[2]->rrdlabel, "end" ); is( $p[2]->value, 5, "value okay"); is( $p[2]->uom, "", "uom okay"); isnt( $p[2]->threshold->warning->is_set, "warn okay"); isnt( $p[2]->threshold->critical->is_set, 18436, "crit okay"); is( $p[2]->min, undef, "min ok"); is( $p[2]->max, undef, "max ok"); @p = Monitoring::Plugin::Performance->parse_perfstring("processes=9;WKFLSV32.exe;9="); is_deeply( \@p, [], "Fails parsing correctly"); # add_perfdata tests in t/Monitoring-Plugin-01.t Monitoring-Plugin-0.39/inc/0000755000175000017500000000000012512177466014322 5ustar svensvenMonitoring-Plugin-0.39/inc/Module/0000755000175000017500000000000012512177466015547 5ustar svensvenMonitoring-Plugin-0.39/inc/Module/Install.pm0000644000175000017500000003013512512177300017500 0ustar svensven#line 1 package Module::Install; # For any maintainers: # The load order for Module::Install is a bit magic. # It goes something like this... # # IF ( host has Module::Install installed, creating author mode ) { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install # 3. The installed version of inc::Module::Install loads # 4. inc::Module::Install calls "require Module::Install" # 5. The ./inc/ version of Module::Install loads # } ELSE { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install # 3. The ./inc/ version of Module::Install loads # } use 5.005; use strict 'vars'; use Cwd (); use File::Find (); use File::Path (); use vars qw{$VERSION $MAIN}; BEGIN { # All Module::Install core packages now require synchronised versions. # This will be used to ensure we don't accidentally load old or # different versions of modules. # This is not enforced yet, but will be some time in the next few # releases once we can make sure it won't clash with custom # Module::Install extensions. $VERSION = '1.06'; # Storage for the pseudo-singleton $MAIN = undef; *inc::Module::Install::VERSION = *VERSION; @inc::Module::Install::ISA = __PACKAGE__; } sub import { my $class = shift; my $self = $class->new(@_); my $who = $self->_caller; #------------------------------------------------------------- # all of the following checks should be included in import(), # to allow "eval 'require Module::Install; 1' to test # installation of Module::Install. (RT #51267) #------------------------------------------------------------- # Whether or not inc::Module::Install is actually loaded, the # $INC{inc/Module/Install.pm} is what will still get set as long as # the caller loaded module this in the documented manner. # If not set, the caller may NOT have loaded the bundled version, and thus # they may not have a MI version that works with the Makefile.PL. This would # result in false errors or unexpected behaviour. And we don't want that. my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm'; unless ( $INC{$file} ) { die <<"END_DIE" } Please invoke ${\__PACKAGE__} with: use inc::${\__PACKAGE__}; not: use ${\__PACKAGE__}; END_DIE # This reportedly fixes a rare Win32 UTC file time issue, but # as this is a non-cross-platform XS module not in the core, # we shouldn't really depend on it. See RT #24194 for detail. # (Also, this module only supports Perl 5.6 and above). eval "use Win32::UTCFileTime" if $^O eq 'MSWin32' && $] >= 5.006; # If the script that is loading Module::Install is from the future, # then make will detect this and cause it to re-run over and over # again. This is bad. Rather than taking action to touch it (which # is unreliable on some platforms and requires write permissions) # for now we should catch this and refuse to run. if ( -f $0 ) { my $s = (stat($0))[9]; # If the modification time is only slightly in the future, # sleep briefly to remove the problem. my $a = $s - time; if ( $a > 0 and $a < 5 ) { sleep 5 } # Too far in the future, throw an error. my $t = time; if ( $s > $t ) { die <<"END_DIE" } Your installer $0 has a modification time in the future ($s > $t). This is known to create infinite loops in make. Please correct this, then run $0 again. END_DIE } # Build.PL was formerly supported, but no longer is due to excessive # difficulty in implementing every single feature twice. if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" } Module::Install no longer supports Build.PL. It was impossible to maintain duel backends, and has been deprecated. Please remove all Build.PL files and only use the Makefile.PL installer. END_DIE #------------------------------------------------------------- # To save some more typing in Module::Install installers, every... # use inc::Module::Install # ...also acts as an implicit use strict. $^H |= strict::bits(qw(refs subs vars)); #------------------------------------------------------------- unless ( -f $self->{file} ) { foreach my $key (keys %INC) { delete $INC{$key} if $key =~ /Module\/Install/; } local $^W; require "$self->{path}/$self->{dispatch}.pm"; File::Path::mkpath("$self->{prefix}/$self->{author}"); $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self ); $self->{admin}->init; @_ = ($class, _self => $self); goto &{"$self->{name}::import"}; } local $^W; *{"${who}::AUTOLOAD"} = $self->autoload; $self->preload; # Unregister loader and worker packages so subdirs can use them again delete $INC{'inc/Module/Install.pm'}; delete $INC{'Module/Install.pm'}; # Save to the singleton $MAIN = $self; return 1; } sub autoload { my $self = shift; my $who = $self->_caller; my $cwd = Cwd::cwd(); my $sym = "${who}::AUTOLOAD"; $sym->{$cwd} = sub { my $pwd = Cwd::cwd(); if ( my $code = $sym->{$pwd} ) { # Delegate back to parent dirs goto &$code unless $cwd eq $pwd; } unless ($$sym =~ s/([^:]+)$//) { # XXX: it looks like we can't retrieve the missing function # via $$sym (usually $main::AUTOLOAD) in this case. # I'm still wondering if we should slurp Makefile.PL to # get some context or not ... my ($package, $file, $line) = caller; die <<"EOT"; Unknown function is found at $file line $line. Execution of $file aborted due to runtime errors. If you're a contributor to a project, you may need to install some Module::Install extensions from CPAN (or other repository). If you're a user of a module, please contact the author. EOT } my $method = $1; if ( uc($method) eq $method ) { # Do nothing return; } elsif ( $method =~ /^_/ and $self->can($method) ) { # Dispatch to the root M:I class return $self->$method(@_); } # Dispatch to the appropriate plugin unshift @_, ( $self, $1 ); goto &{$self->can('call')}; }; } sub preload { my $self = shift; unless ( $self->{extensions} ) { $self->load_extensions( "$self->{prefix}/$self->{path}", $self ); } my @exts = @{$self->{extensions}}; unless ( @exts ) { @exts = $self->{admin}->load_all_extensions; } my %seen; foreach my $obj ( @exts ) { while (my ($method, $glob) = each %{ref($obj) . '::'}) { next unless $obj->can($method); next if $method =~ /^_/; next if $method eq uc($method); $seen{$method}++; } } my $who = $self->_caller; foreach my $name ( sort keys %seen ) { local $^W; *{"${who}::$name"} = sub { ${"${who}::AUTOLOAD"} = "${who}::$name"; goto &{"${who}::AUTOLOAD"}; }; } } sub new { my ($class, %args) = @_; delete $INC{'FindBin.pm'}; { # to suppress the redefine warning local $SIG{__WARN__} = sub {}; require FindBin; } # ignore the prefix on extension modules built from top level. my $base_path = Cwd::abs_path($FindBin::Bin); unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) { delete $args{prefix}; } return $args{_self} if $args{_self}; $args{dispatch} ||= 'Admin'; $args{prefix} ||= 'inc'; $args{author} ||= ($^O eq 'VMS' ? '_author' : '.author'); $args{bundle} ||= 'inc/BUNDLES'; $args{base} ||= $base_path; $class =~ s/^\Q$args{prefix}\E:://; $args{name} ||= $class; $args{version} ||= $class->VERSION; unless ( $args{path} ) { $args{path} = $args{name}; $args{path} =~ s!::!/!g; } $args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm"; $args{wrote} = 0; bless( \%args, $class ); } sub call { my ($self, $method) = @_; my $obj = $self->load($method) or return; splice(@_, 0, 2, $obj); goto &{$obj->can($method)}; } sub load { my ($self, $method) = @_; $self->load_extensions( "$self->{prefix}/$self->{path}", $self ) unless $self->{extensions}; foreach my $obj (@{$self->{extensions}}) { return $obj if $obj->can($method); } my $admin = $self->{admin} or die <<"END_DIE"; The '$method' method does not exist in the '$self->{prefix}' path! Please remove the '$self->{prefix}' directory and run $0 again to load it. END_DIE my $obj = $admin->load($method, 1); push @{$self->{extensions}}, $obj; $obj; } sub load_extensions { my ($self, $path, $top) = @_; my $should_reload = 0; unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) { unshift @INC, $self->{prefix}; $should_reload = 1; } foreach my $rv ( $self->find_extensions($path) ) { my ($file, $pkg) = @{$rv}; next if $self->{pathnames}{$pkg}; local $@; my $new = eval { local $^W; require $file; $pkg->can('new') }; unless ( $new ) { warn $@ if $@; next; } $self->{pathnames}{$pkg} = $should_reload ? delete $INC{$file} : $INC{$file}; push @{$self->{extensions}}, &{$new}($pkg, _top => $top ); } $self->{extensions} ||= []; } sub find_extensions { my ($self, $path) = @_; my @found; File::Find::find( sub { my $file = $File::Find::name; return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is; my $subpath = $1; return if lc($subpath) eq lc($self->{dispatch}); $file = "$self->{path}/$subpath.pm"; my $pkg = "$self->{name}::$subpath"; $pkg =~ s!/!::!g; # If we have a mixed-case package name, assume case has been preserved # correctly. Otherwise, root through the file to locate the case-preserved # version of the package name. if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) { my $content = Module::Install::_read($subpath . '.pm'); my $in_pod = 0; foreach ( split //, $content ) { $in_pod = 1 if /^=\w/; $in_pod = 0 if /^=cut/; next if ($in_pod || /^=cut/); # skip pod text next if /^\s*#/; # and comments if ( m/^\s*package\s+($pkg)\s*;/i ) { $pkg = $1; last; } } } push @found, [ $file, $pkg ]; }, $path ) if -d $path; @found; } ##################################################################### # Common Utility Functions sub _caller { my $depth = 0; my $call = caller($depth); while ( $call eq __PACKAGE__ ) { $depth++; $call = caller($depth); } return $call; } # Done in evals to avoid confusing Perl::MinimumVersion eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@; sub _read { local *FH; open( FH, '<', $_[0] ) or die "open($_[0]): $!"; my $string = do { local $/; }; close FH or die "close($_[0]): $!"; return $string; } END_NEW sub _read { local *FH; open( FH, "< $_[0]" ) or die "open($_[0]): $!"; my $string = do { local $/; }; close FH or die "close($_[0]): $!"; return $string; } END_OLD sub _readperl { my $string = Module::Install::_read($_[0]); $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg; $string =~ s/(\n)\n*__(?:DATA|END)__\b.*\z/$1/s; $string =~ s/\n\n=\w+.+?\n\n=cut\b.+?\n+/\n\n/sg; return $string; } sub _readpod { my $string = Module::Install::_read($_[0]); $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg; return $string if $_[0] =~ /\.pod\z/; $string =~ s/(^|\n=cut\b.+?\n+)[^=\s].+?\n(\n=\w+|\z)/$1$2/sg; $string =~ s/\n*=pod\b[^\n]*\n+/\n\n/sg; $string =~ s/\n*=cut\b[^\n]*\n+/\n\n/sg; $string =~ s/^\n+//s; return $string; } # Done in evals to avoid confusing Perl::MinimumVersion eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@; sub _write { local *FH; open( FH, '>', $_[0] ) or die "open($_[0]): $!"; foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!"; } close FH or die "close($_[0]): $!"; } END_NEW sub _write { local *FH; open( FH, "> $_[0]" ) or die "open($_[0]): $!"; foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!"; } close FH or die "close($_[0]): $!"; } END_OLD # _version is for processing module versions (eg, 1.03_05) not # Perl versions (eg, 5.8.1). sub _version ($) { my $s = shift || 0; my $d =()= $s =~ /(\.)/g; if ( $d >= 2 ) { # Normalise multipart versions $s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg; } $s =~ s/^(\d+)\.?//; my $l = $1 || 0; my @v = map { $_ . '0' x (3 - length $_) } $s =~ /(\d{1,3})\D?/g; $l = $l . '.' . join '', @v if @v; return $l + 0; } sub _cmp ($$) { _version($_[1]) <=> _version($_[2]); } # Cloned from Params::Util::_CLASS sub _CLASS ($) { ( defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s ) ? $_[0] : undef; } 1; # Copyright 2008 - 2012 Adam Kennedy. Monitoring-Plugin-0.39/inc/Module/Install/0000755000175000017500000000000012512177466017155 5ustar svensvenMonitoring-Plugin-0.39/inc/Module/Install/Base.pm0000644000175000017500000000214712512177301020355 0ustar svensven#line 1 package Module::Install::Base; use strict 'vars'; use vars qw{$VERSION}; BEGIN { $VERSION = '1.06'; } # Suspend handler for "redefined" warnings BEGIN { my $w = $SIG{__WARN__}; $SIG{__WARN__} = sub { $w }; } #line 42 sub new { my $class = shift; unless ( defined &{"${class}::call"} ) { *{"${class}::call"} = sub { shift->_top->call(@_) }; } unless ( defined &{"${class}::load"} ) { *{"${class}::load"} = sub { shift->_top->load(@_) }; } bless { @_ }, $class; } #line 61 sub AUTOLOAD { local $@; my $func = eval { shift->_top->autoload } or return; goto &$func; } #line 75 sub _top { $_[0]->{_top}; } #line 90 sub admin { $_[0]->_top->{admin} or Module::Install::Base::FakeAdmin->new; } #line 106 sub is_admin { ! $_[0]->admin->isa('Module::Install::Base::FakeAdmin'); } sub DESTROY {} package Module::Install::Base::FakeAdmin; use vars qw{$VERSION}; BEGIN { $VERSION = $Module::Install::Base::VERSION; } my $fake; sub new { $fake ||= bless(\@_, $_[0]); } sub AUTOLOAD {} sub DESTROY {} # Restore warning handler BEGIN { $SIG{__WARN__} = $SIG{__WARN__}->(); } 1; #line 159 Monitoring-Plugin-0.39/inc/Module/Install/Fetch.pm0000644000175000017500000000462712512177301020541 0ustar svensven#line 1 package Module::Install::Fetch; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub get_file { my ($self, %args) = @_; my ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) { $args{url} = $args{ftp_url} or (warn("LWP support unavailable!\n"), return); ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; } $|++; print "Fetching '$file' from $host... "; unless (eval { require Socket; Socket::inet_aton($host) }) { warn "'$host' resolve failed!\n"; return; } return unless $scheme eq 'ftp' or $scheme eq 'http'; require Cwd; my $dir = Cwd::getcwd(); chdir $args{local_dir} or return if exists $args{local_dir}; if (eval { require LWP::Simple; 1 }) { LWP::Simple::mirror($args{url}, $file); } elsif (eval { require Net::FTP; 1 }) { eval { # use Net::FTP to get past firewall my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600); $ftp->login("anonymous", 'anonymous@example.com'); $ftp->cwd($path); $ftp->binary; $ftp->get($file) or (warn("$!\n"), return); $ftp->quit; } } elsif (my $ftp = $self->can_run('ftp')) { eval { # no Net::FTP, fallback to ftp.exe require FileHandle; my $fh = FileHandle->new; local $SIG{CHLD} = 'IGNORE'; unless ($fh->open("|$ftp -n")) { warn "Couldn't open ftp: $!\n"; chdir $dir; return; } my @dialog = split(/\n/, <<"END_FTP"); open $host user anonymous anonymous\@example.com cd $path binary get $file $file quit END_FTP foreach (@dialog) { $fh->print("$_\n") } $fh->close; } } else { warn "No working 'ftp' program available!\n"; chdir $dir; return; } unless (-f $file) { warn "Fetching failed: $@\n"; chdir $dir; return; } return if exists $args{size} and -s $file != $args{size}; system($args{run}) if exists $args{run}; unlink($file) if $args{remove}; print(((!exists $args{check_for} or -e $args{check_for}) ? "done!" : "failed! ($!)"), "\n"); chdir $dir; return !$?; } 1; Monitoring-Plugin-0.39/inc/Module/Install/Makefile.pm0000644000175000017500000002743712512177301021231 0ustar svensven#line 1 package Module::Install::Makefile; use strict 'vars'; use ExtUtils::MakeMaker (); use Module::Install::Base (); use Fcntl qw/:flock :seek/; use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub Makefile { $_[0] } my %seen = (); sub prompt { shift; # Infinite loop protection my @c = caller(); if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) { die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])"; } # In automated testing or non-interactive session, always use defaults if ( ($ENV{AUTOMATED_TESTING} or -! -t STDIN) and ! $ENV{PERL_MM_USE_DEFAULT} ) { local $ENV{PERL_MM_USE_DEFAULT} = 1; goto &ExtUtils::MakeMaker::prompt; } else { goto &ExtUtils::MakeMaker::prompt; } } # Store a cleaned up version of the MakeMaker version, # since we need to behave differently in a variety of # ways based on the MM version. my $makemaker = eval $ExtUtils::MakeMaker::VERSION; # If we are passed a param, do a "newer than" comparison. # Otherwise, just return the MakeMaker version. sub makemaker { ( @_ < 2 or $makemaker >= eval($_[1]) ) ? $makemaker : 0 } # Ripped from ExtUtils::MakeMaker 6.56, and slightly modified # as we only need to know here whether the attribute is an array # or a hash or something else (which may or may not be appendable). my %makemaker_argtype = ( C => 'ARRAY', CONFIG => 'ARRAY', # CONFIGURE => 'CODE', # ignore DIR => 'ARRAY', DL_FUNCS => 'HASH', DL_VARS => 'ARRAY', EXCLUDE_EXT => 'ARRAY', EXE_FILES => 'ARRAY', FUNCLIST => 'ARRAY', H => 'ARRAY', IMPORTS => 'HASH', INCLUDE_EXT => 'ARRAY', LIBS => 'ARRAY', # ignore '' MAN1PODS => 'HASH', MAN3PODS => 'HASH', META_ADD => 'HASH', META_MERGE => 'HASH', PL_FILES => 'HASH', PM => 'HASH', PMLIBDIRS => 'ARRAY', PMLIBPARENTDIRS => 'ARRAY', PREREQ_PM => 'HASH', CONFIGURE_REQUIRES => 'HASH', SKIP => 'ARRAY', TYPEMAPS => 'ARRAY', XS => 'HASH', # VERSION => ['version',''], # ignore # _KEEP_AFTER_FLUSH => '', clean => 'HASH', depend => 'HASH', dist => 'HASH', dynamic_lib=> 'HASH', linkext => 'HASH', macro => 'HASH', postamble => 'HASH', realclean => 'HASH', test => 'HASH', tool_autosplit => 'HASH', # special cases where you can use makemaker_append CCFLAGS => 'APPENDABLE', DEFINE => 'APPENDABLE', INC => 'APPENDABLE', LDDLFLAGS => 'APPENDABLE', LDFROM => 'APPENDABLE', ); sub makemaker_args { my ($self, %new_args) = @_; my $args = ( $self->{makemaker_args} ||= {} ); foreach my $key (keys %new_args) { if ($makemaker_argtype{$key}) { if ($makemaker_argtype{$key} eq 'ARRAY') { $args->{$key} = [] unless defined $args->{$key}; unless (ref $args->{$key} eq 'ARRAY') { $args->{$key} = [$args->{$key}] } push @{$args->{$key}}, ref $new_args{$key} eq 'ARRAY' ? @{$new_args{$key}} : $new_args{$key}; } elsif ($makemaker_argtype{$key} eq 'HASH') { $args->{$key} = {} unless defined $args->{$key}; foreach my $skey (keys %{ $new_args{$key} }) { $args->{$key}{$skey} = $new_args{$key}{$skey}; } } elsif ($makemaker_argtype{$key} eq 'APPENDABLE') { $self->makemaker_append($key => $new_args{$key}); } } else { if (defined $args->{$key}) { warn qq{MakeMaker attribute "$key" is overriden; use "makemaker_append" to append values\n}; } $args->{$key} = $new_args{$key}; } } return $args; } # For mm args that take multiple space-seperated args, # append an argument to the current list. sub makemaker_append { my $self = shift; my $name = shift; my $args = $self->makemaker_args; $args->{$name} = defined $args->{$name} ? join( ' ', $args->{$name}, @_ ) : join( ' ', @_ ); } sub build_subdirs { my $self = shift; my $subdirs = $self->makemaker_args->{DIR} ||= []; for my $subdir (@_) { push @$subdirs, $subdir; } } sub clean_files { my $self = shift; my $clean = $self->makemaker_args->{clean} ||= {}; %$clean = ( %$clean, FILES => join ' ', grep { length $_ } ($clean->{FILES} || (), @_), ); } sub realclean_files { my $self = shift; my $realclean = $self->makemaker_args->{realclean} ||= {}; %$realclean = ( %$realclean, FILES => join ' ', grep { length $_ } ($realclean->{FILES} || (), @_), ); } sub libs { my $self = shift; my $libs = ref $_[0] ? shift : [ shift ]; $self->makemaker_args( LIBS => $libs ); } sub inc { my $self = shift; $self->makemaker_args( INC => shift ); } sub _wanted_t { } sub tests_recursive { my $self = shift; my $dir = shift || 't'; unless ( -d $dir ) { die "tests_recursive dir '$dir' does not exist"; } my %tests = map { $_ => 1 } split / /, ($self->tests || ''); require File::Find; File::Find::find( sub { /\.t$/ and -f $_ and $tests{"$File::Find::dir/*.t"} = 1 }, $dir ); $self->tests( join ' ', sort keys %tests ); } sub write { my $self = shift; die "&Makefile->write() takes no arguments\n" if @_; # Check the current Perl version my $perl_version = $self->perl_version; if ( $perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; } # Make sure we have a new enough MakeMaker require ExtUtils::MakeMaker; if ( $perl_version and $self->_cmp($perl_version, '5.006') >= 0 ) { # This previous attempted to inherit the version of # ExtUtils::MakeMaker in use by the module author, but this # was found to be untenable as some authors build releases # using future dev versions of EU:MM that nobody else has. # Instead, #toolchain suggests we use 6.59 which is the most # stable version on CPAN at time of writing and is, to quote # ribasushi, "not terminally fucked, > and tested enough". # TODO: We will now need to maintain this over time to push # the version up as new versions are released. $self->build_requires( 'ExtUtils::MakeMaker' => 6.59 ); $self->configure_requires( 'ExtUtils::MakeMaker' => 6.59 ); } else { # Allow legacy-compatibility with 5.005 by depending on the # most recent EU:MM that supported 5.005. $self->build_requires( 'ExtUtils::MakeMaker' => 6.36 ); $self->configure_requires( 'ExtUtils::MakeMaker' => 6.36 ); } # Generate the MakeMaker params my $args = $self->makemaker_args; $args->{DISTNAME} = $self->name; $args->{NAME} = $self->module_name || $self->name; $args->{NAME} =~ s/-/::/g; $args->{VERSION} = $self->version or die <<'EOT'; ERROR: Can't determine distribution version. Please specify it explicitly via 'version' in Makefile.PL, or set a valid $VERSION in a module, and provide its file path via 'version_from' (or 'all_from' if you prefer) in Makefile.PL. EOT if ( $self->tests ) { my @tests = split ' ', $self->tests; my %seen; $args->{test} = { TESTS => (join ' ', grep {!$seen{$_}++} @tests), }; } elsif ( $Module::Install::ExtraTests::use_extratests ) { # Module::Install::ExtraTests doesn't set $self->tests and does its own tests via harness. # So, just ignore our xt tests here. } elsif ( -d 'xt' and ($Module::Install::AUTHOR or $ENV{RELEASE_TESTING}) ) { $args->{test} = { TESTS => join( ' ', map { "$_/*.t" } grep { -d $_ } qw{ t xt } ), }; } if ( $] >= 5.005 ) { $args->{ABSTRACT} = $self->abstract; $args->{AUTHOR} = join ', ', @{$self->author || []}; } if ( $self->makemaker(6.10) ) { $args->{NO_META} = 1; #$args->{NO_MYMETA} = 1; } if ( $self->makemaker(6.17) and $self->sign ) { $args->{SIGN} = 1; } unless ( $self->is_admin ) { delete $args->{SIGN}; } if ( $self->makemaker(6.31) and $self->license ) { $args->{LICENSE} = $self->license; } my $prereq = ($args->{PREREQ_PM} ||= {}); %$prereq = ( %$prereq, map { @$_ } # flatten [module => version] map { @$_ } grep $_, ($self->requires) ); # Remove any reference to perl, PREREQ_PM doesn't support it delete $args->{PREREQ_PM}->{perl}; # Merge both kinds of requires into BUILD_REQUIRES my $build_prereq = ($args->{BUILD_REQUIRES} ||= {}); %$build_prereq = ( %$build_prereq, map { @$_ } # flatten [module => version] map { @$_ } grep $_, ($self->configure_requires, $self->build_requires) ); # Remove any reference to perl, BUILD_REQUIRES doesn't support it delete $args->{BUILD_REQUIRES}->{perl}; # Delete bundled dists from prereq_pm, add it to Makefile DIR my $subdirs = ($args->{DIR} || []); if ($self->bundles) { my %processed; foreach my $bundle (@{ $self->bundles }) { my ($mod_name, $dist_dir) = @$bundle; delete $prereq->{$mod_name}; $dist_dir = File::Basename::basename($dist_dir); # dir for building this module if (not exists $processed{$dist_dir}) { if (-d $dist_dir) { # List as sub-directory to be processed by make push @$subdirs, $dist_dir; } # Else do nothing: the module is already present on the system $processed{$dist_dir} = undef; } } } unless ( $self->makemaker('6.55_03') ) { %$prereq = (%$prereq,%$build_prereq); delete $args->{BUILD_REQUIRES}; } if ( my $perl_version = $self->perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; if ( $self->makemaker(6.48) ) { $args->{MIN_PERL_VERSION} = $perl_version; } } if ($self->installdirs) { warn qq{old INSTALLDIRS (probably set by makemaker_args) is overriden by installdirs\n} if $args->{INSTALLDIRS}; $args->{INSTALLDIRS} = $self->installdirs; } my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_} ) } keys %$args; my $user_preop = delete $args{dist}->{PREOP}; if ( my $preop = $self->admin->preop($user_preop) ) { foreach my $key ( keys %$preop ) { $args{dist}->{$key} = $preop->{$key}; } } my $mm = ExtUtils::MakeMaker::WriteMakefile(%args); $self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile'); } sub fix_up_makefile { my $self = shift; my $makefile_name = shift; my $top_class = ref($self->_top) || ''; my $top_version = $self->_top->VERSION || ''; my $preamble = $self->preamble ? "# Preamble by $top_class $top_version\n" . $self->preamble : ''; my $postamble = "# Postamble by $top_class $top_version\n" . ($self->postamble || ''); local *MAKEFILE; open MAKEFILE, "+< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; eval { flock MAKEFILE, LOCK_EX }; my $makefile = do { local $/; }; $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /; $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g; $makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g; $makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m; $makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m; # Module::Install will never be used to build the Core Perl # Sometimes PERL_LIB and PERL_ARCHLIB get written anyway, which breaks # PREFIX/PERL5LIB, and thus, install_share. Blank them if they exist $makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m; #$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m; # Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well. $makefile =~ s/(\"?)-I\$\(PERL_LIB\)\1//g; # XXX - This is currently unused; not sure if it breaks other MM-users # $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg; seek MAKEFILE, 0, SEEK_SET; truncate MAKEFILE, 0; print MAKEFILE "$preamble$makefile$postamble" or die $!; close MAKEFILE or die $!; 1; } sub preamble { my ($self, $text) = @_; $self->{preamble} = $text . $self->{preamble} if defined $text; $self->{preamble}; } sub postamble { my ($self, $text) = @_; $self->{postamble} ||= $self->admin->postamble; $self->{postamble} .= $text if defined $text; $self->{postamble} } 1; __END__ #line 544 Monitoring-Plugin-0.39/inc/Module/Install/Metadata.pm0000644000175000017500000004327712512177301021234 0ustar svensven#line 1 package Module::Install::Metadata; use strict 'vars'; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } my @boolean_keys = qw{ sign }; my @scalar_keys = qw{ name module_name abstract version distribution_type tests installdirs }; my @tuple_keys = qw{ configure_requires build_requires requires recommends bundles resources }; my @resource_keys = qw{ homepage bugtracker repository }; my @array_keys = qw{ keywords author }; *authors = \&author; sub Meta { shift } sub Meta_BooleanKeys { @boolean_keys } sub Meta_ScalarKeys { @scalar_keys } sub Meta_TupleKeys { @tuple_keys } sub Meta_ResourceKeys { @resource_keys } sub Meta_ArrayKeys { @array_keys } foreach my $key ( @boolean_keys ) { *$key = sub { my $self = shift; if ( defined wantarray and not @_ ) { return $self->{values}->{$key}; } $self->{values}->{$key} = ( @_ ? $_[0] : 1 ); return $self; }; } foreach my $key ( @scalar_keys ) { *$key = sub { my $self = shift; return $self->{values}->{$key} if defined wantarray and !@_; $self->{values}->{$key} = shift; return $self; }; } foreach my $key ( @array_keys ) { *$key = sub { my $self = shift; return $self->{values}->{$key} if defined wantarray and !@_; $self->{values}->{$key} ||= []; push @{$self->{values}->{$key}}, @_; return $self; }; } foreach my $key ( @resource_keys ) { *$key = sub { my $self = shift; unless ( @_ ) { return () unless $self->{values}->{resources}; return map { $_->[1] } grep { $_->[0] eq $key } @{ $self->{values}->{resources} }; } return $self->{values}->{resources}->{$key} unless @_; my $uri = shift or die( "Did not provide a value to $key()" ); $self->resources( $key => $uri ); return 1; }; } foreach my $key ( grep { $_ ne "resources" } @tuple_keys) { *$key = sub { my $self = shift; return $self->{values}->{$key} unless @_; my @added; while ( @_ ) { my $module = shift or last; my $version = shift || 0; push @added, [ $module, $version ]; } push @{ $self->{values}->{$key} }, @added; return map {@$_} @added; }; } # Resource handling my %lc_resource = map { $_ => 1 } qw{ homepage license bugtracker repository }; sub resources { my $self = shift; while ( @_ ) { my $name = shift or last; my $value = shift or next; if ( $name eq lc $name and ! $lc_resource{$name} ) { die("Unsupported reserved lowercase resource '$name'"); } $self->{values}->{resources} ||= []; push @{ $self->{values}->{resources} }, [ $name, $value ]; } $self->{values}->{resources}; } # Aliases for build_requires that will have alternative # meanings in some future version of META.yml. sub test_requires { shift->build_requires(@_) } sub install_requires { shift->build_requires(@_) } # Aliases for installdirs options sub install_as_core { $_[0]->installdirs('perl') } sub install_as_cpan { $_[0]->installdirs('site') } sub install_as_site { $_[0]->installdirs('site') } sub install_as_vendor { $_[0]->installdirs('vendor') } sub dynamic_config { my $self = shift; my $value = @_ ? shift : 1; if ( $self->{values}->{dynamic_config} ) { # Once dynamic we never change to static, for safety return 0; } $self->{values}->{dynamic_config} = $value ? 1 : 0; return 1; } # Convenience command sub static_config { shift->dynamic_config(0); } sub perl_version { my $self = shift; return $self->{values}->{perl_version} unless @_; my $version = shift or die( "Did not provide a value to perl_version()" ); # Normalize the version $version = $self->_perl_version($version); # We don't support the really old versions unless ( $version >= 5.005 ) { die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n"; } $self->{values}->{perl_version} = $version; } sub all_from { my ( $self, $file ) = @_; unless ( defined($file) ) { my $name = $self->name or die( "all_from called with no args without setting name() first" ); $file = join('/', 'lib', split(/-/, $name)) . '.pm'; $file =~ s{.*/}{} unless -e $file; unless ( -e $file ) { die("all_from cannot find $file from $name"); } } unless ( -f $file ) { die("The path '$file' does not exist, or is not a file"); } $self->{values}{all_from} = $file; # Some methods pull from POD instead of code. # If there is a matching .pod, use that instead my $pod = $file; $pod =~ s/\.pm$/.pod/i; $pod = $file unless -e $pod; # Pull the different values $self->name_from($file) unless $self->name; $self->version_from($file) unless $self->version; $self->perl_version_from($file) unless $self->perl_version; $self->author_from($pod) unless @{$self->author || []}; $self->license_from($pod) unless $self->license; $self->abstract_from($pod) unless $self->abstract; return 1; } sub provides { my $self = shift; my $provides = ( $self->{values}->{provides} ||= {} ); %$provides = (%$provides, @_) if @_; return $provides; } sub auto_provides { my $self = shift; return $self unless $self->is_admin; unless (-e 'MANIFEST') { warn "Cannot deduce auto_provides without a MANIFEST, skipping\n"; return $self; } # Avoid spurious warnings as we are not checking manifest here. local $SIG{__WARN__} = sub {1}; require ExtUtils::Manifest; local *ExtUtils::Manifest::manicheck = sub { return }; require Module::Build; my $build = Module::Build->new( dist_name => $self->name, dist_version => $self->version, license => $self->license, ); $self->provides( %{ $build->find_dist_packages || {} } ); } sub feature { my $self = shift; my $name = shift; my $features = ( $self->{values}->{features} ||= [] ); my $mods; if ( @_ == 1 and ref( $_[0] ) ) { # The user used ->feature like ->features by passing in the second # argument as a reference. Accomodate for that. $mods = $_[0]; } else { $mods = \@_; } my $count = 0; push @$features, ( $name => [ map { ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_ } @$mods ] ); return @$features; } sub features { my $self = shift; while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) { $self->feature( $name, @$mods ); } return $self->{values}->{features} ? @{ $self->{values}->{features} } : (); } sub no_index { my $self = shift; my $type = shift; push @{ $self->{values}->{no_index}->{$type} }, @_ if $type; return $self->{values}->{no_index}; } sub read { my $self = shift; $self->include_deps( 'YAML::Tiny', 0 ); require YAML::Tiny; my $data = YAML::Tiny::LoadFile('META.yml'); # Call methods explicitly in case user has already set some values. while ( my ( $key, $value ) = each %$data ) { next unless $self->can($key); if ( ref $value eq 'HASH' ) { while ( my ( $module, $version ) = each %$value ) { $self->can($key)->($self, $module => $version ); } } else { $self->can($key)->($self, $value); } } return $self; } sub write { my $self = shift; return $self unless $self->is_admin; $self->admin->write_meta; return $self; } sub version_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->version( ExtUtils::MM_Unix->parse_version($file) ); # for version integrity check $self->makemaker_args( VERSION_FROM => $file ); } sub abstract_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->abstract( bless( { DISTNAME => $self->name }, 'ExtUtils::MM_Unix' )->parse_abstract($file) ); } # Add both distribution and module name sub name_from { my ($self, $file) = @_; if ( Module::Install::_read($file) =~ m/ ^ \s* package \s* ([\w:]+) \s* ; /ixms ) { my ($name, $module_name) = ($1, $1); $name =~ s{::}{-}g; $self->name($name); unless ( $self->module_name ) { $self->module_name($module_name); } } else { die("Cannot determine name from $file\n"); } } sub _extract_perl_version { if ( $_[0] =~ m/ ^\s* (?:use|require) \s* v? ([\d_\.]+) \s* ; /ixms ) { my $perl_version = $1; $perl_version =~ s{_}{}g; return $perl_version; } else { return; } } sub perl_version_from { my $self = shift; my $perl_version=_extract_perl_version(Module::Install::_read($_[0])); if ($perl_version) { $self->perl_version($perl_version); } else { warn "Cannot determine perl version info from $_[0]\n"; return; } } sub author_from { my $self = shift; my $content = Module::Install::_read($_[0]); if ($content =~ m/ =head \d \s+ (?:authors?)\b \s* ([^\n]*) | =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s* .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s* ([^\n]*) /ixms) { my $author = $1 || $2; # XXX: ugly but should work anyway... if (eval "require Pod::Escapes; 1") { # Pod::Escapes has a mapping table. # It's in core of perl >= 5.9.3, and should be installed # as one of the Pod::Simple's prereqs, which is a prereq # of Pod::Text 3.x (see also below). $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> } { defined $2 ? chr($2) : defined $Pod::Escapes::Name2character_number{$1} ? chr($Pod::Escapes::Name2character_number{$1}) : do { warn "Unknown escape: E<$1>"; "E<$1>"; }; }gex; } elsif (eval "require Pod::Text; 1" && $Pod::Text::VERSION < 3) { # Pod::Text < 3.0 has yet another mapping table, # though the table name of 2.x and 1.x are different. # (1.x is in core of Perl < 5.6, 2.x is in core of # Perl < 5.9.3) my $mapping = ($Pod::Text::VERSION < 2) ? \%Pod::Text::HTML_Escapes : \%Pod::Text::ESCAPES; $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> } { defined $2 ? chr($2) : defined $mapping->{$1} ? $mapping->{$1} : do { warn "Unknown escape: E<$1>"; "E<$1>"; }; }gex; } else { $author =~ s{E}{<}g; $author =~ s{E}{>}g; } $self->author($author); } else { warn "Cannot determine author info from $_[0]\n"; } } #Stolen from M::B my %license_urls = ( perl => 'http://dev.perl.org/licenses/', apache => 'http://apache.org/licenses/LICENSE-2.0', apache_1_1 => 'http://apache.org/licenses/LICENSE-1.1', artistic => 'http://opensource.org/licenses/artistic-license.php', artistic_2 => 'http://opensource.org/licenses/artistic-license-2.0.php', lgpl => 'http://opensource.org/licenses/lgpl-license.php', lgpl2 => 'http://opensource.org/licenses/lgpl-2.1.php', lgpl3 => 'http://opensource.org/licenses/lgpl-3.0.html', bsd => 'http://opensource.org/licenses/bsd-license.php', gpl => 'http://opensource.org/licenses/gpl-license.php', gpl2 => 'http://opensource.org/licenses/gpl-2.0.php', gpl3 => 'http://opensource.org/licenses/gpl-3.0.html', mit => 'http://opensource.org/licenses/mit-license.php', mozilla => 'http://opensource.org/licenses/mozilla1.1.php', open_source => undef, unrestricted => undef, restrictive => undef, unknown => undef, ); sub license { my $self = shift; return $self->{values}->{license} unless @_; my $license = shift or die( 'Did not provide a value to license()' ); $license = __extract_license($license) || lc $license; $self->{values}->{license} = $license; # Automatically fill in license URLs if ( $license_urls{$license} ) { $self->resources( license => $license_urls{$license} ); } return 1; } sub _extract_license { my $pod = shift; my $matched; return __extract_license( ($matched) = $pod =~ m/ (=head \d \s+ L(?i:ICEN[CS]E|ICENSING)\b.*?) (=head \d.*|=cut.*|)\z /xms ) || __extract_license( ($matched) = $pod =~ m/ (=head \d \s+ (?:C(?i:OPYRIGHTS?)|L(?i:EGAL))\b.*?) (=head \d.*|=cut.*|)\z /xms ); } sub __extract_license { my $license_text = shift or return; my @phrases = ( '(?:under )?the same (?:terms|license) as (?:perl|the perl (?:\d )?programming language)' => 'perl', 1, '(?:under )?the terms of (?:perl|the perl programming language) itself' => 'perl', 1, 'Artistic and GPL' => 'perl', 1, 'GNU general public license' => 'gpl', 1, 'GNU public license' => 'gpl', 1, 'GNU lesser general public license' => 'lgpl', 1, 'GNU lesser public license' => 'lgpl', 1, 'GNU library general public license' => 'lgpl', 1, 'GNU library public license' => 'lgpl', 1, 'GNU Free Documentation license' => 'unrestricted', 1, 'GNU Affero General Public License' => 'open_source', 1, '(?:Free)?BSD license' => 'bsd', 1, 'Artistic license 2\.0' => 'artistic_2', 1, 'Artistic license' => 'artistic', 1, 'Apache (?:Software )?license' => 'apache', 1, 'GPL' => 'gpl', 1, 'LGPL' => 'lgpl', 1, 'BSD' => 'bsd', 1, 'Artistic' => 'artistic', 1, 'MIT' => 'mit', 1, 'Mozilla Public License' => 'mozilla', 1, 'Q Public License' => 'open_source', 1, 'OpenSSL License' => 'unrestricted', 1, 'SSLeay License' => 'unrestricted', 1, 'zlib License' => 'open_source', 1, 'proprietary' => 'proprietary', 0, ); while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) { $pattern =~ s#\s+#\\s+#gs; if ( $license_text =~ /\b$pattern\b/i ) { return $license; } } return ''; } sub license_from { my $self = shift; if (my $license=_extract_license(Module::Install::_read($_[0]))) { $self->license($license); } else { warn "Cannot determine license info from $_[0]\n"; return 'unknown'; } } sub _extract_bugtracker { my @links = $_[0] =~ m#L<( https?\Q://rt.cpan.org/\E[^>]+| https?\Q://github.com/\E[\w_]+/[\w_]+/issues| https?\Q://code.google.com/p/\E[\w_\-]+/issues/list )>#gx; my %links; @links{@links}=(); @links=keys %links; return @links; } sub bugtracker_from { my $self = shift; my $content = Module::Install::_read($_[0]); my @links = _extract_bugtracker($content); unless ( @links ) { warn "Cannot determine bugtracker info from $_[0]\n"; return 0; } if ( @links > 1 ) { warn "Found more than one bugtracker link in $_[0]\n"; return 0; } # Set the bugtracker bugtracker( $links[0] ); return 1; } sub requires_from { my $self = shift; my $content = Module::Install::_readperl($_[0]); my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+(v?[\d\.]+)/mg; while ( @requires ) { my $module = shift @requires; my $version = shift @requires; $self->requires( $module => $version ); } } sub test_requires_from { my $self = shift; my $content = Module::Install::_readperl($_[0]); my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg; while ( @requires ) { my $module = shift @requires; my $version = shift @requires; $self->test_requires( $module => $version ); } } # Convert triple-part versions (eg, 5.6.1 or 5.8.9) to # numbers (eg, 5.006001 or 5.008009). # Also, convert double-part versions (eg, 5.8) sub _perl_version { my $v = $_[-1]; $v =~ s/^([1-9])\.([1-9]\d?\d?)$/sprintf("%d.%03d",$1,$2)/e; $v =~ s/^([1-9])\.([1-9]\d?\d?)\.(0|[1-9]\d?\d?)$/sprintf("%d.%03d%03d",$1,$2,$3 || 0)/e; $v =~ s/(\.\d\d\d)000$/$1/; $v =~ s/_.+$//; if ( ref($v) ) { # Numify $v = $v + 0; } return $v; } sub add_metadata { my $self = shift; my %hash = @_; for my $key (keys %hash) { warn "add_metadata: $key is not prefixed with 'x_'.\n" . "Use appopriate function to add non-private metadata.\n" unless $key =~ /^x_/; $self->{values}->{$key} = $hash{$key}; } } ###################################################################### # MYMETA Support sub WriteMyMeta { die "WriteMyMeta has been deprecated"; } sub write_mymeta_yaml { my $self = shift; # We need YAML::Tiny to write the MYMETA.yml file unless ( eval { require YAML::Tiny; 1; } ) { return 1; } # Generate the data my $meta = $self->_write_mymeta_data or return 1; # Save as the MYMETA.yml file print "Writing MYMETA.yml\n"; YAML::Tiny::DumpFile('MYMETA.yml', $meta); } sub write_mymeta_json { my $self = shift; # We need JSON to write the MYMETA.json file unless ( eval { require JSON; 1; } ) { return 1; } # Generate the data my $meta = $self->_write_mymeta_data or return 1; # Save as the MYMETA.yml file print "Writing MYMETA.json\n"; Module::Install::_write( 'MYMETA.json', JSON->new->pretty(1)->canonical->encode($meta), ); } sub _write_mymeta_data { my $self = shift; # If there's no existing META.yml there is nothing we can do return undef unless -f 'META.yml'; # We need Parse::CPAN::Meta to load the file unless ( eval { require Parse::CPAN::Meta; 1; } ) { return undef; } # Merge the perl version into the dependencies my $val = $self->Meta->{values}; my $perl = delete $val->{perl_version}; if ( $perl ) { $val->{requires} ||= []; my $requires = $val->{requires}; # Canonize to three-dot version after Perl 5.6 if ( $perl >= 5.006 ) { $perl =~ s{^(\d+)\.(\d\d\d)(\d*)}{join('.', $1, int($2||0), int($3||0))}e } unshift @$requires, [ perl => $perl ]; } # Load the advisory META.yml file my @yaml = Parse::CPAN::Meta::LoadFile('META.yml'); my $meta = $yaml[0]; # Overwrite the non-configure dependency hashs delete $meta->{requires}; delete $meta->{build_requires}; delete $meta->{recommends}; if ( exists $val->{requires} ) { $meta->{requires} = { map { @$_ } @{ $val->{requires} } }; } if ( exists $val->{build_requires} ) { $meta->{build_requires} = { map { @$_ } @{ $val->{build_requires} } }; } return $meta; } 1; Monitoring-Plugin-0.39/inc/Module/Install/Can.pm0000644000175000017500000000615712512177301020211 0ustar svensven#line 1 package Module::Install::Can; use strict; use Config (); use ExtUtils::MakeMaker (); use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } # check if we can load some module ### Upgrade this to not have to load the module if possible sub can_use { my ($self, $mod, $ver) = @_; $mod =~ s{::|\\}{/}g; $mod .= '.pm' unless $mod =~ /\.pm$/i; my $pkg = $mod; $pkg =~ s{/}{::}g; $pkg =~ s{\.pm$}{}i; local $@; eval { require $mod; $pkg->VERSION($ver || 0); 1 }; } # Check if we can run some command sub can_run { my ($self, $cmd) = @_; my $_cmd = $cmd; return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd)); for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') { next if $dir eq ''; require File::Spec; my $abs = File::Spec->catfile($dir, $cmd); return $abs if (-x $abs or $abs = MM->maybe_command($abs)); } return; } # Can our C compiler environment build XS files sub can_xs { my $self = shift; # Ensure we have the CBuilder module $self->configure_requires( 'ExtUtils::CBuilder' => 0.27 ); # Do we have the configure_requires checker? local $@; eval "require ExtUtils::CBuilder;"; if ( $@ ) { # They don't obey configure_requires, so it is # someone old and delicate. Try to avoid hurting # them by falling back to an older simpler test. return $self->can_cc(); } # Do we have a working C compiler my $builder = ExtUtils::CBuilder->new( quiet => 1, ); unless ( $builder->have_compiler ) { # No working C compiler return 0; } # Write a C file representative of what XS becomes require File::Temp; my ( $FH, $tmpfile ) = File::Temp::tempfile( "compilexs-XXXXX", SUFFIX => '.c', ); binmode $FH; print $FH <<'END_C'; #include "EXTERN.h" #include "perl.h" #include "XSUB.h" int main(int argc, char **argv) { return 0; } int boot_sanexs() { return 1; } END_C close $FH; # Can the C compiler access the same headers XS does my @libs = (); my $object = undef; eval { local $^W = 0; $object = $builder->compile( source => $tmpfile, ); @libs = $builder->link( objects => $object, module_name => 'sanexs', ); }; my $result = $@ ? 0 : 1; # Clean up all the build files foreach ( $tmpfile, $object, @libs ) { next unless defined $_; 1 while unlink; } return $result; } # Can we locate a (the) C compiler sub can_cc { my $self = shift; my @chunks = split(/ /, $Config::Config{cc}) or return; # $Config{cc} may contain args; try to find out the program part while (@chunks) { return $self->can_run("@chunks") || (pop(@chunks), next); } return; } # Fix Cygwin bug on maybe_command(); if ( $^O eq 'cygwin' ) { require ExtUtils::MM_Cygwin; require ExtUtils::MM_Win32; if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) { *ExtUtils::MM_Cygwin::maybe_command = sub { my ($self, $file) = @_; if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) { ExtUtils::MM_Win32->maybe_command($file); } else { ExtUtils::MM_Unix->maybe_command($file); } } } } 1; __END__ #line 236 Monitoring-Plugin-0.39/inc/Module/Install/Win32.pm0000644000175000017500000000340312512177301020401 0ustar svensven#line 1 package Module::Install::Win32; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } # determine if the user needs nmake, and download it if needed sub check_nmake { my $self = shift; $self->load('can_run'); $self->load('get_file'); require Config; return unless ( $^O eq 'MSWin32' and $Config::Config{make} and $Config::Config{make} =~ /^nmake\b/i and ! $self->can_run('nmake') ); print "The required 'nmake' executable not found, fetching it...\n"; require File::Basename; my $rv = $self->get_file( url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe', ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe', local_dir => File::Basename::dirname($^X), size => 51928, run => 'Nmake15.exe /o > nul', check_for => 'Nmake.exe', remove => 1, ); die <<'END_MESSAGE' unless $rv; ------------------------------------------------------------------------------- Since you are using Microsoft Windows, you will need the 'nmake' utility before installation. It's available at: http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe or ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe Please download the file manually, save it to a directory in %PATH% (e.g. C:\WINDOWS\COMMAND\), then launch the MS-DOS command line shell, "cd" to that directory, and run "Nmake15.exe" from there; that will create the 'nmake.exe' file needed by this module. You may then resume the installation process described in README. ------------------------------------------------------------------------------- END_MESSAGE } 1; Monitoring-Plugin-0.39/inc/Module/Install/WriteAll.pm0000644000175000017500000000237612512177301021232 0ustar svensven#line 1 package Module::Install::WriteAll; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = qw{Module::Install::Base}; $ISCORE = 1; } sub WriteAll { my $self = shift; my %args = ( meta => 1, sign => 0, inline => 0, check_nmake => 1, @_, ); $self->sign(1) if $args{sign}; $self->admin->WriteAll(%args) if $self->is_admin; $self->check_nmake if $args{check_nmake}; unless ( $self->makemaker_args->{PL_FILES} ) { # XXX: This still may be a bit over-defensive... unless ($self->makemaker(6.25)) { $self->makemaker_args( PL_FILES => {} ) if -f 'Build.PL'; } } # Until ExtUtils::MakeMaker support MYMETA.yml, make sure # we clean it up properly ourself. $self->realclean_files('MYMETA.yml'); if ( $args{inline} ) { $self->Inline->write; } else { $self->Makefile->write; } # The Makefile write process adds a couple of dependencies, # so write the META.yml files after the Makefile. if ( $args{meta} ) { $self->Meta->write; } # Experimental support for MYMETA if ( $ENV{X_MYMETA} ) { if ( $ENV{X_MYMETA} eq 'JSON' ) { $self->Meta->write_mymeta_json; } else { $self->Meta->write_mymeta_yaml; } } return 1; } 1; Monitoring-Plugin-0.39/Makefile.PL0000644000175000017500000000121012267223262015506 0ustar svensvenuse inc::Module::Install; name 'Monitoring-Plugin'; all_from 'lib/Monitoring/Plugin/Functions.pm'; author 'Monitoring Plugin Team '; license 'perl'; repository 'https://github.com/monitoring-plugins/monitoring-plugin-perl'; requires 'Params::Validate' => 0; requires 'Class::Accessor' => 0; requires 'Carp' => 0; requires 'Config::Tiny' => 0; requires 'File::Spec' => 0; requires 'File::Basename' => 0; requires 'IO::File' => 0; requires 'Math::Calc::Units' => 0; # used in M::P::Performance build_requires 'Test::More' => 0.62; WriteAll; Monitoring-Plugin-0.39/README0000644000175000017500000000171412267223024014421 0ustar svensvenMonitoring::Plugin ================== These modules are meant for perl developers of plugins for Naemon, Nagios, Icinga, Shinken and other compatible products. It is meant to simplify a lot of the common functions required to do checking of a particular service. This module is maintained by the Monitoring-Plugins team (https://monitoring-plugins.org) INSTALLATION To install this module type the following: perl Makefile.PL make make test make install EXAMPLE SCRIPT "Enough talk! Show me where to start!" See the file 'check_stuff.pl' in the 't' directory for a complete working example of a plugin script. COPYRIGHT AND LICENCE Copyright (C) 2014 by Monitoring Plugin Team Copyright (C) 2006-2014 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. Monitoring-Plugin-0.39/lib/0000755000175000017500000000000012512177466014317 5ustar svensvenMonitoring-Plugin-0.39/lib/Monitoring/0000755000175000017500000000000012512177466016444 5ustar svensvenMonitoring-Plugin-0.39/lib/Monitoring/Plugin/0000755000175000017500000000000012512177466017702 5ustar svensvenMonitoring-Plugin-0.39/lib/Monitoring/Plugin/Threshold.pm0000644000175000017500000000630012267223661022167 0ustar svensvenpackage Monitoring::Plugin::Threshold; use 5.006; use strict; use warnings; use base qw(Class::Accessor::Fast); __PACKAGE__->mk_accessors(qw(warning critical)); use Monitoring::Plugin::Range; use Monitoring::Plugin::Functions qw(:codes plugin_die); our ($VERSION) = $Monitoring::Plugin::Functions::VERSION; sub get_status { my ($self, $value) = @_; $value = [ $value ] if (ref $value eq ""); foreach my $v (@$value) { if ($self->critical->is_set) { return CRITICAL if $self->critical->check_range($v); } } foreach my $v (@$value) { if ($self->warning->is_set) { return WARNING if $self->warning->check_range($v); } } return OK; } sub _inflate { my ($self, $value, $key) = @_; # Return an undefined range if $value is undef return Monitoring::Plugin::Range->new if ! defined $value; # For refs, check isa N::P::Range if (ref $value) { plugin_die("Invalid $key object: type " . ref $value) unless $value->isa("Monitoring::Plugin::Range"); return $value; } # Another quick exit if $value is an empty string return Monitoring::Plugin::Range->new if $value eq ""; # Otherwise parse $value my $range = Monitoring::Plugin::Range->parse_range_string($value); plugin_die("Cannot parse $key range: '$value'") unless(defined($range)); return $range; } sub set_thresholds { my ($self, %arg) = @_; # Equals new() as a class method return $self->new(%arg) unless ref $self; # On an object, just acts as special mutator $self->set($_, $arg{$_}) foreach qw(warning critical); } sub set { my $self = shift; my ($key, $value) = @_; $self->SUPER::set($key, $self->_inflate($value, $key)); } # Constructor - inflate scalars to N::P::Range objects sub new { my ($self, %arg) = @_; $self->SUPER::new({ map { $_ => $self->_inflate($arg{$_}, $_) } qw(warning critical) }); } 1; __END__ =head1 NAME Monitoring::Plugin::Threshold - class for handling Monitoring::Plugin thresholds. =head1 SYNOPSIS # NB: This is an internal Monitoring::Plugin class. # See Monitoring::Plugin itself for public interfaces. # Constructor $t = Monitoring::Plugin::Threshold->set_thresholds( warning => $warning_range_string, critical => $critical_range_string, ); # Value checking - returns CRITICAL if in the critical range, # WARNING if in the warning range, and OK otherwise $status = $t->get_status($value); # Accessors - return the associated N::P::Range object $warning_range = $t->warning; $critical_range = $t->critical; =head1 DESCRIPTION Internal Monitoring::Plugin class for handling threshold data. See Monitoring::Plugin for public interfaces. A threshold object contains (typically) a pair of ranges, associated with a particular severity e.g. warning => range1 critical => range2 =head1 AUTHOR This code is maintained by the Monitoring Plugin Development Team: see https://monitoring-plugins.org =head1 COPYRIGHT AND LICENSE Copyright (C) 2014 by Monitoring Plugin Team Copyright (C) 2006-2014 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 Monitoring-Plugin-0.39/lib/Monitoring/Plugin/Performance.pm0000644000175000017500000002004612267223675022504 0ustar svensvenpackage Monitoring::Plugin::Performance; use 5.006; use strict; use warnings; use Carp; use base qw(Class::Accessor::Fast); __PACKAGE__->mk_ro_accessors( qw(label value uom warning critical min max) ); use Monitoring::Plugin::Functions; use Monitoring::Plugin::Threshold; use Monitoring::Plugin::Range; our ($VERSION) = $Monitoring::Plugin::Functions::VERSION; sub import { my ($class, %attr) = @_; $_ = $attr{use_die} || 0; Monitoring::Plugin::Functions::_use_die($_); } # This is NOT the same as N::P::Functions::value_re. We leave that to be the strict # version. This one allows commas to be part of the numeric value. my $value = qr/[-+]?[\d\.,]+/; my $value_re = qr/$value(?:e$value)?/; my $value_with_negative_infinity = qr/$value_re|~/; sub _parse { my $class = shift; my $string = shift; $string =~ /^'?([^'=]+)'?=($value_re)([\w%]*);?($value_with_negative_infinity\:?$value_re?)?;?($value_with_negative_infinity\:?$value_re?)?;?($value_re)?;?($value_re)?/o; return undef unless ((defined $1 && $1 ne "") && (defined $2 && $2 ne "")); my @info = ($1, $2, $3, $4, $5, $6, $7); # We convert any commas to periods, in the value fields map { defined $info[$_] && $info[$_] =~ s/,/./go } (1, 3, 4, 5, 6); # Check that $info[1] is an actual value # We do this by returning undef if a warning appears my $performance_value; { my $not_value; local $SIG{__WARN__} = sub { $not_value++ }; $performance_value = $info[1]+0; return undef if $not_value; } my $p = $class->new( label => $info[0], value => $performance_value, uom => $info[2], warning => $info[3], critical => $info[4], min => $info[5], max => $info[6] ); return $p; } # Map undef to '' sub _nvl { my ($self, $value) = @_; defined $value ? $value : '' } sub perfoutput { my $self = shift; # Add quotes if label contains a space character my $label = $self->label; if ($label =~ / /) { $label = "'$label'"; } my $out = sprintf "%s=%s%s;%s;%s;%s;%s", $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 = (); my $obj; while ($perfstring) { $perfstring =~ s/^\s*//; # If there is more than 1 equals sign, split it out and parse individually if (@{[$perfstring =~ /=/g]} > 1) { $perfstring =~ s/^(.*?=.*?)\s//; if (defined $1) { $obj = $class->_parse($1); } else { # This could occur if perfdata was soemthing=value= # Since this is invalid, we reset the string and continue $perfstring = ""; $obj = $class->_parse($perfstring); } } else { $obj = $class->_parse($perfstring); $perfstring = ""; } push @perfs, $obj if $obj; } return @perfs; } 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"; } elsif ( $name =~ s/^\/// ) { $name =~ s/\//_/g; } # Convert all other characters $name =~ s/\W/_/g; return $name; } # Backward compatibility: create a threshold object on the fly as requested sub threshold { my $self = shift; return Monitoring::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 Monitoring::Plugin::Performance - class for handling Monitoring::Plugin performance data. =head1 SYNOPSIS use Monitoring::Plugin::Performance use_die => 1; # Constructor (also accepts a 'threshold' obj instead of warning/critical) $p = Monitoring::Plugin::Performance->new( label => 'size', value => $value, uom => "kB", warning => $warning, critical => $critical, min => $min, max => $max, ); # Parser @perf = Monitoring::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 Monitoring::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). Monitoring::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 USE'ING THE MODULE If you are using this module for the purposes of parsing perf data, you will probably want to set use_die => 1 at use time. This forces &Monitoring::Plugin::Functions::plugin_exit to call die() - rather than exit() - when an error occurs. This is then trappable by an eval. If you don't set use_die, then an error in these modules will cause your script to exit =head1 CLASS METHODS =over 4 =item Monitoring::Plugin::Performance->new(%attributes) Instantiates a new Monitoring::Plugin::Performance object with the given attributes. =item Monitoring::Plugin::Performance->parse_perfstring($string) Returns an array of Monitoring::Plugin::Performance objects based on the string entered. If there is an error parsing the string - which may consists of several sets of data - will return an array with all the successfully parsed sets. If values are input with commas instead of periods, due to different locale settings, then it will still be parsed, but the commas will be converted to periods. =back =head1 OBJECT METHODS (ACCESSORS) =over 4 =item label, value, uom, warning, critical, min, max These all return scalars. min and max are not well supported yet. =item threshold Returns a Monitoring::Plugin::Threshold object holding the warning and critical ranges for this performance data (if any). =item rrdlabel 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 Monitoring::Plugin perfdata format i.e. label=value[uom];[warn];[crit];[min];[max]. =back =head1 SEE ALSO Monitoring::Plugin, Monitoring::Plugin::Threshold, https://www.monitoring-plugins.org/doc/guidelines.html =head1 AUTHOR This code is maintained by the Monitoring Plugin Development Team: see https://monitoring-plugins.org =head1 COPYRIGHT AND LICENSE Copyright (C) 2014 by Monitoring Plugin Team Copyright (C) 2006-2014 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 Monitoring-Plugin-0.39/lib/Monitoring/Plugin/Getopt.pm0000644000175000017500000005516712512175300021501 0ustar svensvenpackage Monitoring::Plugin::Getopt; # # Monitoring::Plugin::Getopt - OO perl module providing standardised argument # processing for nagios plugins # use 5.006; use strict; use warnings; use File::Basename; use Getopt::Long qw(:config no_ignore_case bundling); use Carp; use Params::Validate qw(:all); use base qw(Class::Accessor); use Monitoring::Plugin::Functions; use Monitoring::Plugin::Config; use vars qw($VERSION); $VERSION = $Monitoring::Plugin::Functions::VERSION; # Standard defaults my %DEFAULT = ( timeout => 15, verbose => 0, license => "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).", ); # Standard arguments my @ARGS = ({ spec => 'usage|?', help => "-?, --usage\n Print usage information", }, { spec => 'help|h', help => "-h, --help\n Print detailed help screen", }, { spec => 'version|V', help => "-V, --version\n Print version information", }, { spec => 'extra-opts:s@', 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.", }, { spec => 'timeout|t=i', help => "-t, --timeout=INTEGER\n Seconds before plugin times out (default: %s)", default => $DEFAULT{timeout}, }, { spec => 'verbose|v+', help => "-v, --verbose\n Show details for command-line debugging (can repeat up to 3 times)", default => $DEFAULT{verbose}, }, ); # Standard arguments we traditionally display last in the help output my %DEFER_ARGS = map { $_ => 1 } qw(timeout verbose); # ------------------------------------------------------------------------- # Private methods sub _die { my $self = shift; my ($msg) = @_; $msg .= "\n" unless substr($msg, -1) eq "\n"; Monitoring::Plugin::Functions::_plugin_exit(3, $msg); } # Return the given attribute, if set, including a final newline sub _attr { my $self = shift; my ($item, $extra) = @_; $extra = '' unless defined $extra; return '' unless $self->{_attr}->{$item}; $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 $optional = ($spec =~ m/:/); my (@short, @long); for (split /\|/, $opts) { if (length $_ == 1) { push @short, "-$_"; } else { push @long, "--$_"; } } my $help = join(', ', @short, @long); if ($type) { if (!$label) { if ($type eq 'i' || $type eq '+' || $type =~ /\d+/) { $label = 'INTEGER'; } else { $label = 'STRING'; } } if ($optional) { $help .= '[=' . $label . ']'; } else { $help .= '=' . $label; } } elsif ($label) { carp "Label specified, but there's no type in spec '$spec'"; } $help .= "\n "; return $help; } # Options output for plugin -h sub _options { my $self = shift; my @args = (); my @defer = (); for (@{$self->{_args}}) { if (exists $DEFER_ARGS{$_->{name}}) { push @defer, $_; } else { push @args, $_; } } my @options = (); for my $arg (@args, @defer) { 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 my $replaced = $help_string; $replaced =~ s|%s|$default|gmx; push @options, $replaced; } else { push @options, $help_string; } } return ' ' . join("\n ", @options); } # Output for plugin -? (or missing/invalid args) sub _usage { my $self = shift; my $usage = $self->_attr('usage'); $usage =~ s|%s|$self->{_attr}->{plugin}|gmx; return($usage); } # Output for plugin -V sub _revision { my $self = shift; my $revision = sprintf "%s %s", $self->{_attr}->{plugin}, $self->{_attr}->{version}; $revision .= sprintf " [%s]", $self->{_attr}->{url} if $self->{_attr}->{url}; $revision .= "\n"; $revision; } # Output for plugin -h sub _help { my $self = shift; my $help = ''; $help .= $self->_revision . "\n"; $help .= $self->_attr('license', "\n"); $help .= $self->_attr('blurb', "\n"); $help .= $self->_usage ? $self->_usage . "\n" : ''; $help .= $self->_options ? $self->_options . "\n" : ''; $help .= $self->_attr('extra', "\n"); return $help; } # Return a Getopt::Long-compatible option array from the current set of specs sub _process_specs_getopt_long { my $self = shift; my @opts = (); for my $arg (@{$self->{_args}}) { push @opts, $arg->{spec}; # Setup names and defaults my $spec = $arg->{spec}; # Use first arg as name (like Getopt::Long does) $spec =~ s/[=:].*$//; my $name = (split /\s*\|\s*/, $spec)[0]; $arg->{name} = $name; if (defined $self->{$name}) { $arg->{default} = $self->{$name}; } else { $self->{$name} = $arg->{default}; } } return @opts; } # Check for existence of required arguments sub _check_required_opts { my $self = shift; my @missing = (); for my $arg (@{$self->{_args}}) { if ($arg->{required} && ! defined $self->{$arg->{name}}) { push @missing, $arg->{name}; } } if (@missing) { $self->_die($self->_usage . "\n" . join("\n", map { sprintf "Missing argument: %s", $_ } @missing) . "\n"); } } # Process and handle any immediate options sub _process_opts { my $self = shift; # Print message and exit for usage, version, help $self->_die($self->_usage) if $self->{usage}; $self->_die($self->_revision) if $self->{version}; $self->_die($self->_help) if $self->{help}; } # ------------------------------------------------------------------------- # Default opts methods sub _load_config_section { my $self = shift; my ($section, $file, $flags) = @_; $section ||= $self->{_attr}->{plugin}; my $Config; eval { $Config = Monitoring::Plugin::Config->read($file); }; $self->_die($@) if ($@); #TODO: add test? # TODO: is this check sane? Does --extra-opts=foo require a [foo] section? ## Nevertheless, if we die as UNKNOWN here we should do the same on default ## file *added eval/_die above*. $file ||= $Config->mp_getfile(); $self->_die("Invalid section '$section' in config file '$file'") unless exists $Config->{$section}; return $Config->{$section}; } # Helper method to setup a hash of spec definitions for _cmdline sub _setup_spec_index { my $self = shift; return if defined $self->{_spec}; $self->{_spec} = { map { $_->{name} => $_->{spec} } @{$self->{_args}} }; } # Quote values that require it sub _cmdline_value { my $self = shift; local $_ = shift; if (m/\s/ && (m/^[^"']/ || m/[^"']$/)) { return qq("$_"); } elsif ($_ eq '') { return q(""); } else { return $_; } } # Helper method to format key/values in $hash in a quasi-commandline format sub _cmdline { my $self = shift; my ($hash) = @_; $hash ||= $self; $self->_setup_spec_index; my @args = (); for my $key (sort keys %$hash) { # Skip internal keys next if $key =~ m/^_/; # Skip defaults and internals next if exists $DEFAULT{$key} && $hash->{$key} eq $DEFAULT{$key}; next if grep { $key eq $_ } qw(help usage version extra-opts); next unless defined $hash->{$key}; # Render arg my $spec = $self->{_spec}->{$key} || ''; if ($spec =~ m/[=:].+$/) { # Arg takes value - may be a scalar or an arrayref for my $value (ref $hash->{$key} eq 'ARRAY' ? @{$hash->{$key}} : ( $hash->{$key} )) { $value = $self->_cmdline_value($value); if (length($key) > 1) { push @args, sprintf "--%s=%s", $key, $value; } else { push @args, "-$key", $value; } } } else { # Flag - render long or short based on option length push @args, (length($key) > 1 ? '--' : '-') . $key; } } return wantarray ? @args : join(' ', @args); } # Process and load extra-opts sections sub _process_extra_opts { my $self = shift; my ($args) = @_; my $extopts_list = $args->{'extra-opts'}; my @sargs = (); for my $extopts (@$extopts_list) { $extopts ||= $self->{_attr}->{plugin}; my $section = $extopts; my $file = ''; # Parse section@file if ($extopts =~ m/^([^@]*)@(.*?)\s*$/) { $section = $1; $file = $2; } # Load section args 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 extra-opts + original @ARGV = ( @sargs, @{$self->{_attr}->{argv}} ); printf "[extra-opts] %s %s\n", $self->{_attr}->{plugin}, join(' ', @ARGV) if $args->{verbose} && $args->{verbose} >= 3; } # ------------------------------------------------------------------------- # Public methods # Define plugin argument sub arg { my $self = shift; my %args; # Named args if ($_[0] =~ m/^(spec|help|required|default)$/ && scalar(@_) % 2 == 0) { %args = validate( @_, { spec => 1, help => 1, default => 0, required => 0, label => 0, }); } # Positional args else { 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], ); } # Add to private args arrayref push @{$self->{_args}}, \%args; } # Process the @ARGV array using the current _args list (possibly exiting) sub getopts { my $self = shift; # Collate spec arguments for Getopt::Long my @opt_array = $self->_process_specs_getopt_long; # Capture original @ARGV (for extra-opts games) $self->{_attr}->{argv} = [ @ARGV ]; # Call GetOptions using @opt_array my $args1 = {}; my $ok = GetOptions($args1, @opt_array); # Invalid options - give usage message and exit $self->_die($self->_usage) unless $ok; # Process extra-opts $self->_process_extra_opts($args1); # 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; # Process immediate options (possibly exiting) $self->_process_opts; # Required options (possibly exiting) $self->_check_required_opts; # Setup accessors for options $self->mk_ro_accessors(grep ! /^_/, keys %$self); # Setup default alarm handler for alarm($ng->timeout) in plugin $SIG{ALRM} = sub { my $plugin = uc $self->{_attr}->{plugin}; $plugin =~ s/^check_//; $self->_die( sprintf("%s UNKNOWN - plugin timed out (timeout %ss)", $plugin, $self->timeout)); }; } # ------------------------------------------------------------------------- # Constructor sub _init { my $self = shift; # Check params my $plugin = basename($ENV{PLUGIN_NAME} || $ENV{NAGIOS_PLUGIN} || $0); my %attr = validate( @_, { usage => 1, version => 0, url => 0, plugin => { default => $plugin }, blurb => 0, extra => 0, 'extra-opts' => 0, license => { default => $DEFAULT{license} }, timeout => { default => $DEFAULT{timeout} }, }); # Add attr to private _attr hash (except timeout) $self->{timeout} = delete $attr{timeout}; $self->{_attr} = { %attr }; # Chomp _attr values chomp foreach values %{$self->{_attr}}; # Setup initial args list $self->{_args} = [ @ARGS ]; $self } sub new { my $class = shift; my $self = bless {}, $class; $self->_init(@_); } # ------------------------------------------------------------------------- 1; __END__ =head1 NAME Monitoring::Plugin::Getopt - OO perl module providing standardised argument processing for Nagios plugins =head1 SYNOPSIS use Monitoring::Plugin::Getopt; # Instantiate object (usage is mandatory) $ng = Monitoring::Plugin::Getopt->new( usage => "Usage: %s -H -w -c ", 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=i', help => q(Exit with CRITICAL status if fewer than INTEGER foobars are free), required => 1, default => 10, ); # Add argument - positional parameters - arg spec, help text, # default value, required? (first two mandatory) $ng->arg( 'warning|w=i', q(Exit with WARNING status if fewer than INTEGER foobars are free), 5, 1); # Parse arguments and process standard ones (e.g. usage, help, version) $ng->getopts; # Access arguments using named accessors or or via the generic get() print $ng->opts->warning; print $ng->opts->get('critical'); =head1 DESCRIPTION Monitoring::Plugin::Getopt is an OO perl module providing standardised and simplified argument processing for Nagios plugins. It implements a number of standard arguments itself (--help, --version, --usage, --timeout, --verbose, and their short form counterparts), produces standardised nagios plugin help output, and allows additional arguments to be easily defined. =head2 CONSTRUCTOR # Instantiate object (usage is mandatory) $ng = Monitoring::Plugin::Getopt->new( usage => 'Usage: %s --hello', version => '0.01', ); The Monitoring::Plugin::Getopt constructor accepts the following named arguments: =over 4 =item usage (required) Short usage message used with --usage/-? and with missing required arguments, and included in the longer --help output. Can include a '%s' sprintf placeholder which will be replaced with the plugin name e.g. usage => qq(Usage: %s -H -p [-v]), might be displayed as: $ ./check_tcp_range --usage Usage: check_tcp_range -H -p [-v] =item version (required) Plugin version number, included in the --version/-V output, and in the longer --help output. e.g. $ ./check_tcp_range --version check_tcp_range 0.2 [http://www.openfusion.com.au/labs/nagios/] =item url URL for info about this plugin, included in the --version/-V output, and in the longer --help output (see preceding 'version' example). =item blurb Short plugin description, included in the longer --help output (see below for an example). =item license 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). Provide your own to replace this text in the help output. =item extra Extra text to be appended at the end of the longer --help output. =item plugin Plugin name. This defaults to the basename of your plugin, which is usually correct, but you can set it explicitly if not. =item timeout Timeout period in seconds, overriding the standard timeout default (15 seconds). =back The full --help output has the following form: version string license string blurb usage string options list extra text The 'blurb' and 'extra text' sections are omitted if not supplied. For example: $ ./check_tcp_range -h check_tcp_range 0.2 [http://www.openfusion.com.au/labs/nagios/] 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 plugin tests arbitrary ranges/sets of tcp ports for a host. Usage: check_tcp_range -H -p [-v] Options: -h, --help Print detailed help screen -V, --version Print version information -H, --hostname=ADDRESS Host name or IP address -p, --ports=STRING 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 Show details for command-line debugging (can repeat up to 3 times) =head2 ARGUMENTS You can define arguments for your plugin using the arg() method, which supports both named and positional arguments. In both cases the C and C arguments are required, while the C