Mailing-List: contact test-dev-help@httpd.apache.org; run by ezmlm
Precedence: bulk
Reply-To: test-dev@httpd.apache.org
Date: Sat, 6 Sep 2003 10:46:47 -0500 (CDT)
From: Randy Kobes <randy@theoryx5.uwinnipeg.ca>
To: test-dev@httpd.apache.org
Subject: Re: need help to add per-user config to Apache::Test
In-Reply-To: <3F57F187.9050906@stason.org>
Message-ID: <Pine.LNX.4.56.0309061041190.27917@theoryx5.uwinnipeg.ca>
References: <3F4DBAF5.1000007@stason.org>
 <Pine.LNX.4.56.0308290211320.25410@theoryx5.uwinnipeg.ca>
 <Pine.LNX.4.56.0308312303500.4626@theoryx5.uwinnipeg.ca>
 <3F54FE10.80906@stason.org>
 <Pine.LNX.4.56.0309021734270.32396@theoryx5.uwinnipeg.ca>
 <3F554304.2050501@stason.org>
 <Pine.LNX.4.56.0309030959270.22055@theoryx5.uwinnipeg.ca>
 <3F562A41.3080606@stason.org>
 <Pine.LNX.4.56.0309041554300.20568@theoryx5.uwinnipeg.ca>
 <3F57F187.9050906@stason.org>
MIME-Version: 1.0
Content-Type: TEXT/PLAIN; charset=US-ASCII

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
 );

-@EXPORT_OK = qw(t_write_perl_script t_write_shell_script t_chown);
+@EXPORT_OK = 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