package Nagios::Config::File; use strict; use warnings; use Carp; use Symbol; # NOTE: due to CPAN version checks this cannot currently be changed to a # standard version string, i.e. '0.21' our $VERSION = '35'; my %DUPLICATES_ALLOWED = ( cfg_file => 1, cfg_dir => 1, ); =head1 NAME Nagios::Config::File - Base class for Nagios configuration files =head1 SYNOPSIS use Nagios::Config ; my $nc = new Nagios::Config("/usr/local/nagios/etc/nagios.cfg") ; my $resource = $nc->get_resource_cfg() ; print $resource->get_attr('$USER1$') . "\n" ; =head1 DESCRIPTION C is the base class for all Nagios configuration files. You should not need to create these yourself. =cut =head1 CONSTRUCTOR =over 4 =item new ([FILE]) Creates a C. =back =cut sub new { my $class = shift; my $file = shift; croak "Missing argument: must specify a configuration file to parse." if ( !$file ); my $this = {}; bless( $this, $class ); my $fh = undef; if ( ref($file) ) { $fh = $file; } else { $fh = gensym; open( $fh, "<$file" ) || croak("Can't open $file for reading: $!"); $this->{filename} = $file; } $this->{file_attributes} = {}; $this->{fh} = $fh; $this->parse(); close($fh); return $this; } sub parse { my $this = shift; my $fh = $this->{fh}; while (<$fh>) { my $line = $this->strip($_); if ( $this->is_comment($line) ) { next; } elsif ( my ( $name, $value ) = $this->is_attribute($line) ) { if ( $DUPLICATES_ALLOWED{$name} ) { push @{ $this->{file_attributes}->{$name} }, $value; } else { $this->{file_attributes}->{$name} = $value; } } } } sub strip { my $this = shift; my $line = shift; $line =~ s/^\s+//; $line =~ s/\s+$//; return $line; } sub is_comment { my $this = shift; my $line = shift; if ( ( $line eq '' ) || ( $line =~ /^#/ ) ) { return 1; } return 0; } sub is_attribute { my $this = shift; my $line = shift; if ( $line =~ /^([\w\$]+)\s*=\s*(.+)$/ ) { return ( $1, $2 ); } return (); } =head1 METHODS =over 4 =item get ([NAME], [SPLIT]) Returns the value of the attribute C for the current file. If C is true, returns a list of all the values split on /\s*,\s*/. This is useful for attributes that can have more that one value. =cut sub get { my ( $this, $name, $split ) = @_; my $val = $this->{file_attributes}->{$name}; return $split ? split( /\s*,\s*/, $val ) : $val; } sub get_attr { &get; } =item filename() Returns the filename for the current object. =cut sub filename { $_[0]->{filename} } =item dump () Returns a scalar with the full configuration text ready to parse again. =cut sub dump { my $this = shift; my $outtxt = "# filename: $this->{filename}\n"; foreach my $attr ( keys( %{ $this->{file_attributes} } ) ) { if ( $DUPLICATES_ALLOWED{$attr} ) { foreach my $element ( @{ $this->{file_attributes}{$attr} } ) { $outtxt .= $attr . '=' . $element . "\n"; } } else { $outtxt .= $attr . '=' . $this->{file_attributes}{$attr} . "\n"; } } return $outtxt; } 1; =back =head1 AUTHOR Patrick LeBoutillier, patl@cpan.org Al Tobey, tobeya@cpan.org =head1 SEE ALSO Nagios::Config, Nagios::Config::Object =cut