On Sat, Sep 15, 2001 at 02:04:13AM +0800, Stas Bekman wrote:
>
> 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
Fails for me with this :
directive/perlrequire....
1..2
Use of uninitialized value in concatenation (.) or string at directive/perlrequire.t
line 24.
dubious
Test returned status 2 (wstat 512, 0x200)
DIED. FAILED tests 1-2
Failed 2/2 tests, 0.00% okay
Failed Test Stat Wstat Total Fail Failed List of Failed
-------------------------------------------------------------------------------
directive/perlrequire.t 2 512 2 2 100.00% 1-2
server localhost.localdomain:8529 shutdown
[Sat Sep 15 14:41:21 2001] [info] removed PID file
/home/gozer/sources/mod_perl2/cvs/t/logs/httpd.pid (pid=16752)
[Sat Sep 15 14:41:21 2001] [notice] caught SIGTERM, shutting down
error running tests (please examine t/logs/error_log)
Failed 1/1 test scripts, 0.00% okay. 2/2 subtests failed, 0.00% okay.
And error_log doesn't say anything interesting ;(
>
> 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]
>
--
Philippe M. Chiasson <[EMAIL PROTECTED]>
Extropia's Resident System Guru
http://www.eXtropia.com/
The problem with the bottom line is that there's more than
one of it. Every spreadsheet has a different opinion.
-- Larry Wall
perl -e '$$=\${gozer};{$_=unpack(P26,pack(L,$$));/^Just Another Perl
Hacker!\n$/&&print||$$++&&redo}'
PGP signature
