libnagios-object-perl 0.21.20-2 / usr / share / perl5 / Nagios / Config / File.pm

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<Nagios::Config::File> 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<Nagios::Config::File>.

=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<NAME> for the current file.
If C<SPLIT> 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