File Coverage

blib/lib/SPOPS/Initialize.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

package SPOPS::Initialize;

# $Id: Initialize.pm,v 3.4 2004/06/02 00:48:21 lachoy Exp $

use strict;
use Log::Log4perl qw( get_logger );
use SPOPS;
use SPOPS::ClassFactory;
use SPOPS::Exception qw( spops_error );

my $log = get_logger();

$SPOPS::Initialize::VERSION = sprintf("%d.%02d", q$Revision: 3.4 $ =~ /(\d+)\.(\d+)/);

# Main interface -- take the information read in from 'read_config()'
# and create SPOPS classes, then initialize them

sub process {
    my ( $class, $p ) = @_;
    $p ||= {};
    my $config = $p->{config};
    if ( $p->{directory} or $p->{filename} ) {
        $config = $class->read_config( $p );
        return unless ( ref $config eq 'HASH' );
        delete $p->{filename};
        delete $p->{directory};
        delete $p->{pattern};
    }

    # We were given more than one configuration to process, so merge

    if ( ref $config eq 'ARRAY' ) {
        my $full_config = {};
        foreach my $single_config ( @{ $config } ) {
            next unless ( ref $single_config eq 'HASH' );
            foreach my $object_key ( keys %{ $single_config } ) {
                $full_config->{ $object_key } = $single_config->{ $object_key };
            }
        }
        $config = $full_config;
    }

    my $class_created_ok = SPOPS::ClassFactory->create( $config, $p ) || [];
    unless ( scalar @{ $class_created_ok } ) {
        $log->warn( "No classes were created by 'SPOPS::ClassFactory->create()'" );
        return undef;
    }

    # Now go through each of the classes created and initialize

    my @full_success = ();
    foreach my $spops_class ( @{ $class_created_ok } ) {
        eval { $spops_class->class_initialize() };
        if ( $@ ) {
            spops_error "Failed to run class_initialize() on ",
                        "[$spops_class]: $@";
        }
        push @full_success, $spops_class;
    }
    return \@full_success;
}


# Read in one or more configuration files (see POD)

sub read_config {
    my ( $class, $p ) = @_;
    my @config_files = ();

    # You can specify one or more filenames to read

    if ( $p->{filename} ) {
        if ( ref $p->{filename} eq 'ARRAY' ) {
            push @config_files, @{ $p->{filename} };
        }
        else {
            push @config_files, $p->{filename};
        }
    }

    # Or specify a directory and, optionally, a pattern to match for
    # files to read

    elsif ( $p->{directory} and -d $p->{directory} ) {
        my $dir = $p->{directory};
        $log->is_info &&
            $log->info( "Reading configuration files from ($dir) with pattern ($p->{pattern})" );
        opendir( CONF, $dir )
               || spops_error "Cannot read configuration files from directory [$dir]: $!";
        my @directory_files = readdir( CONF );
        close( CONF );
        foreach my $file ( @directory_files ) {
            my $full_filename = "$dir/$file";
            next unless ( -f $full_filename );
            if ( $p->{pattern} ) {
                next unless ( $file =~ /$p->{pattern}/ );
            }
            push @config_files, $full_filename;
        }
    }

    # Now read in each of the files and assign the values to the main
    # $spops_config.

    my %spops_config = ();
    foreach my $file ( @config_files ) {
        $log->is_info &&
            $log->info( "Reading configuration from file: ($file)" );
        my $data = $class->read_perl_file( $file );
        if ( ref $data eq 'HASH' ) {
            foreach my $spops_key ( keys %{ $data } ) {
                $spops_config{ $spops_key } = $data->{ $spops_key };
            }
        }
    }

    return \%spops_config;
}


# Read in a Perl data structure from a file and return

sub read_perl_file {
    my ( $class, $filename ) = @_;
    return undef unless ( -f $filename );
    eval { open( INFO, $filename ) || die $! };
    if ( $@ ) {
        warn "Cannot open config file for evaluation ($filename): $@ ";
        return undef;
    }
    local $/ = undef;
    no strict;
    my $info = ;
    close( INFO );
    my $data = eval $info;
    if ( $@ ) {
        spops_error "Cannot read data structure from [$filename]: $@";
    }
    return $data;
}

1;

__END__