httpd-test-dev mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From Randy Kobes <ra...@theoryx5.uwinnipeg.ca>
Subject Re: need help to add per-user config to Apache::Test
Date Mon, 01 Sep 2003 04:22:10 GMT
[ trimmed mod_perl mailing list from cc ]

On Fri, 29 Aug 2003, Randy Kobes wrote:

> On Thu, 28 Aug 2003, Stas Bekman wrote:
>
> > Several people have asked for having a new feature in
> > Apache::Test: they want to configure it once (where the
> > server, apxs, etx are) and run Apache::Test without
> > needing to pass any arguments. Matt suggested that it
> > should remember the values passed the first time it's used
> > and then re-use them. However on a system with several
> > users and different preferences, this won't work.
> > Therefore we need to be able to support per-user
> > preferences. CPAN.pm's setup seems to provide a good
> > solution to the same problem (CPAN/Config.pm and
> > ~user/.cpan/CPAN/Config.pm). So I thought that someone
> > would like to port the functionality from CPAN.pm to
> > Apache::Test and send the patches here. It's all pure
> > perl, so you have no excuses that it's XS/C ;)
>
> I have a mostly functional version of this, save for
> the ability to use a $HOME/.apache-test/Config.pm, which
> shouldn't be too hard to add. I'll try to finish it
> off this weekend.

A stab at this follows ... It's rough, as I wanted to
make sure this was on the right track; basically, what's
supposed to happen is
- if a Apache::MyTestConfig is found, use the values for
apxs, httpd, user, group, and port stored in there. These
values get overridden if they appear as arguments to 'perl
Makefile.PL'.
- if no Apache::MyTestConfig is present, or a '-save'
option is passed to 'perl t/TEST', Apache::MyTestConfig
is created, and then installed.
- the location of Apache::MyTestConfig is, first of all,
under $HOME/.apache-test/, or if this is not present,
under the system @INC.

I'm not sure I'm putting the values of
Apache::MyTestConfig in the right, or best, place;
I haven't tested it extensively, as my linux box
is a live server.

=========================================================
Index: TestConfig.pm
===================================================================
RCS file: /home/cvs/httpd-test/perl-framework/Apache-Test/lib/Apache/TestConfig.pm,v
retrieving revision 1.171
diff -u -r1.171 TestConfig.pm
--- TestConfig.pm	13 Aug 2003 19:02:51 -0000	1.171
+++ TestConfig.pm	1 Sep 2003 03:51:13 -0000
@@ -3,6 +3,22 @@
 use strict;
 use warnings FATAL => 'all';

+require File::Spec;
+sub has_config {
+    my $has_config = 0;
+    if ($ENV{HOME}) {
+        eval
+            {require File::Spec->catfile($ENV{HOME},
+                                         '.apache-test', 'MyTestConfig.pm');};
+        $has_config = 1 unless $@;
+    }
+    unless ($has_config) {
+        eval {require Apache::MyTestConfig;};
+        $has_config = 1 unless $@;
+    }
+    return $has_config;
+}
+
 use constant WIN32   => $^O eq 'MSWin32';
 use constant CYGWIN  => $^O eq 'cygwin';
 use constant NETWARE => $^O eq 'NetWare';
@@ -24,8 +40,8 @@
 use File::Path ();
 use File::Spec::Functions qw(catfile abs2rel splitdir canonpath
                              catdir file_name_is_absolute);
-use Cwd qw(fastcwd);

+use Cwd qw(fastcwd);
 use Apache::TestConfigPerl ();
 use Apache::TestConfigParse ();
 use Apache::TestTrace;
@@ -34,6 +50,8 @@

 use vars qw(%Usage);

+use constant HAS_CONFIG => has_config();
+
 %Usage = (
    top_dir       => 'top-level directory (default is $PWD)',
    t_dir         => 'the t/ test directory (default is $top_dir/t)',
@@ -72,6 +90,12 @@

 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->{$_};
+        }
+    }
     my(@pass, %keep);

     my @filter = @$args;
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	1 Sep 2003 03:51:14 -0000
@@ -11,10 +11,14 @@
 use Apache::TestHarness ();
 use Apache::TestTrace;

+use constant HAS_CONFIG => Apache::TestConfig::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 +27,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 +59,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::MyTestConfig',
    (map { $_, "\U$_\E url" } @request_opts),
 );

@@ -614,6 +619,10 @@
     $self->run_tests;

     $self->stop;
+
+    $self->write_config() if
+        ($self->{opts}->{save} || not HAS_CONFIG);
+
 }

 my @oh = qw(jeez golly gosh darn shucks dangit rats nuts dangnabit crap);
@@ -915,6 +924,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, 'MyTestConfig.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::MyTestConfig;
+\$Apache::MyTestConfig = {
+$config_dump
+};
+1;
+
+=head1 NAME
+
+Apache::MyTestConfig - 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, 'MyTestConfig.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

Mime
View raw message