File Coverage

blib/lib/Config/Manager/Base.pm

Criterion	Covered	Total	%
statement	34	95	35.7
branch	5	30	16.6
condition	0	12	0.0
subroutine	5	8	62.5
pod	0	3	0.0
total	44	148	29.7

###############################################################################
##                                                                           ##
##    Copyright (c) 2003 by Steffen Beyer & Gerhard Albers.                  ##
##    All rights reserved.                                                   ##
##                                                                           ##
##    This package is free software; you can redistribute it                 ##
##    and/or modify it under the same terms as Perl itself.                  ##
##                                                                           ##
###############################################################################

package Config::Manager::Base;

use strict;
use vars qw( @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION $SCOPE $NONE %SIG @ARGV );

require Exporter;

@ISA = qw(Exporter);

@EXPORT = qw();

@EXPORT_OK = qw(
                   $SCOPE
                   GetList
                   GetOrDie
                   ReportErrorAndExit
               );

%EXPORT_TAGS = (all => [@EXPORT_OK]);

$VERSION = '1.7';

use Config::Manager::Conf;
use Config::Manager::Report qw(:all);

################################################
## Private function, name prescribed by Perl! ##
################################################

BEGIN # Global initialization
{
    my($self) = __PACKAGE__;
    my($depth,$caller,$index,$param,$match,$sec,$var,$val,$err);
    my             (  $HOST_LIST, $LANG_LIST, $SRC_LIST, $OBJ_LIST, $EXE_LIST );
    my(@Refs)  =   ( \$HOST_LIST,\$LANG_LIST,\$SRC_LIST,\$OBJ_LIST,\$EXE_LIST );
    my(@Names) = qw(   HOST_LIST   LANG_LIST   SRC_LIST   OBJ_LIST   EXE_LIST );
    my($Section) = "Commandline";
    my($EnvHost) = 1;
    my($EnvLang) = 1;

    ###########################################################################
    # Ensure writability of log dirs etc. for all users:
    umask(002);
    ###########################################################################
    # Determine current "scope":
    $SCOPE = $NONE = 'NONE';
    $self =~ s!::.*$!!;
    $depth = 0;
    while (defined ($caller = (caller($depth++))[0]))
    {
        if ($caller =~ /^         ${self}
                              :: ([a-zA-Z0-9_]+)
                          (?: ::  [a-zA-Z0-9_]+ )* $/ox)
        {
            $SCOPE = $1;
        }
    }
    if ($SCOPE eq $NONE)
    {
        warn "WARNING: Couldn't determine the caller's \"scope\" (assuming '$NONE')!\n";
    }
    unless (defined (Config::Manager::Conf->init( $SCOPE )))
    {
        $err = Config::Manager::Conf->error();
        $err =~ s!\s+$!!;
        &abort( __PACKAGE__ .
            "::BEGIN(): Global initialization failed:\n$err\n" );
    }
    ###########################################################################
    # Install signal handlers for common signals:
    $SIG{'INT'} = 'IGNORE'; # Ignore Ctrl-C (important for closing log file!)
    ###########################################################################
    # Initialize logging module and log file (trigger creation of singleton object):
    unless (ref ($err = Config::Manager::Report->singleton()))
    {
        $err =~ s!\s+$!!;
        &abort( __PACKAGE__ .
            "::BEGIN(): Global initialization failed:\n$err\n" );
    }
    $err = '';
    Config::Manager::Report->notify(1); # in case this should be the default
    ###########################################################################
#   # Read configuration constants for command line option processing:
#   for ( $index = 0; $index < @Refs; $index++ )
#   {
#       $var = $Refs[$index];
#       $val = $Names[$index];
#       unless (defined (${$var} = Config::Manager::Conf->get( $Section, $val )))
#       {
#           $err = Config::Manager::Conf->error();
#           $err =~ s!\s+$!!;
#           Config::Manager::Report->report
#           (
#               $TO_LOG+$TO_ERR,$LEVEL_FATAL+$USE_LEADIN,
#               __PACKAGE__ . "::BEGIN():",
#               "Couldn't get the value of configuration constant " .
#               Config::Manager::Conf::_name_($Section,$val) . ":",
#               $err
#           );
#           &abort();
#       }
#       # Sanity check (*MUST* be uppercase in order to avoid
#       # clashes with lowercase tool-specific parameters!):
#       unless (${$var} =~ m!^[A-Z][A-Z0-9]*(?:\|[A-Z][A-Z0-9]*)*$!)
#       {
#           Config::Manager::Report->report
#           (
#               $TO_LOG+$TO_ERR,$LEVEL_FATAL+$USE_LEADIN,
#               __PACKAGE__ . "::BEGIN():",
#               "Syntax error in configuration constant " .
#               Config::Manager::Conf::_name_($Section,$val) .
#               " (must be UPPERCASE and '|'-separated)!"
#           );
#           &abort();
#       }
#   }
#   $match = "HOST=(?:$HOST_LIST)|LANG=(?:$LANG_LIST)|SRC=(?:$SRC_LIST)|OBJ=(?:$OBJ_LIST)|EXE=(?:$EXE_LIST)";
#   ###########################################################################
#   # The shortcuts below implement the following precedence rules:           #
#   # (low) Config File << Environment Variable << Command Line Option (high) #
#   ###########################################################################
#   # Configuration Shortcuts Part 1:
#   $index = 0;
#   LOOP1:
#   while ($index < @ARGV)
#   {
#       $param = \$ARGV[$index];
#       if ($$param =~ m!^-(?:$match)(?:,(?:$match))*$!o)
#       {
#           splice(@ARGV,$index,1);
#           while ($$param =~ m!($match)!go)
#           {
#               $sec = $1;
#               ($var,$val) = split(/=/, $sec);
#               $EnvHost = 0 if ($var eq 'HOST');
#               $EnvLang = 0 if ($var eq 'LANG');
#               splice(@ARGV,$index,0,"-D${Section}::$var=$val");
#               $index++;
#           }
#           next LOOP1;
#       }
#       elsif ($$param =~ m!^-($HOST_LIST),($LANG_LIST),($SRC_LIST),($OBJ_LIST),($EXE_LIST)$!o)
#       {
#           $EnvHost = 0;
#           $EnvLang = 0;
#           splice(@ARGV,$index,1,
#               "-D${Section}::HOST=$1",
#               "-D${Section}::LANG=$2",
#               "-D${Section}::SRC=$3",
#               "-D${Section}::OBJ=$4",
#               "-D${Section}::EXE=$5" );
#           $index += 5;
#           next LOOP1;
#       }
#       elsif ($$param =~ m!^-($LANG_LIST),($SRC_LIST),($OBJ_LIST),($EXE_LIST)$!o)
#       {
#           $EnvLang = 0;
#           splice(@ARGV,$index,1,
#               "-D${Section}::LANG=$1",
#               "-D${Section}::SRC=$2",
#               "-D${Section}::OBJ=$3",
#               "-D${Section}::EXE=$4" );
#           $index += 4;
#           next LOOP1;
#       }
#       elsif ($$param =~ m!^-($SRC_LIST),($OBJ_LIST),($EXE_LIST)$!o)
#       {
#           splice(@ARGV,$index,1,
#               "-D${Section}::SRC=$1",
#               "-D${Section}::OBJ=$2",
#               "-D${Section}::EXE=$3" );
#           $index += 3;
#           next LOOP1;
#       }
#       elsif ($$param =~ m!^-($HOST_LIST),($LANG_LIST)$!o)
#       {
#           $EnvHost = 0;
#           $EnvLang = 0;
#           splice(@ARGV,$index,1,
#               "-D${Section}::HOST=$1",
#               "-D${Section}::LANG=$2" );
#           $index += 2;
#           next LOOP1;
#       }
#       elsif ($$param =~ s!^-($LANG_LIST)$!-D${Section}::LANG=$1!o) { $EnvLang = 0; }
#       elsif ($$param =~ m!^-D${Section}::LANG=(?:$LANG_LIST)$!o)   { $EnvLang = 0; }
#       elsif ($$param =~ s!^-($HOST_LIST)$!-D${Section}::HOST=$1!o) { $EnvHost = 0; }
#       elsif ($$param =~ m!^-D${Section}::HOST=(?:$HOST_LIST)$!o)   { $EnvHost = 0; }
#       $index++;
#   }
#   ###########################################################################
#   # Configuration Shortcuts Part 2:
#   unshift( @ARGV, "-D${Section}::LANG=$1" )
#       if ($EnvLang and
#           (exists  $ENV{'COMPLANG'}) and
#           (defined $ENV{'COMPLANG'}) and
#           (        $ENV{'COMPLANG'}  =~  m!^($LANG_LIST)$!o));
#   ###########################################################################
#   # Configuration Shortcuts Part 3:
#   unshift( @ARGV, "-D${Section}::HOST=$1" )
#       if ($EnvHost and
#           (exists  $ENV{'PLATFORM'}) and
#           (defined $ENV{'PLATFORM'}) and
#           (        $ENV{'PLATFORM'}  =~  m!^($HOST_LIST)$!o));
    ###########################################################################
    # Process "Define"s for configuration constants:
    $index = 0;
    LOOP2:
    while ($index < @ARGV)
    {
        $param = $ARGV[$index];
        if ($param =~ /^-D   ( [a-zA-Z][a-zA-Z0-9_-]* )
                      ( (?: :: [a-zA-Z][a-zA-Z0-9_-]* )? )
                      = ( .* ) $/x)
        {
            $sec = $1;
            $var = $2;
            $val = $3;
            if ($var eq '')
            {
                $var = $sec;
                $sec = 'DEFAULT';
            }
            else { $var = substr($var,2); }
            if ((substr($sec,-1) ne '-') && (substr($var,-1) ne '-'))
            {
                unless (defined (Config::Manager::Conf->set( $sec,$var,$val )))
                {
                    $err = Config::Manager::Conf->error();
                    $err =~ s!\s+$!!;
                    Config::Manager::Report->report
                    (
                        $TO_LOG+$TO_ERR,$LEVEL_FATAL+$USE_LEADIN,
                        __PACKAGE__ . "::BEGIN():",
                        "Couldn't set the value of configuration constant " .
                        Config::Manager::Conf::_name_($sec,$var) . ":",
                        $err
                    );
                    &abort();
                }
                Config::Manager::Report->report
                (
                    $TO_LOG,$LEVEL_INFO,
                    "OVERRIDE: " . Config::Manager::Conf::_name_($sec,$var) . " = \"${val}\""
                );
                splice(@ARGV,$index,1); # remove option from command line
                next LOOP2;
            }
        }
        $index++;
    }
}

#######################
## Public functions: ##
#######################

sub ReportErrorAndExit
{
    my($fishy) = 1;

    if (Config::Manager::Report->ret_hold() > 0)
    {
        Config::Manager::Report->report($FROM_HOLD+$TO_ERR);
        $fishy = 0;
    }
    if (@_ > 0)
    {
        Config::Manager::Report->report($TO_LOG+$TO_ERR,$LEVEL_ERROR+$USE_LEADIN,@_);
        $fishy = 0;
    }
    if ($fishy)
    {
        Config::Manager::Report->report(
            $TO_LOG+$TO_ERR,$LEVEL_ERROR+$USE_LEADIN,
            "Program abortion without error message -",
            "see log file for possible causes!" );
        Config::Manager::Report->notify(1); # print location of log file if possible
    }
    &abort();
}

sub GetList
{
    my($conf,$item,$value,$error);
    my(@list);

    if ((@_ > 0) && (ref($_[0]) eq 'Config::Manager::Conf'))
        { $conf = shift; }
    else
        { $conf = Config::Manager::Conf->default(); }
    @list = ();
    foreach $item (@_)
    {
        if (ref($item) && (ref($item) eq 'ARRAY') && (@{$item} > 0))
        {
            if (defined ($value = $conf->get( @{$item} )))
            {
                push(@list, $value);
            }
            else
            {
                $error = $conf->error();
                $error =~ s!\s+$!!;
                Config::Manager::Report->report
                (
                    @ERROR,
                    "Couldn't get the value of configuration constant " .
                    Config::Manager::Conf::_name_(@{$item}) . ":",
                    $error
                );
                return ();
            }
        }
        else
        {
            Config::Manager::Report->report
            (
                @FATAL,
        "Parameter '$item' is not a valid ARRAY reference (internal program error)"
            );
            return ();
        }
    }
    return (@list);
}

sub GetOrDie
{
    my(@list);

    if (@list = &GetList(@_)) { return (@list); }
    &ReportErrorAndExit();
}

1;

__END__