OK, here is the patch that:
- adds the writefile sub to genfile+throw content in
- adds a scan for APACHE_TEST_CONFIGURE and its execution
- implements the PerlRequire test
the ugly parts:
- I wish PerlSwitches were working with +Parent, so I didn't have to do
the ugly hack with adding yet another PerlRequire
- +Parent, doesn't worry to load the test INCs so every test has to do it
manually, would be nice to do it in-core
- +Parent doesn't clean @INC from the main interpreter, run the test:
./t/TEST -v directive/perlrequire
and check the error_log -- you will see that VH includes the INC path
defined in the main interpreter. I'm talking about:
/home/stas/apache.org/registry/t/htdocs/testdirectives/main
generated by:
+PerlSwitches -Mlib=@documentroot@/testdirectives/main
Index: Apache-Test/lib/Apache/TestConfig.pm
===================================================================
RCS file: /home/cvs/httpd-test/perl-framework/Apache-Test/lib/Apache/TestConfig.pm,v
retrieving revision 1.58
diff -u -r1.58 TestConfig.pm
--- Apache-Test/lib/Apache/TestConfig.pm 2001/09/09 18:27:39 1.58
+++ Apache-Test/lib/Apache/TestConfig.pm 2001/09/14 17:59:17
@@ -552,6 +552,29 @@
return $fh;
}
+# gen + write file
+sub writefile{
+
+ my($self, $file, $content, $warn) = @_;
+
+ my $name = abs2rel $file, $self->{vars}->{t_dir};
+ $self->trace("generating $name");
+
+ open my $fh, '>', $file or die "open $file: $!";
+
+ if (my $msg = $self->genwarning($warn)) {
+ print $fh $msg, "\n";
+ }
+
+ if ($content) {
+ print $fh $content;
+ }
+
+ $self->{clean}->{files}->{$file} = 1;
+
+ close $fh;
+}
+
sub cpfile {
my($self, $from, $to) = @_;
File::Copy::copy($from, $to);
Index: Apache-Test/lib/Apache/TestConfigPerl.pm
===================================================================
RCS file:
/home/cvs/httpd-test/perl-framework/Apache-Test/lib/Apache/TestConfigPerl.pm,v
retrieving revision 1.22
diff -u -r1.22 TestConfigPerl.pm
--- Apache-Test/lib/Apache/TestConfigPerl.pm 2001/09/06 05:16:25 1.22
+++ Apache-Test/lib/Apache/TestConfigPerl.pm 2001/09/14 17:59:17
@@ -245,11 +245,36 @@
my @args;
my $pm = $_;
- my $module = catfile $File::Find::dir, $pm;
- $self->add_module_config($module, \@args);
- $module = abs2rel $module, $dir;
+ my $file = catfile $File::Find::dir, $pm;
+ $self->add_module_config($file, \@args);
+ my $module = abs2rel $file, $dir;
$module =~ s,\.pm$,,;
$module = join '::', splitdir $module;
+
+ # We have to test whether tests have
+ # APACHE_TEST_CONFIGURE() in them and run it if found at
+ # this stage, so when the server starts everything is
+ # ready.
+ # XXX: however we cannot use a simple require() because
+ # some tests won't require() outside of mod_perl
+ # environment. Therefore we scan the slurped file in. and
+ # if APACHE_TEST_CONFIGURE has been found we require the
+ # file and run this function.
+
+ {
+ local $/;
+ open my $fh, $file or die "cannot open $file: $!";
+ my $content = <$fh>;
+ close $fh;
+ if ($content =~ /APACHE_TEST_CONFIGURE/m) {
+ require $file;
+ # double check that it's a real sub
+ if ($module->can('APACHE_TEST_CONFIGURE')) {
+ eval { $module->APACHE_TEST_CONFIGURE(); };
+ warn $@ if $@;
+ }
+ }
+ }
my($base, $sub) =
map { s/^test//i; $_ } split '::', $module;
--- /dev/null Thu Jan 1 07:30:00 1970
+++ t/directive/perlrequire.t Sat Sep 15 01:47:11 2001
@@ -0,0 +1,32 @@
+# this test tests PerlRequire configuration directive
+########################################################################
+
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test;
+use Apache::TestUtil;
+use Apache::TestRequest ();
+
+my %checks =
+ (
+ 'default' => 'Loaded by Parent',
+ 'TestDirective::perlrequire' => 'Loaded by Virtual Host',
+ );
+
+plan tests => scalar keys %checks;
+
+for my $module (sort keys %checks) {
+ Apache::TestRequest::module($module);
+
+ my $config = Apache::Test::config();
+ my $hostport = Apache::TestRequest::hostport($config);
+ print "connecting to $hostport\n";
+
+ my $res =
+ ok t_cmp(
+ $checks{$module},
+ $config->http_raw_get("/TestDirective::perlrequire",undef),
+ "testing PerlRequire in $module",
+ );
+}
--- /dev/null Thu Jan 1 07:30:00 1970
+++ t/response/TestDirective/perlrequire.pm Sat Sep 15 01:55:38 2001
@@ -0,0 +1,90 @@
+package TestDirective::perlrequire;
+
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test ();
+use Apache::TestUtil;
+use Apache::Const -compile => 'OK';
+use File::Spec::Functions;
+
+sub handler {
+ my $r = shift;
+
+ $r->content_type('text/plain');
+ $r->puts($My::PerlRequireTest::MAGIC || '');
+
+ # XXX: debug printing. @INC is inherited when it shouldn't!
+ my $oldfh = select(STDERR); $| = 1; select($oldfh);
+ print STDERR join "\n", @INC, "\n";
+
+ Apache::OK;
+}
+
+sub APACHE_TEST_CONFIGURE{
+
+ my $vars = Apache::Test::vars();
+ my $cfg = Apache::Test::config();
+
+ my $main_mod = << 'EOF';
+package My::PerlRequireTest;
+$My::PerlRequireTest::MAGIC = 'Loaded by Parent';
+1;
+EOF
+
+ my $vh_mod = << 'EOF';
+package My::PerlRequireTest;
+$My::PerlRequireTest::MAGIC = 'Loaded by Virtual Host';
+1;
+EOF
+
+ my $docroot = $vars->{documentroot};
+
+ my $vh_inc = << "EOF";
+use lib qw($docroot/testdirectives/vh);
+1;
+EOF
+
+ # prepare dirs
+ my $target = catfile $vars->{documentroot}, 'testdirectives';
+ my $main_dir = catfile $target, "main";
+ my $vh_dir = catfile $target, "vh";
+
+ $cfg->gendir($target);
+ $cfg->gendir($main_dir);
+ $cfg->gendir($vh_dir);
+
+ # write the modules
+ my $main_file = catfile $main_dir, "PerlRequireTest.pm";
+ my $vh_file = catfile $vh_dir, "PerlRequireTest.pm";
+ my $vh_inc_file = catfile $vh_dir, "perlrequire_inc.pl";
+
+ $cfg->writefile($main_file, $main_mod, 1);
+ $cfg->writefile($vh_file, $vh_mod, 1);
+ $cfg->writefile($vh_inc_file, $vh_inc, 1);
+}
+
+1;
+__END__
+PerlSwitches -Mlib=@documentroot@/testdirectives/main
+PerlRequire "PerlRequireTest.pm"
+
+<VirtualHost TestDirective::perlrequire>
+
+ PerlOptions +Parent
+ # PerlSwitches -Mlib=@documentroot@/testdirectives/vh
+ # instead of switches need to create .pl with
+ # use lib qw(testdirectives/vh); and perlrequire it
+ # the best is to use <Perl> section when these will be available
+
+ # avoid: Can't locate TestHooks/trans.pm problem
+ PerlRequire "conf/modperl_startup.pl"
+ # XXX: somehow @documentroot@/testdirectives/main is staying in @INC!!!
+ PerlRequire "@documentroot@/testdirectives/vh/perlrequire_inc.pl"
+ PerlRequire "PerlRequireTest.pm"
+
+ <Location /TestDirective::perlrequire>
+ SetHandler modperl
+ PerlResponseHandler TestDirective::perlrequire
+ </Location>
+</VirtualHost>
_____________________________________________________________________
Stas Bekman JAm_pH -- Just Another mod_perl Hacker
http://stason.org/ mod_perl Guide http://perl.apache.org/guide
mailto:[EMAIL PROTECTED] http://apachetoday.com http://eXtropia.com/
http://singlesheaven.com http://perl.apache.org http://perlmonth.com/
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
