[ 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
