File Coverage

blib/lib/OpenInteract2/Config.pm

Criterion	Covered	Total	%
statement	13	15	86.6
branch			n/a
condition			n/a
subroutine	5	5	100.0
pod			n/a
total	18	20	90.0

package OpenInteract2::Config;

# $Id: Config.pm,v 1.16 2005/03/18 04:09:48 lachoy Exp $

use strict;
use base qw( Class::Factory );
use Log::Log4perl            qw( get_logger );
use OpenInteract2::Constants qw( :log );
use OpenInteract2::Exception qw( oi_error );

$OpenInteract2::Config::VERSION   = sprintf("%d.%02d", q$Revision: 1.16 $ =~ /(\d+)\.(\d+)/);

my ( $log );

##############################
# CLASS METHODS

# Create a new config object. This is a factory method: rather than
# creating new objects of the class OpenInteract2::Config, we use the
# variable $type and create an object based on it.

sub new {
    my ( $pkg, $type, @params ) = @_;
    unless ( $type ) {
        my @types = __PACKAGE__->get_loaded_types;
        oi_error "You must specify a configuration type in 'new()'; ",
                 "valid types are: ", join( ', ', @types );
    }
    my $class = eval { $pkg->get_factory_class( $type ) };
    oi_error $@ if ( $@ ) ;
    my $data = $class->read_config( @params );
    return bless( $data, $class );
}


sub is_file_valid {
    my ( $class, $filename ) = @_;
    unless  ( -f $filename ) {
        oi_error "Config file '$filename' does not exist";
    }
}


sub read_file {
    my ( $class, $filename ) = @_;
    $log ||= get_logger( LOG_CONFIG );
    $log->is_debug &&
        $log->debug( "Config trying to read file '$filename'" );
    $class->is_file_valid( $filename );
    open( CONF, '<', $filename )
          || oi_error "Cannot read config '$filename': $!";
    my @lines = ;
    close( CONF );
    return \@lines;
}


##############################
# OBJECT METHODS

sub translate_dirs {
    my ( $self ) = @_;
    return unless ( ref $self->{dir} eq 'HASH' );
    $log ||= get_logger( LOG_CONFIG );
    if ( $self->{dir}{_IS_TRANSLATED_} ) {
        $log->is_info &&
            $log->info( "Directories already translated, no action" );
        return;
    }
    my $site_dir = $self->{dir}{website};
    if ( $site_dir =~ s#(\\|/)$## ) {
        $self->{dir}{website} = $site_dir;
    }
    unless ( $site_dir ) {
        $log->error( "The config key 'dir.website' must be defined" );
        oi_error "Define 'dir.website' before continuing";
    }

    while ( my ( $dir_type, $dir_spec ) = each %{ $self->{dir} } ) {
        next unless ( $dir_spec );
        next if ( $dir_spec eq 'website' );
        my @pieces = split /\//, $dir_spec;
        if ( $pieces[0] eq '$WEBSITE' ) {
            $pieces[0] = $site_dir;
        }
        my $full_path = File::Spec->catdir( @pieces );
        $self->{dir}{ $dir_type } = $full_path;
        $log->is_debug &&
            $log->debug( "Set $dir_type = $full_path" );
    }
    return $self->{dir}{_IS_TRANSLATED_} = 1;
}


########################################
# SUBCLASS INTERFACE

# Subclasses should override these

sub read_config {
    oi_error 'Implementation must define read_config()';
}

sub save_config {
    oi_error 'Implementation must define save_config()';
}

########################################
# FACTORY

sub factory_log {
    my ( $self, @msg ) = @_;
    get_logger( LOG_CONFIG )->info( @msg );
}

sub factory_error {
    my ( $self, @msg ) = @_;
    get_logger( LOG_CONFIG )->error( @msg );
    die @msg, "\n";
}

# Initialize built-in configuration types

__PACKAGE__->register_factory_type(
                         perl => 'OpenInteract2::Config::PerlFile' );
__PACKAGE__->register_factory_type(
                         ini  => 'OpenInteract2::Config::IniFile' );

1;

__END__