httpd-test-dev mailing list archives

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