view release on metacpan or  search on metacpan

lib/AppConfig/File.pm  view on Meta::CPAN

                    last FILE if $pedantic;
                }
            }
            else {
                $state->_error("parse error");
                $warnings++;
            }
        }
    }

    # restore original error handler
    $state->_ehandler($errhandler);

    # return $warnings => 0, $success => 1
    return $warnings ? 0 : 1;
}



#========================================================================
#                      -----  PRIVATE METHODS -----
#========================================================================

#------------------------------------------------------------------------
# _expand(\$value, $expand, $prefix)
#
# The variable value string, referenced by $value, is examined and any 
# embedded variables, environment variables or tilde globs (home 
# directories) are replaced with their respective values, depending on 
# the value of the second parameter, $expand.  The third paramter may
# specify the name of the current [block] in which the parser is 
# parsing.  This prefix is prepended to any embedded variable name that
# can't otherwise be resolved.  This allows the following to work:
#
#   [define]
#   home = /home/abw
#   html = $define_home/public_html
#   html = $home/public_html     # same as above, 'define' is prefix
#
# Modifications are made directly into the variable referenced by $value.
# The method returns 1 on success or 0 if any warnings (undefined 
# variables) were encountered.
#------------------------------------------------------------------------

sub _expand {
    my ($self, $value, $expand, $prefix) = @_;
    my $warnings = 0;
    my ($sys, $var, $val);


    # ensure prefix contains something (nothing!) valid for length()
    $prefix = "" unless defined $prefix;

    # take a local copy of the state to avoid much hash dereferencing
    my ($state, $debug, $pedantic) = @$self{ qw( STATE DEBUG PEDANTIC ) };

    # bail out if there's nothing to do
    return 1 unless $expand && defined($$value);

    # create an AppConfig::Sys instance, or re-use a previous one, 
    # to handle platform dependant functions: getpwnam(), getpwuid()
    unless ($sys = $self->{ SYS }) {
        require AppConfig::Sys;
        $sys = $self->{ SYS } = AppConfig::Sys->new();
    }

    print STDERR "Expansion of [$$value] " if $debug;

    EXPAND: {

        # 
        # EXPAND_VAR
        # expand $(var) and $var as AppConfig::State variables
        #
        if ($expand & AppConfig::EXPAND_VAR) {

            $$value =~ s{
                (?<!\\)\$ (?: \((\w+)\) | (\w+) ) # $2 => $(var) | $3 => $var

            } {
                # embedded variable name will be one of $2 or $3
                $var = defined $1 ? $1 : $2;

                # expand the variable if defined
                if ($state->_exists($var)) {
                    $val = $state->get($var);
                }
                elsif (length $prefix 
                        && $state->_exists($prefix . '_' . $var)) {
                    print STDERR "(\$$var => \$${prefix}_$var) "
                        if $debug;
                    $var = $prefix . '_' . $var;
                    $val = $state->get($var);
                }
                else {
                    # raise a warning if EXPAND_WARN set
                    if ($expand & AppConfig::EXPAND_WARN) {
                        $state->_error("$var: no such variable");
                        $warnings++;
                    }

                    # replace variable with nothing
                    $val = '';
                }

                # $val gets substituted back into the $value string
                $val;
            }gex;

            $$value =~ s/\\\$/\$/g;

            # bail out now if we need to
            last EXPAND if $warnings && $pedantic;
        }


        #
        # EXPAND_UID
        # expand ~uid as home directory (for $< if uid not specified)
        #
        if ($expand & AppConfig::EXPAND_UID) {