view release on metacpan or  search on metacpan

lib/App/Options.pm  view on Meta::CPAN

                # or "[value;var=value]" or "[/regexp/;var1=value1;var2=/regexp2/]"
                if (s!^\s*\[(.*)\]\s*!!) {
                    print STDERR "         Checking Section : [$1]\n" if ($debug_options >= 6);
                    @cond = split(/;/,$1);   # separate the conditions that must be satisfied
                    $exclude = 0;            # assume the condition allows inclusion (! $exclude)
                    foreach $cond (@cond) {  # check each condition
                        if ($cond =~ /^([^=]+)=(.*)$/) {  # i.e. [city=ATL] or [name=/[Ss]tephen/]
                            $var = $1;
                            $value = $2;
                        }
                        else {              # i.e. [go] matches the program (app) named "go"
                            $var = "app";
                            $value = $cond;
                        }
                        if ($value =~ m!^/(.*)/$!) {  # variable's value must match the regexp
                            $regexp = $1;
                            $exclude = ((defined $values->{$var} ? $values->{$var} : "") !~ /$regexp/) ? 1 : 0;
                            print STDERR "         Checking Section Condition var=[$var] [$value] matches [$regexp] : result=",
                                ($exclude ? "[ignore]" : "[use]"), "\n"
                                if ($debug_options >= 6);
                        }
                        elsif ($var eq "app" && ($value eq "" || $value eq "ALL")) {
                            $exclude = 0;   # "" and "ALL" are special wildcards for the "app" variable
                            print STDERR "         Checking Section Condition var=[$var] [$value] = ALL : result=",
                                ($exclude ? "[ignore]" : "[use]"), "\n"
                                if ($debug_options >= 6);
                        }
                        else {  # a variable's value must match exactly
                            $exclude = ((defined $values->{$var} ? $values->{$var} : "") ne $value) ? 1 : 0;
                            print STDERR "         Checking Section Condition var=[$var] [$value] = [",
                                (defined $values->{$var} ? $values->{$var} : ""),
                                "] : result=",
                                ($exclude ? "[ignore]" : "[use]"), "\n"
                                if ($debug_options >= 6);
                        }
                        last if ($exclude);
                    }
                    s/^#.*$//;               # delete comments
                    print STDERR "      ", ($exclude ? "[ignore]" : "[use]   "), " $orig_line\n" if ($debug_options >= 5);
                    if ($_) {
                        # this is a single-line condition, don't change the $exclude_section flag
                        next if ($exclude);
                    }
                    else {
                        # this condition pertains to all lines after it
                        $exclude_section = $exclude;
                        next;
                    }
                }
                else {
                    print STDERR "      ", ($exclude_section ? "[ignore]" : "[use]   "), " $orig_line\n" if ($debug_options >= 5);
                }
                next if ($exclude_section);

                s/#.*$//;        # delete comments
                s/^\s+//;         # delete leading spaces
                s/\s+$//;         # delete trailing spaces
                next if (/^$/);  # skip blank lines

                # look for "var = value" (ignore other lines)
                if (/^([^\s=]+)\s*=\s*(.*)/) {  # untainting also happens
                    $var = $1;
                    $value = $2;

                    if (!$is_mod_perl) {
                        if ($var eq "perl_restart" && $value && $value ne "1") {
                            foreach my $env_var (split(/,/,$value)) {
                                if (!$ENV{$env_var}) {
                                    $value = 1;
                                    last;
                                }
                            }
                        }
                    }

                    # "here documents": var = <<EOF ... EOF
                    if ($value =~ /^<<(.*)/) {
                        $heredoc_end = $1;
                        $value = "";
                        while (<App::Options::FILE>) {
                            last if ($_ =~ /^$heredoc_end\s*$/);
                            $value .= $_;
                        }
                        $heredoc_end = "";
                    }
                    # get value from a file
                    elsif ($value =~ /^<\s*(.+)/ || $value =~ /^(.+)\s*\|$/) {
                        $value =~ s/\$\{([a-zA-Z0-9_\.-]+)\}/(defined $values->{$1} ? $values->{$1} : "")/eg;
                        if (open(App::Options::FILE2, $value)) {
                            $value = join("", <App::Options::FILE2>);
                            close(App::Options::FILE2);
                        }
                        else {
                            $value = "Can't read file [$value] for variable [$var]: $!";
                        }
                    }
                    # get additional line(s) due to continuation chars
                    elsif ($value =~ s/\\\s*$//) {
                        while (<App::Options::FILE>) {
                            if ($_ =~ s/\\\s*[\r\n]*$//) {   # remove trailing newline
                                s/^\s+//;  # remove leading space when following a line continuation character
                                $value .= $_;
                            }
                            else {
                                chomp;     # remove trailing newline when following a line continuation character
                                s/^\s+//;  # remove leading space when following a line continuation character
                                $value .= $_;
                                last;
                            }
                        }
                    }
                    else {
                        $value =~ s/^"(.*)"$/$1/;  # quoting, var = " hello world " (enables leading/trailing spaces)
                    }

                    print STDERR "         Var Found in File : var=[$var] value=[$value]\n" if ($debug_options >= 6);
                    
                    # only add values which have never been defined before
                    if ($var =~ /^ENV\{([^{}]+)\}$/) {
                        $env_var = $1;
                        $ENV{$env_var} = $value;