On Thu, 4 Sep 2003, Stas Bekman wrote:
> In the effort to remove some of the Win32 noise, I was
> thinking that we can write a generic function which gets a
> path as an argument and figures out internally if it needs
> to keep the argument as passed or mangle it. So it'll do
> something like:
>
> my $cwd = Apache::TestUtil::path(cwd);
>
> probably need a more intuitive name for this function.
That'd be nice - a version that does this appears below.
I named it win32_long_path - it'll just return what was
passed into it if not on Win32.
[ .. ]
> Just a sanity check, the env var overrides (.e.g. USER)
> come in later, right?
I checked that the environment variables Apache::Test
recognizes do override the settings in
Apache::TestConfigData, if they are set, and will be saved
to Apache::TestConfigData if -save is passed to t/TEST.
I think I got the indentation right this time. Also,
I've added in a bit of pod to describe this.
==============================================================
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 6 Sep 2003 15:40:09 -0000
@@ -10,20 +10,67 @@
use Apache::TestRequest ();
use Apache::TestHarness ();
use Apache::TestTrace;
+use Apache::TestUtil qw(win32_long_path);
+
+use Cwd;
+# Are we building things within Apache-Test?
+sub in_apache_test {
+ my $cwd = win32_long_path(cwd);
+ return ($cwd =~ m{Apache-Test}) ? 1 : 0;
+}
+use constant IN_APACHE_TEST => in_apache_test();
+
+require File::Spec;
+# routine to determine where the configuration file
+# Apache::TestConfigData lives. The order searched is
+# 1) a path within Apache-Test, if we are building things there
+# 2) an $ENV{HOME}/.apache-test/ directory;
+# 3) somewhere in @INC, other than a path within Apache-Test.
+sub config_data {
+ my $sys_config;
+ my $file = 'TestConfigData.pm';
+ for (@INC) {
+ my $candidate = File::Spec->catfile($_, 'Apache', $file);
+ if (-e $candidate) {
+ $sys_config = $candidate;
+ last;
+ }
+ }
+ if ($sys_config) {
+ eval {require $sys_config};
+ return $sys_config if (not $@ and IN_APACHE_TEST);
+ $sys_config = undef if $@;
+ }
+ # XXX $ENV{HOME} isn't propagated in mod_perl
+ if ($ENV{HOME}) {
+ my $priv_config = File::Spec->catfile($ENV{HOME},
+ '.apache-test',
+ $file);
+ eval {require $priv_config};
+ return $priv_config unless $@;
+ }
+ return $sys_config ? $sys_config : undef;
+}
+
+use constant CONFIG_DATA => config_data();
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 qw(dirname);
use Config;
use constant STARTUP_TIMEOUT => 300; # secs (good for extreme debug cases)
use subs qw(exit_shell exit_perl);
+die 'Could not find a suitable Apache::TestConfigData'
+ unless defined CONFIG_DATA;
+
my %core_files = ();
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 +102,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),
);
@@ -407,6 +455,8 @@
$test_config->cmodules_configure;
$test_config->generate_httpd_conf;
$test_config->save;
+ $self->write_config() if
+ (not %{$Apache::TestConfigData} or $self->{opts}->{save});
}
sub try_exit_opts {
@@ -509,6 +559,10 @@
sub new_test_config {
my $self = shift;
+ for (qw(httpd port user group apxs)) {
+ next unless $Apache::TestConfigData->{$_};
+ $self->{conf_opts}->{$_} ||= $Apache::TestConfigData->{$_};
+ }
Apache::TestConfig->new($self->{conf_opts});
}
@@ -917,6 +971,41 @@
CORE::exit $_[0];
}
+sub write_config {
+ my $self = shift;
+ my $fh = Symbol::gensym();
+ my $vars = $self->{test_config}->{vars};
+ my $conf_opts = $self->{conf_opts};
+ my $file = IN_APACHE_TEST ?
+ catfile($vars->{top_dir}, CONFIG_DATA) :
+ CONFIG_DATA;
+ die "Cannot open $file: $!" unless (open($fh, ">$file"));
+ warn "Writing $file.\n";
+ my $config_dump = '';
+ if ($self->{test_config}->{vars}->{httpd}) {
+ for (qw(group user apxs port httpd)) {
+ next unless my $var = $conf_opts->{$_} || $vars->{$_};
+ $config_dump .= qq{ '$_' => } . qq{'$var',\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;
+ return 1;
+}
+
1;
__END__
@@ -963,5 +1052,37 @@
Notice that the extension is I<.c>, and not I<.so>.
+=head1 Saving options
+
+When C<Apache::Test> is first installed, it will save the
+values of C<httpd>, C<port>, C<apxs>, C<user>, and C<group>,
+if set, to a configuration file C<Apache::TestConfigData>.
+This information will then be used in setting these options
+for subsequent uses.
+
+The values stored in C<Apache::TestConfigData> can be overriden
+temporarily either by setting the appropriate environment
+variable or by giving the relevant option when the C<TEST>
+script is run. If you want to save these options to
+C<Apache::TestConfigData>, use the C<-save> flag when
+running C<TEST>.
+
+If you are running C<Apache::Test> as a
+user who does not have permission to alter the system
+C<Apache::TestConfigData>, you can place your
+own private configuration file under C<$ENV{HOME}/.apache-test/>,
+which C<Apache::Test> will use, if present. An example
+of such a configuration file is
+
+ # file $ENV{HOME}/.apache-test/TestConfigData.pm
+ package Apache::TestConfigData;
+ $Apache::TestConfigData = {
+ 'group' => 'me',
+ 'user' => 'myself',
+ 'port' => '8529',
+ 'httpd' => '/usr/local/apache/bin/httpd',
+
+ };
+ 1;
=cut
Index: TestUtil.pm
===================================================================
RCS file:
/home/cvs/httpd-test/perl-framework/Apache-Test/lib/Apache/TestUtil.pm,v
retrieving revision 1.31
diff -u -r1.31 TestUtil.pm
--- TestUtil.pm 29 Apr 2003 08:04:04 -0000 1.31
+++ TestUtil.pm 6 Sep 2003 15:40:09 -0000
@@ -14,6 +14,8 @@
use Apache::Test ();
use Apache::TestConfig ();
+use constant WIN32 => Apache::TestConfig::WIN32;
+require Win32 if WIN32;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %CLEAN);
@@ -26,7 +28,8 @@
t_client_log_error_is_expected t_client_log_warn_is_expected
);
[EMAIL PROTECTED] = qw(t_write_perl_script t_write_shell_script t_chown);
[EMAIL PROTECTED] = qw(t_write_perl_script t_write_shell_script t_chown
+ win32_long_path win32_short_path);
%CLEAN = ();
@@ -302,6 +305,18 @@
t_debug("removing dir tree: $_");
t_rmtree($_);
}
+}
+
+# on Win32, returns the long path name, otherwise, does nothing
+sub win32_long_path {
+ my $file = shift;
+ return WIN32 ? Win32::GetLongPathName($file) : $file;
+}
+
+# on Win32, returns the short path name, otherwise, does nothing
+sub win32_short_path {
+ my $file = shift;
+ return WIN32 ? Win32::GetShortPathName($file) : $file;
}
1;
===================================================================
--
best regards,
randy