view release on metacpan or  search on metacpan

lib/App/CELL/Load.pm  view on Meta::CPAN

continues. 

This function doesn't care what type of configuration parameters
are in the file, except that they must be scalar values. Since the
configuration files are actually Perl modules, the value can even be
a reference (to an array, a hash, or a subroutine, or any other complex
data structure).

The technique used in the C<eval>, derived from Request Tracker, can be
described as follows: a local typeglob "set" is defined, containing a
reference to an anonymous subroutine. Subsequently, a config file (Perl
module) consisting of calls to this "set" subroutine is C<require>d.

Note: If even one call to C<set> fails to compile, the entire file will be
rejected and no configuration parameters from that file will be loaded.

The C<parse_config_file> function takes a PARAMHASH consisting of:

=over

=item C<File> - filename (full path)

=item C<Dest> - hash reference (where to store the config params).

=back

Returns: number of configuration parameters parsed/loaded

(IMPORTANT NOTE: If even one call to C<set> fails to compile, the entire
file will be rejected and no configuration parameters from that file will
be loaded.)

=cut

sub parse_config_file {
    my %ARGS = ( 
                    'File' => undef,
                    'Dest' => undef,
                    @_,
               );

    # This is so we can use the C<$self> variable (in the C<try>
    # statement, below) to reach the C<_conf_from_config> functions from
    # the configuration file.
    my $self = {};
    bless $self, 'App::CELL::Load';

    my $count = 0;
    
    # ideally this should be 'debug' for sharedir and 'info' for sitedir
    # but in this routine I have no easy way of telling one from the other
    $log->debug( "Loading =>$ARGS{'File'}<=", cell => 1 );
    if ( not ref( $ARGS{'Dest'} ) ) {
        $log->warn(
            "Something strange happened: destination is not a reference?!?",
            cell => 1,
        );
    }

    {
        use Try::Tiny;
        try {
            local *set = sub(@) {
                my $number_of_params = scalar @_;
                my @params = @_;
                my $param;
                my $value;
                if ( $number_of_params == 0 ) {
                    my $msg = "set() called with no parameters";
                    $log->crit( $msg, cell => 1 );
                    die $msg;
                } elsif ( $number_of_params == 1 ) {
                    $param = $params[0];
                    $log->warn(
                        "set() called with parameter $param but no value - set to \"\"",
                        cell => 1,
                    );
                } elsif ( $number_of_params == 2 ) {
                    $param = $params[0];
                    $value = $params[1];
                    $log->debug(
                        "set() called with parameter $param and one value",
                        cell => 1,
                    );
                } else {
                    $param = $params[0];
                    $value = $params[1];
                    $log->warn(
                        "set() called with $number_of_params parameters. Only " .
                        "the first two were used; the rest were ignored.",
                        cell => 1,
                    );
                }
                my ( undef, $file, $line ) = caller;
                $count += $self->_conf_from_config(
                    'Dest'  => $ARGS{'Dest'},
                    'Param' => $param,
                    'Value' => $value,
                    'File'  => $file,
                    'Line'  => $line,
                );
            };
            require $ARGS{'File'};
        }
        catch {
           my $errmsg = $_;
           $errmsg =~ s/\012/ -- /g;
           $log->err(
               "CELL_CONFIG_LOAD_FAIL on file $ARGS{File} with error message: $errmsg",
               cell => 1,
           );
           $log->debug( "The count is $count", cell => 1 );
           return $count;
        };
    }
    #$log->info( "Successfully loaded $count configuration parameters "
    #          . "from $ARGS{'File'}", cell => 1 );

    return $count;
}