view release on metacpan or  search on metacpan

lib/Apache/TestConfig.pm  view on Meta::CPAN

    for my $name (qw(user group)) { #win32
        if ($vars->{$name}) {
            print $out qq[\u$name    "$vars->{$name}"\n];
        }
    }

    #2.0: ServerName $ServerName:$Port
    #1.3: ServerName $ServerName
    #     Port       $Port
    my @name_cfg = $self->servername_config($vars->{servername},
                                            $vars->{port});
    for my $pair (@name_cfg) {
        print $out "@$pair\n";
    }

    $self->replace_vars($in, $out);

    # handle the case when mod_alias is built as a shared object
    # but wasn't included in the system-wide httpd.conf

    print $out "<IfModule mod_alias.c>\n";
    for (sort keys %aliases) {
        next unless $vars->{$aliases{$_}};
        print $out "    Alias /getfiles-$_ $vars->{$aliases{$_}}\n";
    }
    print $out "</IfModule>\n";

    print $out "\n";

    $self->postamble_run($out);

    print $out join "\n", @very_last_postamble;

    close $in;
    close $out or die "close $conf_file: $!";
}

sub need_reconfiguration {
    my($self, $conf_opts) = @_;
    my @reasons = ();
    my $vars = $self->{vars};

    # if '-port select' we need to check from scratch which ports are
    # available
    if (my $port = $conf_opts->{port} || $Apache::TestConfig::Argv{port}) {
        if ($port eq 'select') {
            push @reasons, "'-port $port' requires reconfiguration";
        }
    }

    my $exe = $vars->{apxs} || $vars->{httpd} || '';
    # if httpd.conf is older than executable
    push @reasons,
        "$exe is newer than $vars->{t_conf_file}"
            if -e $exe &&
               -e $vars->{t_conf_file} &&
               -M $exe < -M $vars->{t_conf_file};

    # any .in files are newer than their derived versions?
    if (my @files = $self->extra_conf_files_needing_update) {
        # invalidate the vhosts cache, since a different port could be
        # assigned on reparse
        $self->{vhosts} = {};
        for my $file (@files) {
            push @reasons, "$file.in is newer than $file";
        }
    }

    # if special env variables are used (since they can change any time)
    # XXX: may be we could check whether they have changed since the
    # last run and thus avoid the reconfiguration?
    {
        my $passenv = passenv();
        if (my @env_vars = sort grep { $ENV{$_} } keys %$passenv) {
            push @reasons, "environment variables (@env_vars) are set";
        }
    }

    # if the generated config was created with a version of Apache-Test
    # less than the current version
    {
      my $current = Apache::Test->VERSION;
      my $config  = $self->{apache_test_version};

      if (! $config || $config < $current) {
          push @reasons, "configuration generated with old Apache-Test";
      }
    }

    return @reasons;
}

sub error_log {
    my($self, $rel) = @_;
    my $file = catfile $self->{vars}->{t_logs}, 'error_log';
    my $rfile = abs2rel $file, $self->{vars}->{top_dir};
    return wantarray ? ($file, $rfile) :
      $rel ? $rfile : $file;
}

#utils

#For Win32 systems, stores the extensions used for executable files
#They may be . prefixed, so we will strip the leading periods.

my @path_ext = ();

if (WIN32) {
    if ($ENV{PATHEXT}) {
        push @path_ext, split ';', $ENV{PATHEXT};
        for my $ext (@path_ext) {
            $ext =~ s/^\.*(.+)$/$1/;
        }
    }
    else {
        #Win9X: doesn't have PATHEXT
        push @path_ext, qw(com exe bat);
    }
}

sub which {