package OpenInteract2::Config::Base;
# $Id: Base.pm,v 1.10 2004/02/18 05:25:27 lachoy Exp $
use strict;
use base qw( Exporter Class::Accessor::Fast );
use File::Basename qw( dirname );
use File::Spec::Functions qw( :ALL );
use Log::Log4perl qw( get_logger );
use OpenInteract2::Constants qw( :log BASE_CONF_DIR BASE_CONF_FILE );
use OpenInteract2::Context qw( CTX );
use OpenInteract2::Exception qw( oi_error );
$OpenInteract2::Config::Base::VERSION = sprintf("%d.%02d", q$Revision: 1.10 $ =~ /(\d+)\.(\d+)/);
my ( $log );
my @CONFIG_FIELDS = qw( website_dir temp_lib_dir package_dir
config_type config_class config_dir config_file );
my @FIELDS = ( @CONFIG_FIELDS, 'filename' );
OpenInteract2::Config::Base->mk_accessors( @FIELDS );
########################################
# CLASS METHODS
sub new {
my ( $class, $params ) = @_;
my $self = bless( {}, $class );
my $filename = $params->{filename};
my $website_dir = $params->{website_dir};
if ( ! $filename and $website_dir ) {
$filename = $self->create_website_filename( $website_dir );
$self->website_dir( $website_dir );
}
# If the last directory of the specified file is 'conf', assume
# that everything else is the website dir
elsif ( $filename and ! $website_dir ) {
$filename = rel2abs( $filename );
my @dirs = splitdir( dirname( $filename ) );
if ( $dirs[-1] eq BASE_CONF_DIR ) {
pop @dirs;
$self->website_dir( catdir( @dirs ) );
}
}
if ( $filename and -f $filename ) {
$params = $self->read_config( $filename );
$self->filename( $filename );
}
unless ( $self->config_dir ) {
$self->config_dir( BASE_CONF_DIR );
}
return $self->initialize( $params );
}
sub read_config {
my ( $class, $filename ) = @_;
$log ||= get_logger( LOG_CONFIG );
unless ( -f $filename ) {
$log->error( "Config file [$filename] does not exist" );
oi_error "Cannot open [$filename] for base configuration: ",
"file does not exist";
}
eval { open( CONF, "< $filename" ) || die $! };
if ( $@ ) {
$log->error( "Failed to open [$filename]: $@" );
oi_error "Cannot open [$filename] for base configuration: $@";
}
my $vars = {};
while ( <CONF> ) {
chomp;
$log->is_debug &&
$log->debug( "Config line read: $_" );
next if ( /^\s*\#/ );
next if ( /^\s*$/ );
s/^\s*//;
s/\s*$//;
my ( $var, $value ) = split /\s+/, $_, 2;
$vars->{ $var } = $value;
}
return $vars;
}
sub create_website_filename {
my ( $class, $dir ) = @_;
unless ( $dir ) {
oi_error "Must pass in website directory to create base ",
"config filename";
}
return $class->create_filename( catdir( $dir, BASE_CONF_DIR ) );
}
sub create_filename {
my ( $class, $dir ) = @_;
unless ( $dir ) {
oi_error "Must pass in directory to create base config filename";
}
return catfile( $dir, BASE_CONF_FILE );
}
########################################
# OBJECT METHODS
sub initialize {
my ( $self, $params ) = @_;
foreach my $field ( @CONFIG_FIELDS ) {
if ( $params->{ $field } ) {
$self->$field( $params->{ $field } );
}
if ( $field =~ /dir$/ ) {
$self->clean_dir( $field );
}
}
return $self;
}
sub clean_dir {
my ( $self, $prop ) = @_;
my $dir = $self->$prop();
if ( $dir ) {
$dir =~ s|/$||;
$self->$prop( $dir );
}
return $dir;
}
sub get_server_config_file {
my ( $self ) = @_;
unless ( $self->website_dir and $self->config_dir and
$self->config_file ) {
oi_error "Properties 'website_dir', 'config_dir' and 'config_file' ",
"must be defined to retrieve the config filename.";
}
$self->clean_dir( 'website_dir' );
$self->clean_dir( 'config_dir' );
return catfile( $self->website_dir,
$self->config_dir,
$self->config_file );
}
sub save_config {
my ( $self, ) = @_;
# First ensure that everything necessary is set
my @empty_fields = grep { ! $self->$_() } @CONFIG_FIELDS;
if ( scalar @empty_fields ) {
oi_error "Cannot save base config: the following fields must be",
"defined: ", join( ", ", @empty_fields );
}
# If not filename set, create one from the website_dir
unless ( $self->filename() ) {
$self->filename(
$self->create_website_filename( $self->website_dir )
);
}
eval { open( CONF, '>', $self->filename ) || die $! };
if ( $@ ) {
oi_error "Cannot open [", $self->filename, "] for writing: $@";
}
foreach my $config ( @CONFIG_FIELDS ) {
printf CONF "%-20s%s\n", $config, $self->$config();
}
close( CONF );
return $self->filename;
}
1;
__END__
=head1 NAME
OpenInteract2::Config::Base - Represents a server base configuration
=head1 SYNOPSIS
# Sample base configuration
website_dir /path/to/mysite
config_type ini
config_class OpenInteract2::Config::IniFile
config_dir conf
config_file server.ini
package_dir pkg
# Open an existing base config
my $bc = OpenInteract2::Config::Base->new({
website_dir => '/path/to/mysite' });
my $bc = OpenInteract2::Config::Base->new({
filename => '/path/to/mysite/conf/base-alt.conf' });
# Create a new one and write it with the default filename
my $bc = OpenInteract2::Config::Base->new;
$bc->website_dir( '/path/to/mysite' );
$bc->config_type( 'ini' );
$bc->config_class( 'OpenInteract2::Config::IniFile' );
$bc->config_dir( 'conf' );
$bc->config_file( 'server.ini' );
$bc->package_dir( 'pkg' );
$bc->write;
=head1 DESCRIPTION
A base configuration enables you to easily bootstrap an OpenInteract
server configuration with just a little information.
=head1 METHODS
=head2 Class Methods
B<new( [ \%params ] )>
Creates a new base config object. You can initialize it with as many
parameters as you like if you are creating one from scratch.
You can also pass in one of:
=over 4
=item B<filename>
=item B<website_dir>
=back
And the constructor will read values from C<filename> or the filename
returned by C<create_filename()> with C<website_dir>. The constructor
will also set the C<filename> property to the file from which the
values were read.
Returns: A C<OpenInteract2::Config::Base> object.
B<read_config( $filename )>
Reads configuration values from C<$filename> and returns the
configured key/value pairs. When reading in the file we sskip all
blank lines as well as lines beginning with a '#' for comments. Extra
space is stripped from the beginning and ending of all keys and values.
Returns: Hashref of config values from $filename.
B<create_website_filename( $website_directory )>
Creates a typicaly configuration filename given
C<$website_directory>. This is:
$website_directory/BASE_CONF_DIR/BASE_CONF_FILE
where C<BASE_CONF_DIR> and C<BASE_CONF_FILE> are from
L<OpenInteract2::Constants|OpenInteract2::Constants>.
An exception is thrown if C<$directory> is not provided. We do not
check whether C<$directory> is a valid directory.
Returns: a potential filename for a base config object
B<create_filename( $directory )>
Creates a typical configuration filename given C<$directory>. This is:
$directory/BASE_CONF_FILE
where C<BASE_CONF_FILE> is from
L<OpenInteract2::Constants|OpenInteract2::Constants>.
An exception is thrown if C<$directory> is not provided. We do not
check whether C<$directory> is a valid directory.
Returns: a potential filename for a base config object
=head2 Object Methods
B<initialize( \%params )>
You will probably never call this as it is only used from the
constructor.
Returns: a C<OpenInteract2::Config::Base> object with relevant
properties from C<\%params> set.
B<clean_dir( $property_name )>
Remove the trailing '/' from the directory specified by
C<$property_name>. Sets the property in the object and returns the
cleaned directory.
Example:
$bc->clean_dir( 'config_dir' );
$bc->clean_dir( 'website_dir' );
Returns: the cleaned directory.
B<get_server_config_file()>
Puts together the properties 'website_dir', 'config_dir' and
'config_file' to create a fully qualified filename.
Returns: full filename for the server config.
B<save_config()>
Writes the configured values from the object to a file. If you do not
set a filename before calling this the method will create one for you
using C<create_filename()> and the value from the C<website_dir>
property.
If you do not have all the properties defined the method will throw an
exception.
Returns: the filename to which the configuration was written.
=head1 PROPERTIES
B<website_dir>: Root directory of the website
B<config_type>: Type of configuration site is using
B<config_class>: Class used to read server configuration
B<config_dir>: Directory where configuration is kept, relative to
C<website_dir>
B<config_file>: Name of configuration file in C<config_dir>
B<package_dir>: Directory where packages are kept, relative to
C<website_dir>.
B<filename>: Location of base_configuration file. Not written out to
the base configuration file.
=head1 BUGS
None known.
=head1 TO DO
Nothing known.
=head1 SEE ALSO
L<Class::Accessor|Class::Accessor>
=head1 COPYRIGHT
Copyright (c) 2001-2004 Chris Winters. All rights reserved.
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=head1 AUTHORS
Chris Winters E<lt>chris@cwinters.comE<gt>