stas 2002/12/13 02:04:28
Modified: perl-framework/Apache-Test/lib/Apache TestConfigPerl.pm
Log:
This patch allows us to sort configuration sections in any order we want:
# a simple numerical order is performed and configuration sections are
# inserted using that order. If the test package specifies no special
# token that matches /APACHE_TEST_CONFIG_ORDER\s+([+-]?\d+)/ anywhere
# in the file, 0 is assigned as its order. If the token is specified,
# config section with negative values will be inserted first, with
# positive last. By using different values you can arrange for the
# test configuration sections to be inserted in any desired order
Revision Changes Path
1.58 +121 -66
httpd-test/perl-framework/Apache-Test/lib/Apache/TestConfigPerl.pm
Index: TestConfigPerl.pm
===================================================================
RCS file:
/home/cvs/httpd-test/perl-framework/Apache-Test/lib/Apache/TestConfigPerl.pm,v
retrieving revision 1.57
retrieving revision 1.58
diff -u -r1.57 -r1.58
--- TestConfigPerl.pm 13 Dec 2002 01:53:45 -0000 1.57
+++ TestConfigPerl.pm 13 Dec 2002 10:04:28 -0000 1.58
@@ -292,16 +292,12 @@
}
}
-sub configure_pm_tests {
- my $self = shift;
+# @status fields
+use constant APACHE_TEST_CONFIGURE => 0;
+use constant APACHE_TEST_CONFIG_ORDER => 1;
- # since server wasn't started yet, the modules in blib under
- # Apache2 can't be seen. So we must load Apache2.pm, without which
- # run_apache_test_config might fail to require modules
- require mod_perl;
- if ($mod_perl::VERSION > 1.99) {
- require Apache2;
- }
+sub configure_pm_tests_pick {
+ my($self, $entries) = @_;
for my $subdir (@extra_subdirs) {
my $dir = catfile $self->{vars}->{t_dir}, lc $subdir;
@@ -309,61 +305,100 @@
finddepth(sub {
return unless /\.pm$/;
- my @args = ();
- my $pm = $_;
- my $file = catfile $File::Find::dir, $pm;
- my $directives = $self->add_module_config($file, [EMAIL
PROTECTED]);
+ my $file = catfile $File::Find::dir, $_;
my $module = abs2rel $file, $dir;
- $module =~ s,\.pm$,,;
- $module =~ s/^[a-z]://i; #strip drive if any
- $module = join '::', splitdir $module;
+ my $status = $self->run_apache_test_config_scan($file);
+ push @$entries, [$file, $module, $subdir, $status];
+ }, $dir);
+ }
+}
- $self->run_apache_test_config($file, $module);
- my($base, $sub) =
- map { s/^test//i; $_ } split '::', $module;
+# a simple numerical order is performed and configuration sections are
+# inserted using that order. If the test package specifies no special
+# token that matches /APACHE_TEST_CONFIG_ORDER\s+([+-]?\d+)/ anywhere
+# in the file, 0 is assigned as its order. If the token is specified,
+# config section with negative values will be inserted first, with
+# positive last. By using different values you can arrange for the
+# test configuration sections to be inserted in any desired order
+sub configure_pm_tests_sort {
+ my($self, $entries) = @_;
+
+ @$entries = sort {
+ $a->[3]->[APACHE_TEST_CONFIG_ORDER] <=>
+ $b->[3]->[APACHE_TEST_CONFIG_ORDER]
+ } @$entries;
- my $hook = ($subdir eq 'Hooks' ? $hooks{$sub} : '')
- || $hooks{$subdir} || $subdir;
+}
- if ($hook eq 'OutputFilter' and $pm =~ /^i/) {
- #XXX: tmp hack
- $hook = 'InputFilter';
- }
+sub configure_pm_tests {
+ my $self = shift;
- my $handler = join $hook, qw(Perl Handler);
+ # since server wasn't started yet, the modules in blib under
+ # Apache2 can't be seen. So we must load Apache2.pm, without which
+ # run_apache_test_config might fail to require modules
+ require mod_perl;
+ if ($mod_perl::VERSION > 1.99) {
+ require Apache2;
+ }
- if ($self->server->{rev} < 2 and lc($hook) eq 'response') {
- $handler =~ s/response//i;
#s/PerlResponseHandler/PerlHandler/
- }
+ my @entries = ();
+ $self->configure_pm_tests_pick([EMAIL PROTECTED]);
+ $self->configure_pm_tests_sort([EMAIL PROTECTED]);
+
+ for my $entry (@entries) {
+ my ($file, $module, $subdir, $status) = @$entry;
+ my @args = ();
+
+ my $directives = $self->add_module_config($file, [EMAIL PROTECTED]);
+ $module =~ s,\.pm$,,;
+ $module =~ s/^[a-z]://i; #strip drive if any
+ $module = join '::', splitdir $module;
+
+ $self->run_apache_test_configure($file, $module, $status);
+
+ my($base, $sub) =
+ map { s/^test//i; $_ } split '::', $module;
+
+ my $hook = ($subdir eq 'Hooks' ? $hooks{$sub} : '')
+ || $hooks{$subdir} || $subdir;
+
+ if ($hook eq 'OutputFilter' and $module =~ /::i\w+$/) {
+ #XXX: tmp hack
+ $hook = 'InputFilter';
+ }
- debug "configuring $module";
+ my $handler = join $hook, qw(Perl Handler);
- if (my $cv = $add_hook_config{$hook}) {
- $self->$cv($module, [EMAIL PROTECTED]);
- }
+ if ($self->server->{rev} < 2 and lc($hook) eq 'response') {
+ $handler =~ s/response//i; #s/PerlResponseHandler/PerlHandler/
+ }
- my $container = $container_config{$hook} || \&location_container;
+ debug "configuring $module";
- #unless the .pm test already configured the Perl*Handler
- unless ($directives->{$handler}) {
- my @handler_cfg = ($handler => $module);
-
- if ($outside_container{$handler}) {
- $self->postamble(@handler_cfg);
- }
- else {
- push @args, @handler_cfg;
- }
+ if (my $cv = $add_hook_config{$hook}) {
+ $self->$cv($module, [EMAIL PROTECTED]);
+ }
+
+ my $container = $container_config{$hook} || \&location_container;
+
+ #unless the .pm test already configured the Perl*Handler
+ unless ($directives->{$handler}) {
+ my @handler_cfg = ($handler => $module);
+
+ if ($outside_container{$handler}) {
+ $self->postamble(@handler_cfg);
+ } else {
+ push @args, @handler_cfg;
}
+ }
- my $args_hash = list_to_hash_of_lists([EMAIL PROTECTED]);
- $self->postamble($self->$container($module),
- $args_hash) if @args;
+ my $args_hash = list_to_hash_of_lists([EMAIL PROTECTED]);
+ $self->postamble($self->$container($module),
+ $args_hash) if @args;
- $self->write_pm_test($module, lc $base, lc $sub);
- }, $dir);
+ $self->write_pm_test($module, lc $base, lc $sub);
}
}
@@ -382,33 +417,53 @@
return \%hash;
}
-# 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.
-sub run_apache_test_config {
- my ($self, $file, $module) = @_;
- local $/;
+# scan tests for interesting information
+sub run_apache_test_config_scan {
+ my ($self, $file) = @_;
+
+ my @status = ();
+ $status[APACHE_TEST_CONFIGURE] = 0;
+ $status[APACHE_TEST_CONFIG_ORDER] = 0;
+
my $fh = Symbol::gensym();
if (open $fh, $file) {
+ local $/;
my $content = <$fh>;
close $fh;
+ # XXX: optimize to match once?
if ($content =~ /APACHE_TEST_CONFIGURE/m) {
- eval { require $file };
- warn $@ if $@;
- # double check that it's a real sub
- if ($module->can('APACHE_TEST_CONFIGURE')) {
- eval { $module->APACHE_TEST_CONFIGURE($self); };
- warn $@ if $@;
- }
+ $status[APACHE_TEST_CONFIGURE] = 1;
+ }
+ if ($content =~ /APACHE_TEST_CONFIG_ORDER\s+([+-]?\d+)/m) {
+ $status[APACHE_TEST_CONFIG_ORDER] = int $1;
}
}
else {
error "cannot open $file: $!";
+ }
+
+ return [EMAIL PROTECTED];
+}
+
+# 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.
+sub run_apache_test_configure {
+ my ($self, $file, $module, $status) = @_;
+
+ return unless $status->[APACHE_TEST_CONFIGURE];
+
+ eval { require $file };
+ warn $@ if $@;
+ # double check that it's a real sub
+ if ($module->can('APACHE_TEST_CONFIGURE')) {
+ eval { $module->APACHE_TEST_CONFIGURE($self); };
+ warn $@ if $@;
}
}
