On Tue, 2 Sep 2003, Stas Bekman wrote:
> Randy Kobes wrote:
[ ... ]
> > sub filter_args {
> > my($args, $wanted_args) = @_;
> > + if (HAS_CONFIG) {
> > + for (qw(group user apxs port httpd)) {
> > + next unless defined $Apache::MyTestConfig->{$_};
> > + unshift @$args, "-$_", $Apache::MyTestConfig->{$_};
> > + }
> > + }
>
> may be it's better to do it at a later stage? this just
> used to generate t/TEST and similar scripts. If MyConfig
> has changed since t/TEST was generated the changes won't
> affect t/TEST.
[ .. ]
Thanks, Stas. You're right about the problems with $HOME,
and I'll take a more careful look at it, as well as your
other comments. In the meantime, here's something that
inserts the data at a later stage, and yet still can get
overridden by explicit arguments to t/TEST. In this
attempt, all the changes are made to Apache::TestRun.pm.
===========================================================
Index: TestRun.pm
===================================================================
RCS file:
/home/cvs/httpd-test/perl-framework/Apache-Test/lib/Apache/TestRun.pm,v
retrieving revision 1.113
diff -u -r1.113 TestRun.pm
--- TestRun.pm 22 Jul 2003 11:21:36 -0000 1.113
+++ TestRun.pm 2 Sep 2003 22:31:40 -0000
@@ -11,10 +11,31 @@
use Apache::TestHarness ();
use Apache::TestTrace;
+require File::Spec;
+sub has_config {
+ my $has_config = 0;
+ # XXX $HOME isn't propagated in mod_perl
+ if ($ENV{HOME}) {
+ eval
+ {require File::Spec->catfile($ENV{HOME},
+ '.apache-test',
+ 'TestConfigData.pm');};
+ $has_config = 1 unless $@;
+ }
+ unless ($has_config) {
+ eval {require Apache::TestConfigData;};
+ $has_config = 1 unless $@;
+ }
+ return $has_config;
+}
+use constant HAS_CONFIG => has_config();
+
use File::Find qw(finddepth);
-use File::Spec::Functions qw(catfile);
+use File::Spec::Functions qw(catfile catdir);
use Getopt::Long qw(GetOptions);
+use File::Basename;
use Config;
+use Symbol qw(gensym);
use constant STARTUP_TIMEOUT => 300; # secs (good for extreme debug cases)
use subs qw(exit_shell exit_perl);
@@ -23,7 +44,7 @@
my %original_t_perms = ();
my @std_run = qw(start-httpd run-tests stop-httpd);
-my @others = qw(verbose configure clean help ssl http11);
+my @others = qw(verbose configure clean help ssl http11 save);
my @flag_opts = (@std_run, @others);
my @string_opts = qw(order trace);
my @ostring_opts = qw(proxy ping);
@@ -55,6 +76,7 @@
'ssl' => 'run tests through ssl',
'proxy' => 'proxy requests (default proxy is localhost)',
'trace=T' => 'change tracing default to: warning, notice, info,
debug, ...',
+ 'save' => 'save test paramaters into Apache::TestConfigData',
(map { $_, "\U$_\E url" } @request_opts),
);
@@ -509,6 +531,12 @@
sub new_test_config {
my $self = shift;
+ if (HAS_CONFIG) {
+ for (qw(httpd port user group apxs)) {
+ next unless $Apache::TestConfigData->{$_};
+ $self->{conf_opts}->{$_} ||= $Apache::TestConfigData->{$_};
+ }
+ }
Apache::TestConfig->new($self->{conf_opts});
}
@@ -614,6 +642,10 @@
$self->run_tests;
$self->stop;
+
+ $self->write_config() if
+ ($self->{opts}->{save} or not HAS_CONFIG);
+
}
my @oh = qw(jeez golly gosh darn shucks dangit rats nuts dangnabit crap);
@@ -915,6 +947,75 @@
# require Carp;
# Carp::cluck('exiting');
CORE::exit $_[0];
+}
+
+sub write_config {
+ my $self = shift;
+ my $dir;
+ for (@INC) {
+ my $candidate = catfile($_, 'Apache', 'Test.pm');
+ if (-e $candidate) {
+ $dir = dirname($candidate);
+ last;
+ }
+ }
+ unless (-w $dir) {
+ $dir = catdir($ENV{HOME}, '.apache-test');
+ unless (-d $dir) {
+ mkdir $dir or do {
+ warn "Cannot mkdir $dir: $!";
+ return;
+ };
+ }
+ }
+
+ my $fh = Symbol::gensym();
+ my $file = catfile($dir, 'TestConfigData.pm');
+ unless (open($fh, ">$file")) {
+ warn "Cannot open $file: $!";
+ return;
+ }
+ warn "Writing $file ....\n";
+ my $vars = $self->{test_config}->{vars};
+ my $config_dump;
+ for (qw(group user apxs port httpd)) {
+ next unless $vars->{$_};
+ $config_dump .= qq{ '$_' => } . qq{'$vars->{$_}',\n};
+ }
+
+ my $pkg = << "EOC";
+package Apache::TestConfigData;
+\$Apache::TestConfigData = {
+$config_dump
+};
+1;
+
+=head1 NAME
+
+Apache::TestConfigData - Configuration file for Apache::Test
+
+=cut
+EOC
+ print $fh $pkg;
+ close $fh;
+ my $test = catdir($vars->{top_dir}, 'blib/lib/Apache');
+ if (-e catfile($test, 'Test.pm')) {
+ my $fh = Symbol::gensym();
+ my $file = catfile($test, 'TestConfigData.pm');
+ if (-e $file) {
+ unlink $file or do {
+ warn "Cannot unlink $file: $!";
+ return;
+ }
+ }
+ unless (open($fh, ">$file")) {
+ warn "Cannot open $file: $!";
+ return;
+ }
+ print $fh $pkg;
+ close $fh;
+ }
+ return 1;
}
1;
===================================================================
--
best regards,
randy
