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