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