r66106 - in /trunk/libnagios-object-perl: Build.PL ChangeLog META.yml debian/changelog lib/Nagios/Object.pm lib/Nagios/Object/Config.pm
carnil at users.alioth.debian.org
carnil at users.alioth.debian.org
Wed Dec 22 06:56:30 UTC 2010
Author: carnil
Date: Wed Dec 22 06:56:20 2010
New Revision: 66106
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=66106
Log:
New upstream release
Modified:
trunk/libnagios-object-perl/Build.PL
trunk/libnagios-object-perl/ChangeLog
trunk/libnagios-object-perl/META.yml
trunk/libnagios-object-perl/debian/changelog
trunk/libnagios-object-perl/lib/Nagios/Object.pm
trunk/libnagios-object-perl/lib/Nagios/Object/Config.pm
Modified: trunk/libnagios-object-perl/Build.PL
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnagios-object-perl/Build.PL?rev=66106&op=diff
==============================================================================
--- trunk/libnagios-object-perl/Build.PL (original)
+++ trunk/libnagios-object-perl/Build.PL Wed Dec 22 06:56:20 2010
@@ -13,7 +13,7 @@
},
dist_name => 'Nagios-Object',
- dist_version => "0.21.12",
+ dist_version => "0.21.13",
dist_author => 'Duncan Ferguson <duncs at cpan.org>',
dist_abstract => 'Nagios::Object - Nagios object configuration parsing.',
license => 'gpl',
@@ -25,6 +25,7 @@
'Data::Dumper' => 0.01,
'Scalar::Util' => 0.01,
'Test::NoWarnings' => 0.08,
+ 'List::Compare' => 0.37,
}
);
Modified: trunk/libnagios-object-perl/ChangeLog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnagios-object-perl/ChangeLog?rev=66106&op=diff
==============================================================================
--- trunk/libnagios-object-perl/ChangeLog (original)
+++ trunk/libnagios-object-perl/ChangeLog Wed Dec 22 06:56:20 2010
@@ -110,3 +110,9 @@
0.21.10 - Fixed test failure on Perl 5.11 (RT #54464)
0.21.11 - Added repository, bugtracker and homepage resources
0.21.12 - Fixed continuation line handling - Thanks to payerle (RT#58906)
+0.21.13 - Fixed parsing of ServiceEscalation, ServiceDependency and HostEscalation types. Thanks to PIRZYK (RT#63802)
+ - Fixed host_name and hostgroup_name methods in various objects. Thanks to PIRZYK (RT#63805)
+ - Improve find_object performance. Thanks to PIRZYK (RT#63803)
+ - Allow for nested group membership. Thanks to PIRZYK (RT#63804)
+ - Ensure host membership lists are consistent. Thanks to PIRZYK (RT#63808)
+ - Allow for name() method to not be unique on service objects. Thanks to PIRZYK (RT#63806)
Modified: trunk/libnagios-object-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnagios-object-perl/META.yml?rev=66106&op=diff
==============================================================================
--- trunk/libnagios-object-perl/META.yml (original)
+++ trunk/libnagios-object-perl/META.yml Wed Dec 22 06:56:20 2010
@@ -4,6 +4,7 @@
- 'Duncan Ferguson <duncs at cpan.org>'
build_requires:
Data::Dumper: 0.01
+ List::Compare: 0.37
Module::Build: 0.26
Scalar::Util: 0.01
Test::Exception: 0.01
@@ -38,10 +39,10 @@
version: 0.1
Nagios::Object:
file: lib/Nagios/Object.pm
- version: 40
+ version: 45
Nagios::Object::Config:
file: lib/Nagios/Object/Config.pm
- version: 37
+ version: 39
Nagios::Program::Status:
file: lib/Nagios/StatusLog.pm
version: 0.1
@@ -64,4 +65,4 @@
homepage: http://github.com/duncs/perl-nagios-object
license: http://www.gnu.org/licenses/old-licenses/gpl-1.0.txt
repository: http://github.com/duncs/perl-nagios-object
-version: v0.21.12
+version: v0.21.13
Modified: trunk/libnagios-object-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnagios-object-perl/debian/changelog?rev=66106&op=diff
==============================================================================
--- trunk/libnagios-object-perl/debian/changelog (original)
+++ trunk/libnagios-object-perl/debian/changelog Wed Dec 22 06:56:20 2010
@@ -1,3 +1,9 @@
+libnagios-object-perl (0.21.13-1) UNRELEASED; urgency=low
+
+ * New upstream release
+
+ -- Salvatore Bonaccorso <carnil at debian.org> Wed, 22 Dec 2010 07:55:12 +0100
+
libnagios-object-perl (0.21.12-2) UNRELEASED; urgency=low
* Update my email address.
Modified: trunk/libnagios-object-perl/lib/Nagios/Object.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnagios-object-perl/lib/Nagios/Object.pm?rev=66106&op=diff
==============================================================================
--- trunk/libnagios-object-perl/lib/Nagios/Object.pm (original)
+++ trunk/libnagios-object-perl/lib/Nagios/Object.pm Wed Dec 22 06:56:20 2010
@@ -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 = '40';
+our $VERSION = '45';
our $pre_link = undef;
our $fast_mode = undef;
our %nagios_setup;
@@ -44,11 +44,12 @@
sub NAGIOS_NO_DISPLAY { 1 << 7 } # should not be displayed by gui
sub NAGIOS_V3 { 1 << 8 } # nagios v3 attribute
sub NAGIOS_V3_ONLY { 1 << 9 } # not valid for nagios v1 or v2
+sub NAGIOS_GROUP_SYNC { 1 << 10 } # keep sync'ed with members method in group object
# export constants - the :all tag will export them all
our %EXPORT_TAGS = (
all => [
- qw(NAGIOS_NO_INHERIT NAGIOS_PERL_ONLY NAGIOS_V1 NAGIOS_V2 NAGIOS_V3 NAGIOS_V1_ONLY NAGIOS_V2_ONLY NAGIOS_V3_ONLY NAGIOS_NO_DISPLAY)
+ qw(NAGIOS_NO_INHERIT NAGIOS_PERL_ONLY NAGIOS_V1 NAGIOS_V2 NAGIOS_V3 NAGIOS_V1_ONLY NAGIOS_V2_ONLY NAGIOS_V3_ONLY NAGIOS_NO_DISPLAY NAGIOS_GROUP_SYNC)
]
);
Exporter::export_ok_tags('all');
@@ -71,7 +72,7 @@
Service => {
use => [ 'Nagios::Service', 10 ],
service_description => [ 'STRING', 10 ],
- display_name => ['STRING', 280],
+ display_name => [ 'STRING', 280 ],
host_name => [ ['Nagios::Host'], 10 ],
servicegroups => [ ['Nagios::ServiceGroup'], 280 ],
hostgroup_name => [ ['Nagios::HostGroup'], 256 ],
@@ -120,6 +121,7 @@
servicegroup_name => [ 'STRING', 18 ],
alias => [ 'STRING', 16 ],
members => [ [ 'Nagios::Host', 'Nagios::Service' ], 16 ],
+ servicegroup_members => [ ['Nagios::ServiceGroup'], 280 ],
name => [ 'servicegroup_name', 22 ],
comment => [ 'comment', 22 ],
file => [ 'filename', 22 ]
@@ -130,7 +132,7 @@
alias => [ 'STRING', 280 ],
address => [ 'STRING', 280 ],
parents => [ ['Nagios::Host'], 280 ],
- hostgroups => [ ['Nagios::HostGroup'], 280 ],
+ hostgroups => [ ['Nagios::HostGroup'], 1304 ],
check_command => [ 'STRING', 280 ],
max_check_attempts => [ 'INTEGER', 280 ],
checks_enabled => [ 'BINARY', 280 ],
@@ -173,8 +175,9 @@
hostgroup_name => [ 'STRING', 280 ],
alias => [ 'STRING', 280 ],
contact_groups => [ ['Nagios::ContactGroup'], 40 ],
- members => [ ['Nagios::Host'], 280 ],
- name => [ 'hostgroup', 280 ],
+ members => [ ['Nagios::Host'], 1304 ],
+ hostgroup_members => [ ['Nagios::HostGroup'], 280 ],
+ name => [ 'hostgroup_name', 280 ],
comment => [ 'comment', 280 ],
file => [ 'filename', 280 ]
},
@@ -201,7 +204,7 @@
address4 => [ 'STRING', 16 ],
address5 => [ 'STRING', 16 ],
address6 => [ 'STRING', 16 ],
- contactgroups => [ ['Nagios::ContactGroup'], 16 ],
+ contactgroups => [ ['Nagios::ContactGroup'], 1040 ],
name => [ 'contact_name', 280 ],
comment => [ 'comment', 280 ],
file => [ 'filename', 280 ]
@@ -210,7 +213,8 @@
use => [ 'Nagios::ContactGroup', 280 ],
contactgroup_name => [ 'STRING', 280 ],
alias => [ 'STRING', 280 ],
- members => [ ['Nagios::Contact'], 280 ],
+ members => [ ['Nagios::Contact'], 1304 ],
+ contactgroup_members => [ ['Nagios::ContactGroup'], 280 ],
name => [ 'contactgroup_name', 280 ],
comment => [ 'comment', 280 ],
file => [ 'filename', 280 ]
@@ -252,7 +256,7 @@
},
ServiceEscalation => {
use => [ 'Nagios::ServiceEscalation', 280 ],
- host_name => [ 'Nagios::Host', 280 ],
+ host_name => [ ['Nagios::Host'], 280 ],
hostgroup_name => [ ['Nagios::HostGroup'], 280 ],
service_description => [ 'Nagios::Service', 280 ],
contacts => [ ['Nagios::Contact'], 280 ],
@@ -268,11 +272,11 @@
},
ServiceDependency => {
use => [ 'Nagios::ServiceDependency', 280 ],
- dependent_host_name => [ 'Nagios::Host', 280 ],
+ dependent_host_name => [ ['Nagios::Host'], 280 ],
dependent_service_description => [ 'Nagios::Service', 280 ],
- hostgroup_name => [ 'Nagios::HostGroup', 280 ],
- dependent_hostgroup_name => [ 'Nagios::HostGroup', 280 ],
- host_name => [ 'Nagios::Host', 280 ],
+ hostgroup_name => [ ['Nagios::HostGroup'], 280 ],
+ dependent_hostgroup_name => [ ['Nagios::HostGroup'], 280 ],
+ host_name => [ ['Nagios::Host'], 280 ],
service_description => [ 'Nagios::Service', 280 ],
inherits_parent => [ 'INTEGER', 280 ],
execution_failure_criteria => [ [qw(o w u c n)], 280 ],
@@ -285,8 +289,8 @@
},
HostEscalation => {
use => [ 'Nagios::HostEscalation', 280 ],
- host_name => [ 'Nagios::Host', 280 ],
- hostgroup => [ 'Nagios::HostGroup', 280 ],
+ host_name => [ ['Nagios::Host'], 280 ],
+ hostgroup => [ ['Nagios::HostGroup'], 280 ],
contacts => [ ['Nagios::Contact'], 280 ],
contact_groups => [ ['Nagios::ContactGroup'], 280 ],
first_notification => [ 'INTEGER', 280 ],
@@ -294,14 +298,15 @@
notification_interval => [ 'INTEGER', 280 ],
name => [ 'host_name', 280 ],
comment => [ 'comment', 280 ],
- escalation_options => [[qw(d u r)], 280 ],
- file => [ 'filename', 280 ]
+ escalation_options => [ [qw(d u r)], 280 ],
+ file => [ 'filename', 280 ]
},
HostDependency => {
use => [ 'Nagios::HostDependency', 280 ],
- dependent_host_name => [ 'Nagios::Host', 280 ],
- dependent_hostgroup_name => [ 'Nagios::HostGroup', 280 ],
- host_name => [ 'Nagios::Host', 280 ],
+ dependent_host_name => [ ['Nagios::Host'], 280 ],
+ dependent_hostgroup_name => [ ['Nagios::HostGroup'], 280 ],
+ host_name => [ ['Nagios::Host'], 280 ],
+ hostgroup_name => [ ['Nagios::HostGroup'], 280 ],
inherits_parent => [ 'INTEGER', 16 ],
notification_failure_criteria => [ [qw(o w u c n)], 280 ],
notification_failure_options => [ [qw(o w u c n)], 280 ],
@@ -657,20 +662,20 @@
my $_name_hack;
sub name {
- my $self = shift;
- my $name_method = $self->_name_attribute;
-
- if ( $name_method eq 'generated' ) {
- $_name_hack++;
- return
- ref($self) . '-'
- . $_name_hack; # FIXME: this should work but feels wrong
- }
+ my $self = shift;
if ( !$self->register ) {
return $self->{name};
}
else {
+ my $name_method = $self->_name_attribute;
+ if ( $name_method eq 'generated' ) {
+ $_name_hack++;
+ return
+ ref($self) . '-'
+ . $_name_hack; # FIXME: this should work but feels wrong
+ }
+
my $name = $self->$name_method();
# recurse down on references to get the names, then generate something
Modified: trunk/libnagios-object-perl/lib/Nagios/Object/Config.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnagios-object-perl/lib/Nagios/Object/Config.pm?rev=66106&op=diff
==============================================================================
--- trunk/libnagios-object-perl/lib/Nagios/Object/Config.pm (original)
+++ trunk/libnagios-object-perl/lib/Nagios/Object/Config.pm Wed Dec 22 06:56:20 2010
@@ -27,7 +27,7 @@
# NOTE: due to CPAN version checks this cannot currently be changed to a
# standard version string, i.e. '0.21'
-our $VERSION = '37';
+our $VERSION = '39';
our $fast_mode = undef;
our $strict_mode = undef;
@@ -71,9 +71,10 @@
config_files => []
};
- # initialize lists e.g. host_list, command_list, etc.
+ # initialize lists and indexes e.g. host_list, command_index, etc.
foreach my $class ( keys %nagios_setup ) {
$self->{ lc($class) . '_list' } = [];
+ $self->{ lc($class) . '_index' } = {};
}
# parse arguments passed in
@@ -294,6 +295,11 @@
= [ 'STRING', 0 ];
$current->{$key} = $val;
}
+
+ # Add to the find_object search hash.
+ if ( $key eq 'name' || $key eq $nagios_setup{ $current->setup_key }->{'name'}[0] ) {
+ push( @{ $self->{ lc($current->setup_key) . '_index' }->{$val} }, $current );
+ }
}
else {
croak
@@ -327,19 +333,42 @@
my $searchlist;
if ( $type && $type =~ /^Nagios::/ ) {
- $searchlist = $self->all_objects_for_type($type);
+ my @objl = $self->find_objects($name, $type);
+ return $objl[0] if ( scalar @objl );
}
elsif ( !$type ) {
$searchlist = $self->all_objects;
- }
-
- foreach my $obj (@$searchlist) {
-
- #printf STDERR "obj name '%s', name searched '%s'\n", $obj->name, $name;
- if ( $obj->name && $obj->name eq $name ) {
- return $obj;
- }
- }
+
+ foreach my $obj (@$searchlist) {
+
+ #printf STDERR "obj name '%s', name searched '%s'\n", $obj->name, $name;
+ my $n = $obj->name;
+ if ( $n && $n eq $name ) {
+ return $obj;
+ }
+ }
+ }
+}
+
+=item find_objects()
+
+Search through the list of objects' names and return all the matches.
+The second argument is required.
+
+ my @object_list = $parser->find_objects( "load", "Nagios::Service" );
+
+=cut
+
+sub find_objects {
+ my ( $self, $name, $type ) = @_;
+
+ if ( $type && $type =~ /^Nagios::(.*)/ ) {
+ my $index_type = lc($1) . '_index';
+ if ( exists $self->{$index_type} && exists $self->{$index_type}->{$name} ) {
+ return @{$self->{$index_type}->{$name}};
+ }
+ }
+ return ();
}
=item find_objects_by_regex()
@@ -584,10 +613,98 @@
$object->$set(@new_list);
}
else {
- my $ref = $self->find_object( $object->$attribute(), $attr_type );
- $object->_set( $attribute, $ref ) if ($ref);
- }
-
+ my @refl = $self->find_objects( $object->$attribute(), $attr_type );
+ if ( scalar @refl == 1 ) {
+ $object->_set( $attribute, $refl[0] );
+ }
+
+ # If we have found multiple hits, then we most likely have a Nagios::Service
+ # Need to pick the correct one. Use the Nagios::Host object to help pick it.
+ elsif ( scalar @refl > 1 && ( $object->can('host_name') || $object->can('hostgroup_name') )) {
+ sub _host_list {
+ my ($self, $method, $h) = @_;
+ if ( $self->can($method) ) {
+ if ( ref $self->$method eq 'ARRAY' ) {
+ map {
+ if ( ref $_ eq '' ) {
+ $h->{$_}++;
+ } else {
+ $h->{$_->host_name}++;
+ }
+ } @{$self->$method};
+ } elsif ( defined $self->$method ) {
+ $h->{ $self->$method }++;
+ }
+ }
+ }
+ sub get_host_list {
+ my $self = shift;
+ my $obj = $self->{'object_config_object'};
+ my %h;
+ &_host_list($self, 'host_name', \%h);
+ if ( $self->can('hostgroup_name') ) {
+ if ( ref $self->hostgroup_name eq 'ARRAY' ) {
+ foreach my $hg ( @{$self->hostgroup_name} ) {
+ my $hg2 = ( ref $hg eq ''
+ ? $obj->find_object($hg, 'Nagios::HostGroup')
+ : $hg);
+ &_host_list($hg2, 'members', \%h);
+ }
+ } elsif ( defined $self->hostgroup_name ) {
+ my $hg2 = ( ref $self->hostgroup_name eq ''
+ ? $obj->find_object($self->hostgroup_name, 'Nagios::HostGroup')
+ : $self->hostgroup_name);
+ &_host_list($hg2, 'members', \%h);
+ }
+ }
+ return keys %h;
+ }
+ my @h1 = &get_host_list($object);
+ my $old_found = 0;
+ foreach my $o ( @refl ) {
+ my @h2 = &get_host_list($o);
+ next if ( ! scalar @h2 );
+ my $found = 0;
+ foreach my $h ( @h1 ) {
+ $found++ if ( grep {$h eq $_} @h2 );
+ }
+ # Use the service which had the max hosts found.
+ if ( $found > $old_found ) {
+ $object->_set( $attribute, $o );
+ $old_found = $found;
+ }
+ }
+ }
+ }
+
+ # This field is marked as to be synced with it's group members object
+ if ( ( $nagios_setup{ $object->setup_key }->{ $attribute }[1] & NAGIOS_GROUP_SYNC ) == NAGIOS_GROUP_SYNC ) {
+ my $method = ( $attribute eq 'members'
+ ? lc($object->{'_nagios_setup_key'}) . 's'
+ : 'members');
+ my $setmethod = 'set_' . $method;
+
+ foreach my $o ( @{$object->$attribute()} ) {
+ next if ( ! $o->can($method) );
+ my $members = $o->$method();
+
+ # If the object has not yet been registered, just add the name
+ if ( ! $o->registered ) {
+ if ( defined $members && ref $members eq '' ) {
+ $members = [ $members, $object->name ];
+ } else {
+ push @$members, $object->name;
+ }
+ $o->$setmethod($members);
+ }
+
+ # otherwise add the object itself.
+ elsif ( ! $members || ! grep ({$object eq $_} @$members )) {
+ push @$members, $object;
+ $o->$setmethod($members);
+ }
+ }
+ }
}
$object->registered(1);
@@ -689,7 +806,9 @@
sub register_objects {
my $self = shift;
- foreach my $obj_type ( map { lc $_ } keys %nagios_setup ) {
+ # Order we process the Object is important. We need the Host/HostGroups
+ # processed before the Service and the Service before the ServiceEescalation
+ foreach my $obj_type ( map { lc $_ } sort keys %nagios_setup ) {
foreach my $object ( @{ $self->{ $obj_type . '_list' } } ) {
$self->register($object);
}
More information about the Pkg-perl-cvs-commits
mailing list