view release on metacpan or  search on metacpan

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

    }

    # enable live testing of the Apache-Test dev modules if they are
    # located at the project's root dir
    my $apache_test_dev_dir = catfile($top, 'Apache-Test', 'lib');
    unshift @$inc, $apache_test_dev_dir if -d $apache_test_dev_dir;
}

sub write_pm_test {
    my($self, $module, $sub, @base) = @_;

    my $dir = catfile $self->{vars}->{t_dir}, @base;
    my $t = catfile $dir, "$sub.t";
    return if -e $t;

    $self->gendir($dir);
    my $fh = $self->genfile($t);

    my $path = Apache::TestRequest::module2path($module);

    print $fh <<EOF;
use Apache::TestRequest 'GET_BODY_ASSERT';
print GET_BODY_ASSERT "/$path";
EOF

    close $fh or die "close $t: $!";
}

# propogate PerlPassEnv settings to the server
sub configure_env {
    my $self = shift;
    $self->preamble(IfModule => 'mod_perl.c',
                    [ qw(PerlPassEnv APACHE_TEST_TRACE_LEVEL
                         PerlPassEnv HARNESS_PERL_SWITCHES
                         PerlPassEnv APACHE_TEST_NO_STICKY_PREFERENCES)
                    ]);
}

sub startup_pl_code {
    my $self = shift;
    my $serverroot = $self->{vars}->{serverroot};

    my $cover = <<'EOF';
    if (($ENV{HARNESS_PERL_SWITCHES}||'') =~ m/Devel::Cover/) {
        eval {
            # 0.48 is the first version of Devel::Cover that can
            # really generate mod_perl coverage statistics
            require Devel::Cover;
            Devel::Cover->VERSION(0.48);

            # this ignores coverage data for some generated files
            Devel::Cover->import('+inc' => 't/response/',);

            1;
        } or die "Devel::Cover error: $@";
    }
EOF

    return <<"EOF";
BEGIN {
    use lib '$serverroot';
    for my \$file (qw(modperl_inc.pl modperl_extra.pl)) {
        eval { require "conf/\$file" } or
            die if grep { -e "\$_/conf/\$file" } \@INC;
    }

$cover
}

1;
EOF
}

sub configure_startup_pl {
    my $self = shift;

    #for 2.0 we could just use PerlSwitches -Mlib=...
    #but this will work for both 2.0 and 1.xx
    if (my $inc = $self->{inc}) {
        my $include_pl = catfile $self->{vars}->{t_conf}, 'modperl_inc.pl';
        my $fh = $self->genfile($include_pl);
        for (reverse @$inc) {
            next unless $_;
            print $fh "use lib '$_';\n";
        }
        my $tlib = catdir $self->{vars}->{t_dir}, 'lib';
        if (-d $tlib) {
            print $fh "use lib '$tlib';\n";
        }

        # directory for temp packages which can change during testing
        # we use require here since a circular dependency exists
        # between Apache::TestUtil and Apache::TestConfigPerl, so
        # use does not work here
        eval { require Apache::TestUtil; };
        if ($@) {
            die "could not require Apache::TestUtil: $@";
        } else {
            print $fh "use lib '" . Apache::TestUtil::_temp_package_dir() . "';\n";
        }

        # if Apache::Test is used to develop a project, we want the
        # project/lib directory to be first in @INC (loaded last)
        if ($ENV{APACHE_TEST_LIVE_DEV}) {
            my $dev_lib = catdir $self->{vars}->{top_dir}, "lib";
            print $fh "use lib '$dev_lib';\n" if -d $dev_lib;
        }

        print $fh "1;\n";
    }

    if ($self->server->{rev} >= 2) {
        $self->postamble(IfModule => 'mod_perl.c',
                         "PerlSwitches -Mlib=$self->{vars}->{serverroot}\n");
    }

    my $startup_pl = catfile $self->{vars}->{t_conf}, 'modperl_startup.pl';

    unless (-e $startup_pl) {
        my $fh = $self->genfile($startup_pl);
        print $fh $self->startup_pl_code;
        close $fh;
    }

    $self->postamble(IfModule => 'mod_perl.c',
                     "PerlRequire $startup_pl\n");
}

my %sethandler_modperl = (1 => 'perl-script', 2 => 'modperl');

sub set_handler {
    my($self, $module, $args) = @_;
    return if grep { $_ eq 'SetHandler' } @$args;

    push @$args,
      SetHandler =>
        $self->server->version_of(\%sethandler_modperl);
}

sub set_connection_handler {
    my($self, $module, $args) = @_;
    my $port = $self->new_vhost($module);
    my $vars = $self->{vars};
    $self->postamble(Listen => '0.0.0.0:' . $port);
}

my %add_hook_config = (
    Response          => \&set_handler,
    ProcessConnection => \&set_connection_handler,
    PreConnection     => \&set_connection_handler,
);

my %container_config = (
    ProcessConnection => \&vhost_container,
    PreConnection     => \&vhost_container,
);

sub location_container {
    my($self, $module) = @_;
    my $path = Apache::TestRequest::module2path($module);
    Location => "/$path";
}

sub vhost_container {
    my($self, $module) = @_;
    my $port = $self->{vhosts}->{$module}->{port};