view release on metacpan or  search on metacpan

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

=head1 DESCRIPTION

The purpose of the App::CELL::Load module is to provide message and config
file finding and loading functionality to the App::CELL::Message and
App::CELL::Config modules.



=head1 PACKAGE VARIABLES

This module provides the following package variables

=over 

=item C<$sharedir> - the full path of the sharedir

=item C<$sharedir_loaded> - whether it has been loaded or not

=item C<@sitedir> - the full path of the site configuration directory

=back

=cut

our $sharedir = '';
our $sharedir_loaded = 0;
our @sitedir = ();


=head1 MODULES

=head2 init

Idempotent initialization function.

Optionally takes a PARAMHASH. The following arguments are recognized:

=over

=item C<sitedir> -- full path to the/a site dir

=item C<enviro> -- name of environment variable containing sitedir path

=item C<verbose> -- increase logging verbosity of the load routine

=back

E.g.: 

    my $status = App::CELL::Load::init( 
                                         sitedir => '/etc/foo', 
                                         verbose => 1 
                                      );

See L<App::CELL::Guide> for details.

=cut

sub init {
    my %ARGS = validate( @_, {
        enviro => { type => SCALAR, optional => 1 },
        sitedir => { type => SCALAR, optional => 1 },
        verbose => { type => SCALAR, default => 0 },
    } );

    # determine verbosity level
    my $args_string;
    if ( %ARGS ) {
        $args_string = "with arguments: " . stringify_args( \%ARGS );
    } else {
        $args_string = "without arguments";
    }
    $meta->set('CELL_META_LOAD_VERBOSE', $ARGS{'verbose'} || 0);

    $log->info(
        "Entering App::CELL::Load::init from " . (caller)[0] . " $args_string",
        cell => 1
    ) if $meta->CELL_META_LOAD_VERBOSE;

    # check for taint mode
    if ( ${^TAINT} != 0 ) {
        return App::CELL::Status->new( level => "FATAL",
            code => "Attempt to load while in taint mode (-T)" );
    }

    # look up sharedir
    if ( not $sharedir ) {
        my $tmp_sharedir = File::ShareDir::dist_dir('App-CELL');
        if ( ! is_directory_viable( $tmp_sharedir ) ) {
            return App::CELL::Status->new( 
                level => 'ERR', 
                code => 'CELL_SHAREDIR_NOT_VIABLE',
                args => [ $tmp_sharedir, $App::CELL::Util::not_viable_reason ],
            );
        } 
        $log->info( "Found viable CELL configuration directory " . 
            $tmp_sharedir . " in App::CELL distro", cell => 1 ) if $meta->CELL_META_LOAD_VERBOSE;
        $site->set( 'CELL_SHAREDIR_FULLPATH', $tmp_sharedir );
        $sharedir = $tmp_sharedir;
    }

    # walk sharedir
    if ( $sharedir and not $sharedir_loaded ) {
        my $status = message_files( $sharedir );
        my $load_status = _report_load_status( $sharedir, 'sharedir', 'message', $status );
        return $load_status if $load_status->not_ok;
        $status = meta_core_site_files( $sharedir );
        $load_status = _report_load_status( $sharedir, 'sharedir', 'config params', $status );
        return $load_status if $load_status->not_ok;
        $site->set( 'CELL_SHAREDIR_LOADED', 1 );
        $sharedir_loaded = 1;
    }

    if ( $meta->CELL_META_LOAD_VERBOSE ) {
        if ( @sitedir ) {
            $log->debug( "sitedir package variable contains ->" . 
                         join( ':', @sitedir ) . "<-", cell => 1 );
        } else {
            $log->debug( "sitedir package variable is empty", cell => 1 );
        }

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

                        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;
}


=head2 _conf_from_config

This function takes a target hashref (which points to one of the 'meta',
'core', or 'site' package hashes in C<App::CELL::Config>), a config parameter
(i.e. a string), config value, config file name, and line number.

Let's imagine that the configuration parameter is "FOO_BAR". The function
first checks if a key named "FOO_BAR" already exists in the package hash
(which is passed into the function as C<%ARGS{'Dest'}>). If there isn't
one, it creates that key. If there is one, it leaves it untouched and
triggers a warning.

Although the arguments are passed to the function in the form of a
PARAMHASH, the function converts them into ordinary private variables.
This was necessary to avoid extreme notational ugliness.

=cut

sub _conf_from_config {
    my $self = shift;
    my ( %ARGS ) = validate( @_, {
        Dest => { type => HASHREF },
        Param => { type => SCALAR },
        Value => { type => SCALAR|SCALARREF|ARRAYREF|HASHREF|CODEREF|UNDEF },
        File => { type => SCALAR },
        Line => { type => SCALAR },
    } );
    # convert PARAMHASH into private variables
    my $desthash = $ARGS{'Dest'};
    my $param = $ARGS{'Param'};
    my $value = $ARGS{'Value'};
    my $file = $ARGS{'File'};
    my $line = $ARGS{'Line'};

    if ( keys( %{ $desthash->{ $param } } ) ) 
    {
        $log->warn(
            "ignoring duplicate definition of config parameter $param in line $line " .
            "of config file $file because it conflicts with a similar parameter in " .
            $desthash->{ $param }->{'File'},
            cell => 1,
        );
        return 0;
    } else {
        $desthash->{ $param } = {
                                    'Value' => $value,
                                    'File'  => $file,
                                    'Line'  => $line,
                                }; 
        $log->debug(
                "Parsed parameter $param from $file, line $line",
                cell => 1, 
                suppress_caller => 1
            ) if $meta->CELL_META_LOAD_VERBOSE;
        return 1;
    } 
}

1;