package ConfigReader::Simple; use strict; # $Id: Simple.pm,v 1.13 2002/09/16 21:18:46 comdog Exp $ use vars qw($VERSION $AUTOLOAD); use Carp qw(croak); ( $VERSION ) = sprintf "%d.%02d", q$Revision: 1.13 $ =~ m/ (\d+) \. (\d+) /gx; my $DEBUG = 0; =head1 NAME ConfigReader::Simple - Simple configuration file parser =head1 SYNOPSIS use ConfigReader::Simple; # parse one file $config = ConfigReader::Simple->new("configrc", [qw(Foo Bar Baz Quux)]); # parse multiple files, in order $config = ConfigReader::Simple->new_multiple( Files => [ "global", "configrc" ], Keys => [qw(Foo Bar Baz Quux)] ); my @directives = $config->directives; $config->get( "Foo" ); if( $config->exists( "Bar" ) ) { print "Bar was in the config file\n"; } =head1 DESCRIPTION C<ConfigReader::Simple> reads and parses simple configuration files. It's designed to be smaller and simpler than the C<ConfigReader> module and is more suited to simple configuration files. =head1 METHODS =over 4 =item new ( FILENAME, DIRECTIVES ) Creates a ConfigReader::Simple object. C<FILENAME> tells the instance where to look for the configuration file. C<DIRECTIVES> is an optional argument and is a reference to an array. Each member of the array should contain one valid directive. A directive is the name of a key that must occur in the configuration file. If it is not found, the module will die. The directive list may contain all the keys in the configuration file, a sub set of keys or no keys at all. The C<new> method is really a wrapper around C<new_multiple>. =cut sub new { my $class = shift; my $filename = shift; my $keyref = shift; $keyref = [] unless defined $keyref; my $self = $class->new_multiple( Files => [ $filename ], Keys => $keyref ); return $self; } =item new_multiple( Files => ARRAY_REF, Keys => ARRAY_REF ) Create a configuration object from several files listed in the anonymous array value for the C<Files> key. The module reads the files in the same order that they appear in the array. Later values override earlier ones. This allows you to specify global configurations which you may override with more specific ones: ConfigReader::Simple->new_multiple( Files => [ qw( /etc/config /usr/local/etc/config /home/usr/config ) ], ); This function carps if the values are not array references. =cut sub new_multiple { my $class = shift; my %args = @_; my $self = {}; $args{'Keys'} = [] unless defined $args{'Keys'}; carp( __PACKAGE__ . ': Strings argument must be a array reference') unless UNIVERSAL::isa( $args{'Files'}, 'ARRAY' ); carp( __PACKAGE__ . ': Keys argument must be an array reference') unless UNIVERSAL::isa( $args{'Keys'}, 'ARRAY' ); $self->{"filenames"} = $args{'Files'}; $self->{"validkeys"} = $args{'Keys'}; bless $self, $class; foreach my $file ( @{ $self->{"filenames"} } ) { $self->parse( $file ); } return $self; } =item new_string( Strings => ARRAY_REF, Keys => ARRAY_REF ) Create a configuration object from several strings listed in the anonymous array value for the C<Strings> key. The module reads the strings in the same order that they appear in the array. Later values override earlier ones. This allows you to specify global configurations which you may override with more specific ones: ConfigReader::Simple->new_strings( Strings => [ \$global, \$local ], ); This function carps if the values are not array references. =cut sub new_string { my $class = shift; my %args = @_; my $self = {}; $args{'Keys'} = [] unless defined $args{'Keys'}; carp( __PACKAGE__ . ': Strings argument must be a array reference') unless UNIVERSAL::isa( $args{'Strings'}, 'ARRAY' ); carp( __PACKAGE__ . ': Keys argument must be an array reference') unless UNIVERSAL::isa( $args{'Keys'}, 'ARRAY' ); bless $self, $class; $self->{"strings"} = $args{'Strings'}; $self->{"validkeys"} = $args{'Keys'}; foreach my $string ( @{ $self->{"strings"} } ) { $self->parse_string( $string ); } return $self; } =item add_config_file( FILENAME ) Parse another configuration file and add its directives to the current configuration object. Any directives already defined will be replaced with the new values found in FILENAME. =cut sub add_config_file { my $self = shift; my $filename = shift; return unless ( -e $filename and -r _ ); push @{ $self->{"filenames"} }, $filename if $self->parse( $filename ); return 1; } sub new_from_prototype { my $self = shift; my $filename = shift; my $clone = $self->clone; return $clone; } sub AUTOLOAD { my $self = shift; my $method = $AUTOLOAD; $method =~ s/.*:://; $self->get( $method ); } sub DESTROY { return 1; } =item parse( FILENAME ) This does the actual work. This is automatically called from C<new()>, although you can reparse the configuration file by calling C<parse()> again. =cut sub parse { my $self = shift; my $file = shift; open CONFIG, $file or die "Cannot open file $file: $!"; while( <CONFIG> ) { chomp; next if /^\s*(#|$)/; my ($key, $value) = &parse_line($_); warn "Key: '$key' Value: '$value'\n" if $DEBUG; $self->{"config_data"}{$key} = $value; } close(CONFIG); $self->_validate_keys; return 1; } =item parse_from_string( SCALAR_REF ) Parses the string inside the reference SCALAR_REF just as if it found it in a file. =cut sub parse_string { my $self = shift; my $string = shift; my @lines = split /\r?\n/, $$string; foreach my $line ( @lines ) { next if $line =~ /^\s*(#|$)/; my ($key, $value) = &parse_line($line); warn "Key: '$key' Value: '$value'\n" if $DEBUG; $self->{"config_data"}{$key} = $value; } $self->_validate_keys; return 1; } =item get( DIRECTIVE ) Returns the parsed value for that directive. For directives which did not have a value in the configuration file, C<get> returns the empty string. =cut sub get { my $self = shift; my $key = shift; return $self->{"config_data"}{$key}; } =item set( DIRECTIVE, VALUE ) Sets the value for DIRECTIVE to VALUE. The DIRECTIVE need not already exist. This overwrites previous values. =cut sub set { my $self = shift; my( $key, $value ) = @_; $self->{"config_data"}{$key} = $value; } =item unset( DIRECTIVE ) Remove the value from DIRECTIVE, which will still exist. It's value is undef. If the DIRECTIVE does not exist, it will not be created. Returns FALSE if the DIRECTIVE does not already exist, and TRUE otherwise. =cut sub unset { my $self = shift; my $key = shift; return unless $self->exists( $key ); $self->{"config_data"}{$key} = undef; return 1; } =item remove( DIRECTIVE ) Remove the DIRECTIVE. Returns TRUE is DIRECTIVE existed and FALSE otherwise. =cut sub remove { my $self = shift; my $key = shift; return unless $self->exists( $key ); delete $self->{"config_data"}{$key}; return 1; } =item directives() Returns a list of all of the directive names found in the configuration file. The keys are sorted ASCII-betically. =cut sub directives { my $self = shift; my @keys = sort keys %{ $self->{"config_data"} }; return @keys; } =item exists( DIRECTIVE ) Return TRUE if the specified directive exists, and FALSE otherwise. =cut sub exists { my $self = shift; my $name = shift; return CORE::exists $self->{"config_data"}{ $name }; } =item clone Return a copy of the object. The new object is distinct from the original. =cut # this is only the first stab at this -- from 35,000 # feet in coach class sub clone { my $self = shift; my $clone = {}; $clone->{"filename"} = $self->{"filename"}; $clone->{"validkeys"} = $self->{"validkeys"}; foreach my $key ( keys %{ $self->{'config_data'} } ) { $clone->{'config_data'}{$key} = $self->{'config_data'}{$key}; } bless $clone, __PACKAGE__; return $clone; } # Internal methods sub parse_line { my $text = shift; my ($key, $value); # AWJ: Allow optional '=' or ' = ' between key and value: if ($text =~ /^\s*(\w+)\s*[=]?\s*(['"]?)(.*?)\2\s*$/ ) { ( $key, $value ) = ( $1, $3 ); } else { croak "Config: Can't parse line: $text\n"; } return ($key, $value); } =item _validate_keys ( ) If any keys were declared when the object was constructed, check that those keys actually occur in the configuration file. =cut sub _validate_keys { my $self = shift; if ( $self->{"validkeys"} ) { my ($declared_key); my $declared_keys_ref = $self->{"validkeys"}; foreach $declared_key ( @$declared_keys_ref ) { unless ( $self->{"config_data"}{$declared_key} ) { croak "Config: key '$declared_key' does not occur in file $self->{filename}\n"; } warn "Key: $declared_key found.\n" if $DEBUG; } } return 1; } =back =head1 LIMITATIONS/BUGS Directives are case-sensitive. If a directive is repeated, the first instance will silently be ignored. =head1 CREDITS Bek Oberin <gossamer@tertius.net.au> wote the original module Kim Ryan <kimaryan@ozemail.com.au> adapted the module to make declaring keys optional. Thanks Kim. Alan W. Jurgensen <jurgensen@berbee.com> added a change to allow the NAME=VALUE format in the configuration file. =head1 AUTHORS brian d foy, <bdfoy@cpan.org> =head1 COPYRIGHT Copyright (c) 2002 brian d foy. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1;