File Coverage

blib/lib/Basset/Object/Conf.pm

Criterion	Covered	Total	%
statement	47	67	70.1
branch	24	48	50.0
condition	12	25	48.0
subroutine	6	6	100.0
pod	2	4	50.0
total	91	150	60.6

package Basset::Object::Conf;

#Basset::Object::Conf Copyright and (c) 2002, 2003, 2004, 2005, 2006 James A Thomason III
#Basset::Object::Conf is distributed under the terms of the Perl Artistic License.

=pod

=head1 NAME

Basset::Object::Conf - used to read conf files

=head1 AUTHOR

Jim Thomason, [e-mail]

=head1 DESCRIPTION

It's good not to set up default values inside of your module. Believe me, I know. Lord knows I've gotten chewed out enough for Carp::Notify
having the defaults in the module. Anyway, this module includes instructions for the conf file format, how the read_conf_file method works,
and some bits of interaction with the rest of the system. See Basset::Object for more information.

=cut


$VERSION = '1.03';

#
# Basset::Object::Conf isa Basset::Object, but there are circular inheritance reasons. So, instead,
# @ISA is set from within the read_conf_file method
#
#
#use Basset::Object;
#@ISA = qw(Basset::Object);

use strict;
use warnings;

=pod

=head1 SET-UP

You'll need to specify your conf files. There is the @conf_files array, toss in as many conf files as you'd like

 my @conf_files = qw(
 	/etc/mail.bulkmail.cfg
 	/etc/mail.bulkmail.cf2
 );

It'll just silently ignore any conf files that aren't present, so don't expect any errors. That's to allow you
to place multiple conf files in for use on multiple servers and then not worry about them.

Multiple conf files are in significance order. So if mail.bulkmail.cfg and mail.bulkmail.cf2 both define a value
for 'foo', then the one in mail.bulkmail.cfg is used. And so on, conf files listed earlier are more important.
There is no way for a program to later look at a less significant conf value.

=cut

our @conf_files = (qw(
		/etc/basset.conf
		./basset.conf
		Basset/Object/basset.conf
		lib/Basset/Object/basset.conf
	),
);
our %conf_files = ();

sub conf_files {
	my $class = shift;
	foreach (reverse @_) {
		unshift @conf_files, $_ unless $conf_files{$_}++;
	}

	return @conf_files;

}

our $default_package = 'Basset::Object';

=pod

=over

=item read_conf_file

read_conf_file will read in the conf files specified in the @conf_files array up at the top.

You can also pass in a list of conf files to read, in most to least significant order, same as the @conf_files array.

 my $conf = Mail::Bulkmail::Object->read_conf_file();
 or
 my $conf = Mail::Bulkmail::Object->read_conf_file('conf_files' => '/other/conf.file');
 or
 my $conf = Mail::Bulkmail::Object->read_conf_file('conf_files' => ['/other/conf.file', '/additional/conf.file']);

If you pass in a list of conf files, then the internal @conf_files array is bypassed.

$conf is a hashref of hashrefs. the main keys are the package names, the values are the hashes of the values
for that object.

Example:

 #conf file
 define package Mail::Bulkmail

 use_envelope = 1
 safe_banned = 0

 define package Mail::Bulkmail::Server

 Smtp = your.smtp.com
 Port = 25

 $conf = {
 	'Mail::Bulkmail' => {
 		'use_envelope' => 1,
 		'safe_banned' => 1
 	},
 	'Mail::Bulkmail::Server' => {
 		'Smtp' => 'your.smtp.com',
 		'safe_banned' => 1
 	}
 };

read_conf_file is called at object initialization. Any defaults for your object are read in at this time.
You'll rarely need to read the conf file yourself, since at object creation it is read and parsed and the values passed
on.

Note that it will combine the conf file in with an existing conf hash. To get a fresh one, pass in the conf_hash parameter.

Basset::Object->read_conf_file('conf_hash' => {});

B

The conf file is only re-read if it has been modified since the last time it was read.

=cut

our $conf = {};
our $loaded = {};

sub conf {
	return $conf;
}

sub loaded {
	return $loaded;
}

sub read_conf_file {
	my $class = shift;

	#this is a major league hack. Since Basset::Object::Conf isa Basset::Object, we wait
	#until now to set its inheritance. Basset::Object::Conf should never be instantiated, so it's
	#not an issue. The first time read_conf_file is called, we set this to be a Basset::Object.
	#
	#This way, we can successfully compile this module first, and have Basset::Object use it.
	unless (@Basset::Object::Conf::ISA) {
		require Basset::Object;
		@Basset::Object::Conf::ISA = qw(Basset::Object);
	}

	my %init = @_;

	if (defined $init{'conf_files'} && ! ref $init{'conf_files'}) {
		$init{'conf_files'} = [$init{'conf_files'}];
	}

	my @confs	= reverse($init{'conf_files'} ? @{$init{'conf_files'}} : $class->conf_files);
	my $conf	= $init{'conf_hash'} ? $init{'conf_hash'} : $class->conf;

	$conf->{$default_package}->{'types'}->{'conf'} = $class;

	foreach my $conf_file (@confs){
		next unless -e $conf_file ;

		if (! $class->loaded->{$conf_file} || -M $conf_file < $class->loaded->{$conf_file} || @_){

			my $pkg	 = $default_package;

			my $handle = $class->gen_handle;

			open ($handle, $conf_file) || next;
			while (my $line = <$handle>) {

				next if ! defined $line || $line =~ /^\s*#/ || $line =~ /^\s*$/;

				if ($line =~ /^define package\s+(\S+)/){
					$pkg = $1;
					next;
				};

				if ($line =~ /^include file\s+(\S+)/) {
					my $subconf = $class->read_conf_file($1);
					foreach my $pkg (keys %$subconf) {
						my $pkgconf = $conf->{$pkg};
						my $subpkgconf = $subconf->{$pkg};
						@$pkgconf{keys %$subpkgconf} = values %$subpkgconf;
					};
					next;
				};

				$line =~ s/(?:^\s+|\s+$)//g;
				$line =~ /^(?:\s*(\d+)\s*:)?\s*([-+]?\w+)\s*([@%]?)=\s*(.+)/
					or return $class->error("Invalid conf file : $line", "BOC-02");

				my ($user, $key, $ref, $val) = ($1, $2, $3, $4);

				unless (defined $val){
					($user, $key, $ref, $val) = ($user, $key, undef, $ref);
				};

				unless (defined $ref){
					($user, $key, $ref, $val) = (undef, $user, $ref, $key);
				};

				($user, $key, $val) = (undef, $user, $key) unless defined $val;

				next if defined $user && $user != $>;

				$val = undef if $val eq 'undef';

				$val = eval qq{return "$val"} if defined $val && $val =~ /^\\/;

				if ($ref) {
					if ($ref eq '@') {
						$conf->{$pkg}->{$key} ||= [];
						push @{$conf->{$pkg}->{$key}}, $val;
					} elsif ($ref eq '%') {
						$conf->{$pkg}->{$key} ||= {};
						my ($k, $v) = split(/\s*=\s*/, $val);
						$conf->{$pkg}->{$key}->{$k} = $v;
					}
				}
				else {
					$conf->{$pkg}->{$key} = $val;
				};
			};	#end while
			close $handle;

			#this is an irritating hack. In order to notify, types needs to be defined
			#and chances are, this is the first place we'd define it due to circular inheritance
			#issues.

			unless (! $class->loaded->{$conf_file}) {
				Basset::Object->add_trickle_class_attr('types')
					unless Basset::Object->can('types');
				$class->notify('ConfFileReRead', $conf_file);
			}

			$class->loaded->{$conf_file} = -M $conf_file unless @_;
		};	#end if
	};	#end foreach
	return $conf;

};	#end sub

1;

__END__