r30949 - in /branches/upstream/libnagios-object-perl/current: ./ lib/Nagios/ lib/Nagios/Object/ t/
ryan52-guest at users.alioth.debian.org
ryan52-guest at users.alioth.debian.org
Sat Feb 21 07:04:58 UTC 2009
Author: ryan52-guest
Date: Sat Feb 21 07:04:54 2009
New Revision: 30949
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=30949
Log:
[svn-upgrade] Integrating new upstream version, libnagios-object-perl (0.21.3)
Modified:
branches/upstream/libnagios-object-perl/current/Build.PL
branches/upstream/libnagios-object-perl/current/ChangeLog
branches/upstream/libnagios-object-perl/current/META.yml
branches/upstream/libnagios-object-perl/current/README
branches/upstream/libnagios-object-perl/current/lib/Nagios/Config.pm
branches/upstream/libnagios-object-perl/current/lib/Nagios/Object.pm
branches/upstream/libnagios-object-perl/current/lib/Nagios/Object/Config.pm
branches/upstream/libnagios-object-perl/current/lib/Nagios/StatusLog.pm
branches/upstream/libnagios-object-perl/current/t/00object.t
branches/upstream/libnagios-object-perl/current/t/50config.t
branches/upstream/libnagios-object-perl/current/t/54dump.t
branches/upstream/libnagios-object-perl/current/t/98nagios-sample-config.t
branches/upstream/libnagios-object-perl/current/t/nagios2config.t
Modified: branches/upstream/libnagios-object-perl/current/Build.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnagios-object-perl/current/Build.PL?rev=30949&op=diff
==============================================================================
--- branches/upstream/libnagios-object-perl/current/Build.PL (original)
+++ branches/upstream/libnagios-object-perl/current/Build.PL Sat Feb 21 07:04:54 2009
@@ -4,7 +4,7 @@
my $build = Module::Build->new(
dist_name => 'Nagios-Object',
- dist_version => "0.21.1",
+ dist_version => "0.21.3",
dist_author => 'Duncan Ferguson <duncs at cpan.org>',
dist_abstract => 'Nagios::Object - Nagios object configuration parsing.',
license => 'gpl',
Modified: branches/upstream/libnagios-object-perl/current/ChangeLog
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnagios-object-perl/current/ChangeLog?rev=30949&op=diff
==============================================================================
--- branches/upstream/libnagios-object-perl/current/ChangeLog (original)
+++ branches/upstream/libnagios-object-perl/current/ChangeLog Sat Feb 21 07:04:54 2009
@@ -86,3 +86,9 @@
inheritance - the default is to preserve inheritance, calling $obj->dump(1) will flatten
* light test cleaning
+0.21.1 - slight amendment of version numbers to allow uploading to CPAN
+0.21.2 - Fix version numbers missed from 0.21.1 and reinitialise them where
+ possible
+0.21.3 - Apply 'whatis' patch from Ryan52
+ - Cope with Nagios 3 status.dat file better
+ - Apply Nagios 3 stanza patch from Shadih Rahman
Modified: branches/upstream/libnagios-object-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnagios-object-perl/current/META.yml?rev=30949&op=diff
==============================================================================
--- branches/upstream/libnagios-object-perl/current/META.yml (original)
+++ branches/upstream/libnagios-object-perl/current/META.yml Sat Feb 21 07:04:54 2009
@@ -1,6 +1,6 @@
---
name: Nagios-Object
-version: 0.21.1
+version: 0.21.3
author:
- 'Duncan Ferguson <duncs at cpan.org>'
abstract: Nagios::Object - Nagios object configuration parsing.
@@ -29,33 +29,33 @@
version: 0
Nagios::Host::Status:
file: lib/Nagios/StatusLog.pm
- version: 000000
+ version: 0.1
Nagios::HostGroup:
file: lib/Nagios/Object.pm
version: 0
Nagios::Info::Status:
file: lib/Nagios/StatusLog.pm
- version: 000000
+ version: 0.1
Nagios::Object:
file: lib/Nagios/Object.pm
- version: 35
+ version: 36
Nagios::Object::Config:
file: lib/Nagios/Object/Config.pm
version: 35
Nagios::Program::Status:
file: lib/Nagios/StatusLog.pm
- version: 000000
+ version: 0.1
Nagios::Service:
file: lib/Nagios/Object.pm
version: 0
Nagios::Service::Status:
file: lib/Nagios/StatusLog.pm
- version: 000000
+ version: 0.1
Nagios::ServiceGroup:
file: lib/Nagios/Object.pm
version: 0
Nagios::StatusLog:
file: lib/Nagios/StatusLog.pm
- version: 35
+ version: 37
resources:
license: http://www.opensource.org/licenses/gpl-license.php
Modified: branches/upstream/libnagios-object-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnagios-object-perl/current/README?rev=30949&op=diff
==============================================================================
--- branches/upstream/libnagios-object-perl/current/README (original)
+++ branches/upstream/libnagios-object-perl/current/README Sat Feb 21 07:04:54 2009
@@ -32,7 +32,12 @@
Notes:
-Module maintenance was taken over by <duncs at cpan.org> in January 2009
+Module maintenance was taken over by <duncs at cpan.org> in January 2009. The
+source has been placed into a git repository at:
+ git://github.com/duncs/perl-nagios-object.git
+
+See also:
+ http://github.com/duncs/perl-nagios-object/
<duncs at cpan.org>
Modified: branches/upstream/libnagios-object-perl/current/lib/Nagios/Config.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnagios-object-perl/current/lib/Nagios/Config.pm?rev=30949&op=diff
==============================================================================
--- branches/upstream/libnagios-object-perl/current/lib/Nagios/Config.pm (original)
+++ branches/upstream/libnagios-object-perl/current/lib/Nagios/Config.pm Sat Feb 21 07:04:54 2009
@@ -35,7 +35,7 @@
=head1 NAME
-Nagios::Config
+Nagios::Config - Parser for the Nagios::Object set of perl modules
=head1 DESCRIPTION
Modified: branches/upstream/libnagios-object-perl/current/lib/Nagios/Object.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnagios-object-perl/current/lib/Nagios/Object.pm?rev=30949&op=diff
==============================================================================
--- branches/upstream/libnagios-object-perl/current/lib/Nagios/Object.pm (original)
+++ branches/upstream/libnagios-object-perl/current/lib/Nagios/Object.pm Sat Feb 21 07:04:54 2009
@@ -28,7 +28,7 @@
# NOTE: due to CPAN version checks this cannot currently be changed to a
# standard version string, i.e. '0.21'
-our $VERSION = '35';
+our $VERSION = '36';
our $pre_link = undef;
our $fast_mode = undef;
our %nagios_setup;
@@ -68,7 +68,7 @@
service_description => ['STRING', 10 ],
host_name => [['Nagios::Host'], 10 ],
servicegroups => [['Nagios::ServiceGroup'], 280],
- hostgroup => [['Nagios::HostGroup'], 280],
+ hostgroup_name => [['Nagios::HostGroup'], 256],
is_volatile => ['BINARY', 280],
check_command => ['Nagios::Command', 280],
max_check_attempts => ['INTEGER', 280],
@@ -116,7 +116,7 @@
alias => ['STRING', 280],
address => ['STRING', 280],
parents => [['Nagios::Host'], 280],
- hostgroup => [['Nagios::HostGroup'], 280],
+ hostgroups => [['Nagios::HostGroup'], 280],
check_command => ['STRING', 280],
max_check_attempts => ['INTEGER', 280],
checks_enabled => ['BINARY', 280],
@@ -323,7 +323,7 @@
=head1 NAME
-Nagios::Object
+Nagios::Object - Creates perl objects to represent Nagios objects
=head1 DESCRIPTION
Modified: branches/upstream/libnagios-object-perl/current/lib/Nagios/Object/Config.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnagios-object-perl/current/lib/Nagios/Object/Config.pm?rev=30949&op=diff
==============================================================================
--- branches/upstream/libnagios-object-perl/current/lib/Nagios/Object/Config.pm (original)
+++ branches/upstream/libnagios-object-perl/current/lib/Nagios/Object/Config.pm Sat Feb 21 07:04:54 2009
@@ -33,7 +33,7 @@
=head1 NAME
-Nagios::Object::Config
+Nagios::Object::Config - Perl objects to represent Nagios configuration
=head1 DESCRIPTION
Modified: branches/upstream/libnagios-object-perl/current/lib/Nagios/StatusLog.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnagios-object-perl/current/lib/Nagios/StatusLog.pm?rev=30949&op=diff
==============================================================================
--- branches/upstream/libnagios-object-perl/current/lib/Nagios/StatusLog.pm (original)
+++ branches/upstream/libnagios-object-perl/current/lib/Nagios/StatusLog.pm Sat Feb 21 07:04:54 2009
@@ -25,7 +25,7 @@
# NOTE: due to CPAN version checks this cannot currently be changed to a
# standard version string, i.e. '0.21'
-our $VERSION = '35';
+our $VERSION = '37';
# this is going to be rewritten to use AUTOLOAD + method caching in a future version
BEGIN {
@@ -72,7 +72,7 @@
=head1 NAME
-Nagios::StatusLog, Nagios::(Service|Host|Program)::Status
+Nagios::StatusLog, Nagios::(Service|Host|Program)::Status - Perl objects to represent the Nagios status file
=head1 DESCRIPTION
@@ -119,7 +119,7 @@
$logfile = $value;
}
elsif ( lc $param eq 'version' ) {
- $version = $value;
+ $version = int($value);
}
}
}
@@ -150,7 +150,10 @@
sub update {
my $self = shift;
- if ( $self->{VERSION} >= 2 ) {
+ if ( $self->{VERSION} >= 3 ) {
+ return $self->update_v3( @_ );
+ }
+ if ( $self->{VERSION} == 2 ) {
return $self->update_v2( @_ );
}
return $self->update_v1( @_ );
@@ -228,18 +231,18 @@
1;
}
+# be compatible with StatusLog which makes sure that references
+# held in client code remain valid during update (also prevents
+# some memory leaks)
+sub _copy {
+ my( $from, $to ) = @_;
+ foreach my $key ( keys %$from ) {
+ $to->{$key} = $from->{$key};
+ }
+}
+
sub update_v2 ($) {
my $self = shift;
-
- # be compatible with StatusLog which makes sure that references
- # held in client code remain valid during update (also prevents
- # some memory leaks)
- sub _copy {
- my( $from, $to ) = @_;
- foreach my $key ( keys %$from ) {
- $to->{$key} = $from->{$key};
- }
- }
my %handlers = (
host => sub {
@@ -264,6 +267,80 @@
_copy( shift, $self->{INFO} );
},
program => sub {
+ _copy( shift, $self->{PROGRAM} );
+ }
+
+ );
+
+ my $log_fh = gensym;
+ open( $log_fh, "<$self->{LOGFILE}" )
+ || croak "could not open file $self->{LOGFILE} for reading: $!";
+
+ # change the first line of the RE to this:
+ # (info|program|host|service) \s* {(
+ # to make it a bit more careful, but it has a measurable cost on runtime
+ my $entry_re = qr/
+ # capture the type into $1
+ (\w+) \s*
+ # capture all of the text between the brackets into $2
+ {( .*? )}
+ # match the last bracket only if followed by another definition
+ (?=(?: \s* (?:info|program|host|service) \s* { | \Z) )
+ # capture remaining text (1-2 lines) into $3 for re-processing
+ (.*)$
+ /xs;
+
+ my $entry = '';
+ while ( my $line = <$log_fh> ) {
+ next if ( $line =~ /^\s*#/ );
+ $entry .= $line;
+ if ( $entry =~ m/$entry_re/ ) {
+ ( my $type, my $text, $entry ) = ( $1, $2, $3 );
+ $text =~ s/[\r\n]+\s*/\n/g; # clean up whitespace and newlines
+ my %item = map { split /\s*=\s*/, $_, 2 } split /\n/, $text;
+ $handlers{$type}->( \%item );
+ }
+ }
+
+ close( $log_fh );
+
+ 1;
+}
+
+sub update_v3 ($) {
+ my $self = shift;
+
+ my %handlers = (
+ hoststatus => sub {
+ my $item = shift;
+ my $host = $item->{host_name};
+ if ( !exists $self->{HOST}{$host} ) {
+ $self->{HOST}{$host} = {};
+ }
+ _copy( $item, $self->{HOST}{$host} );
+ },
+ servicestatus => sub {
+ my $item = shift;
+ my $host = $item->{host_name};
+ my $svc = $item->{service_description};
+
+ if ( !exists $self->{SERVICE}{$host}{$svc} ) {
+ $self->{SERVICE}{$host}{$svc} = {};
+ }
+ _copy( $item, $self->{SERVICE}{$host}{$svc} );
+ },
+ contactstatus => sub {
+ my $item = shift;
+ my $contact = $item->{contact_name};
+ if ( !exists $self->{CONTACT}{$contact} ) {
+ $self->{CONTACT}{$contact} = {};
+ }
+ _copy( $item, $self->{CONTACT}{$contact} );
+ },
+ info => sub {
+ _copy( shift, $self->{INFO} );
+ },
+ programstatus => sub {
_copy( shift, $self->{PROGRAM} );
}
@@ -561,7 +638,7 @@
package Nagios::Service::Status;
-our $VERSION = sprintf('%06d', '$Rev$' =~ /(\d+)/o);
+our $VERSION = '0.1';
# Nagios 2.x has current_state instead of status, but since anybody
# using this module is probably using status and does not want to
@@ -597,7 +674,7 @@
}
package Nagios::Host::Status;
-our $VERSION = sprintf('%06d', '$Rev$' =~ /(\d+)/o);
+our $VERSION = '0.1';
# same deal as Nagios::Service::Status::status()
sub status {
@@ -627,10 +704,10 @@
}
package Nagios::Program::Status;
-our $VERSION = sprintf('%06d', '$Rev$' =~ /(\d+)/o);
+our $VERSION = '0.1';
package Nagios::Info::Status;
-our $VERSION = sprintf('%06d', '$Rev$' =~ /(\d+)/o);
+our $VERSION = '0.1';
1;
Modified: branches/upstream/libnagios-object-perl/current/t/00object.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnagios-object-perl/current/t/00object.t?rev=30949&op=diff
==============================================================================
--- branches/upstream/libnagios-object-perl/current/t/00object.t (original)
+++ branches/upstream/libnagios-object-perl/current/t/00object.t Sat Feb 21 07:04:54 2009
@@ -12,7 +12,7 @@
ok( my $timerange = Nagios::Object::parse_time_range( $timetxt ), "parse_time_range( $timetxt )" );
ok( eq_array($timerange, [[0,32400],[61200,86400]]), "verify data returned by parse_time_range" );
-diag( "creating a Nagios::TimePeriod object ..." );
+diag( "creating a Nagios::TimePeriod object ..." ) if ( $ENV{TEST_VERBOSE} );
my $tp = Nagios::TimePeriod->new(
timeperiod_name => '24x7',
alias => '24x7',
@@ -26,14 +26,14 @@
);
isa_ok( $tp, 'Nagios::Object' );
-diag( "creating a Nagios::Command object ..." );
+diag( "creating a Nagios::Command object ..." ) if ( $ENV{TEST_VERBOSE} );
my $cmd = Nagios::Command->new(
command_name => 'Test',
command_line => '/bin/true'
);
isa_ok( $cmd, 'Nagios::Object' );
-diag( "creating a Nagios::Contact object ..." );
+diag( "creating a Nagios::Contact object ..." ) if ( $ENV{TEST_VERBOSE} );
my $contact = Nagios::Contact->new(
contact_name => "testuser",
alias => "The Testing User",
@@ -47,14 +47,14 @@
pager => '5555555555'
);
-diag( "creating a Nagios::ContactGroup object ..." );
+diag( "creating a Nagios::ContactGroup object ..." ) if ( $ENV{TEST_VERBOSE} );
my $cg = Nagios::ContactGroup->new(
alias => 'A Test Contact Group',
contactgroup_name => 'testgroup',
members => [$contact]
);
-diag( "creating a Nagios::Host object ..." );
+diag( "creating a Nagios::Host object ..." ) if ( $ENV{TEST_VERBOSE} );
my $host = Nagios::Host->new(
host_name => 'localhost',
alias => 'localhost',
@@ -86,9 +86,9 @@
ok( $host->set_alias( "bar" ), "Nagios::Host->set_alias() works" );
is( $host->alias(), "bar", "Nagios::Host->alias() returns value set by previous test" );
-diag( "\ntesting templates ...\n\n" );
+diag( "\ntesting templates ...\n\n" ) if ( $ENV{TEST_VERBOSE} );
-diag( "creating service template ..." );
+diag( "creating service template ..." ) if ( $ENV{TEST_VERBOSE} );
my $template = Nagios::Service->new(
register => 0,
host => $host,
Modified: branches/upstream/libnagios-object-perl/current/t/50config.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnagios-object-perl/current/t/50config.t?rev=30949&op=diff
==============================================================================
--- branches/upstream/libnagios-object-perl/current/t/50config.t (original)
+++ branches/upstream/libnagios-object-perl/current/t/50config.t Sat Feb 21 07:04:54 2009
@@ -12,7 +12,7 @@
ok( my $cf = Nagios::Config->new(Filename => "nagios.cfg"),
"Nagios::Config->new()" );
-diag( "run tests to make sure inherited Nagios::Config::File methods work" );
+diag( "run tests to make sure inherited Nagios::Config::File methods work" ) if ( $ENV{TEST_VERBOSE} );
is( $cf->get('command_check_interval'), '15s',
"get('command_check_interval') returns 15s" );
@@ -27,7 +27,7 @@
ok( @$list > 2, "arrayref from previous test has more than two elements" );
-diag( "run tests to make sure inherited Nagios::Config::Object methods work" );
+diag( "run tests to make sure inherited Nagios::Config::Object methods work" ) if ( $ENV{TEST_VERBOSE} );
ok( $cf->resolve_objects, "\$parser->resolve_objects should be ok to call multiple times" );
ok( $cf->register_objects, "\$parser->register_objects should be ok to call multiple times" );
Modified: branches/upstream/libnagios-object-perl/current/t/54dump.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnagios-object-perl/current/t/54dump.t?rev=30949&op=diff
==============================================================================
--- branches/upstream/libnagios-object-perl/current/t/54dump.t (original)
+++ branches/upstream/libnagios-object-perl/current/t/54dump.t Sat Feb 21 07:04:54 2009
@@ -32,7 +32,7 @@
stalking_options => [qw(o d u)]
);
-diag( "create a test Nagios::Host object" );
+diag( "create a test Nagios::Host object" ) if ( $ENV{TEST_VERBOSE} );
my $host = Nagios::Host->new( %test_host );
ok( my $dump1 = $host->dump, "call dump()" );
@@ -62,3 +62,31 @@
is_deeply( $host->$key, $file_host->$key, "$key matches" );
}
+
+# test for rt#17945
+my $some_command = "foo";
+my $timeperiod = 5;
+
+my $generic_host = Nagios::Host->new(
+register => 0,
+parents => undef,
+check_command => $some_command,
+max_check_attempts => 3,
+checks_enabled => 1,
+event_handler => $some_command,
+event_handler_enabled => 0,
+low_flap_threshold => 0,
+high_flap_threshold => 0,
+flap_detection_enabled => 0,
+process_perf_data => 1,
+retain_status_information => 1,
+retain_nonstatus_information => 1,
+notification_interval => $timeperiod,
+notification_options => [qw(d u r)],
+notifications_enabled => 1,
+stalking_options => [qw(o d u)]
+);
+isa_ok($generic_host, 'Nagios::Host');
+
+ok( $generic_host->dump(), "rt#17945 - dump ok");;
+
Modified: branches/upstream/libnagios-object-perl/current/t/98nagios-sample-config.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnagios-object-perl/current/t/98nagios-sample-config.t?rev=30949&op=diff
==============================================================================
--- branches/upstream/libnagios-object-perl/current/t/98nagios-sample-config.t (original)
+++ branches/upstream/libnagios-object-perl/current/t/98nagios-sample-config.t Sat Feb 21 07:04:54 2009
@@ -23,7 +23,7 @@
);
foreach my $file ( @sample_files ) {
- diag( "testing with Nagios sample file $file ..." );
+ diag( "testing with Nagios sample file $file ..." ) if ( $ENV{TEST_VERBOSE} );
my $parser = Nagios::Object::Config->new( Version => '2.0' );
$parser->parse( $file );
Modified: branches/upstream/libnagios-object-perl/current/t/nagios2config.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnagios-object-perl/current/t/nagios2config.t?rev=30949&op=diff
==============================================================================
--- branches/upstream/libnagios-object-perl/current/t/nagios2config.t (original)
+++ branches/upstream/libnagios-object-perl/current/t/nagios2config.t Sat Feb 21 07:04:54 2009
@@ -12,7 +12,7 @@
ok( my $cf = Nagios::Config->new(Filename => "v2_config/nagios.cfg", Version => 2),
"Nagios::Config->new()" );
-diag( "run tests to make sure inherited Nagios::Config::File methods work" );
+diag( "run tests to make sure inherited Nagios::Config::File methods work" ) if ( $ENV{TEST_VERBOSE} );
is( $cf->get('command_check_interval'), '-1',
"get('command_check_interval') returns -1" );
@@ -27,7 +27,7 @@
ok( @$list > 2, "arrayref from previous test has more than two elements" );
-diag( "run tests to make sure inherited Nagios::Config::Object methods work" );
+diag( "run tests to make sure inherited Nagios::Config::Object methods work" ) if ( $ENV{TEST_VERBOSE} );
ok( $cf->resolve_objects, "\$parser->resolve_objects should be ok to call multiple times" );
ok( $cf->register_objects, "\$parser->register_objects should be ok to call multiple times" );
More information about the Pkg-perl-cvs-commits
mailing list