Re: Patch for easy testing of Apache::* modules (resend)
On Tue, 10 Oct 2000, Ken Williams wrote:
> [EMAIL PROTECTED] (Doug MacEachern) wrote:
> >ken, i have a feature request too :) i would like to be able to test if
> >mod_include is linked static with httpd, otherwise Makefile.PL will
> >disable PERL_SSI. a hash of parsed `httpd -l`, something like:
> >
> >my $static_modules = Apache::test->http_static_modules;
> >
> >if ($static_modules->{mod_include}) {
> >...
> >}
>
> Okey dokey Doug, here's a patch. I cleaned up _read_existing_conf()
> too because it was pretty hard to understand.
applied, thanks ken!
Re: Patch for easy testing of Apache::* modules (resend)
[EMAIL PROTECTED] (Doug MacEachern) wrote:
>ken, i have a feature request too :) i would like to be able to test if
>mod_include is linked static with httpd, otherwise Makefile.PL will
>disable PERL_SSI. a hash of parsed `httpd -l`, something like:
>
>my $static_modules = Apache::test->http_static_modules;
>
>if ($static_modules->{mod_include}) {
>...
>}
Okey dokey Doug, here's a patch. I cleaned up _read_existing_conf()
too because it was pretty hard to understand.
===
RCS file: /home/cvspublic/modperl/lib/Apache/test.pm,v
retrieving revision 1.19
diff -u -r1.19 test.pm
--- test.pm 2000/10/02 21:06:19 1.19
+++ test.pm 2000/10/10 06:47:00
@@ -138,13 +138,12 @@
}
sub _read_existing_conf {
-# Returns some config text
-shift;
-my ($server_conf) = @_;
+# Returns some "(Add|Load)Module" config lines, generated from the
+# existing config file and a few must-have modules.
+my ($self, $server_conf) = @_;
-
open SERVER_CONF, $server_conf or die "Couldn't open $server_conf: $!";
-my @lines = grep {!m/^\s*#/} ;
+my @lines = grep {!m/^\s*\#/} ;
close SERVER_CONF;
my @modules = grep /^\s*(Add|Load)Module/, @lines;
@@ -154,41 +153,47 @@
foreach (@modules) {
s!(\s)([^/\s]\S+/)!$1$server_root/$2!;
}
-
-# Directories where apache DSOs live.
-my (@module_dirs) = map {m,(/\S*/),} @modules;
-
-# Have to make sure that dir, autoindex and perl are loaded.
-my @required = qw(dir autoindex perl);
-my @l = `t/httpd -l`;
-my @compiled_in = map /^\s*(\S+)/, @l[1..@l-2];
+my $static_mods = $self->static_modules('t/httpd');
my @load;
-foreach my $module (@required) {
- if (!grep /$module/i, @compiled_in, @modules) {
+# Have to make sure that dir, autoindex and perl are loaded.
+foreach my $module (qw(dir autoindex perl)) {
+ unless ($static_mods->{"mod_$module"} or grep /$module/i, @modules) {
+ warn "Will attempt to load mod_$module dynamically.\n";
push @load, $module;
}
}
+# Directories where apache DSOs live.
+my @module_dirs = map {m,(/\S*/),} @modules;
+
# Finally compute the directives to load modules that need to be loaded.
MODULE:
foreach my $module (@load) {
foreach my $module_dir (@module_dirs) {
- if (-e "$module_dir/mod_$module.so") {
- push @modules, "LoadModule ${module}_module
$module_dir/mod_$module.so\n"; next MODULE;
- } elsif (-e "$module_dir/lib$module.so") {
- push @modules, "LoadModule ${module}_module
$module_dir/lib$module.so\n"; next MODULE;
- } elsif (-e "$module_dir/ApacheModule\u$module.dll") {
- push @modules, "LoadModule ${module}_module
$module_dir/ApacheModule\u$module.dll\n"; next
MODULE;
+ foreach my $filename ("mod_$module.so", "lib$module.so",
+"ApacheModule\u$module.dll") {
+ if (-e "$module_dir/$filename") {
+ push @modules, "LoadModule ${module}_module
+$module_dir/$filename\n"; next MODULE;
+ }
}
}
+ warn "Warning: couldn't find anything to load for 'mod_$module'.\n";
}
-
-print "found the following modules: \n@modules";
+
+print "Adding the following dynamic config lines: \n@modules";
return join '', @modules;
}
+sub static_modules {
+# Returns a hashref whose keys are each of the modules compiled
+# statically into the given httpd binary.
+my ($self, $httpd) = @_;
+
+my @l = `$httpd -l`;
+return {map {lc($_) => 1} map /(\S+)\.c/, @l};
+}
+
# Find an executable in the PATH.
sub which {
foreach (map { "$_/$_[0]" } split /:/, $ENV{PATH}) {
@@ -628,6 +633,14 @@
response. In a list context, fetch() returns the content and the
HTTP::Response object itself. This can be handy if you need to check
the response headers, or the HTTP return code, or whatever.
+
+=head2 static_modules
+
+ Example: $mods = Apache::test->static_modules('/path/to/httpd');
+
+This method returns a hashref whose keys are all the modules
+statically compiled into the given httpd binary. The corresponding
+values are all 1.
=head1 EXAMPLES
===
------
Ken Williams Last Bastion of Euclidity
[EMAIL PROTECTED]The Math Forum
Re: Patch for easy testing of Apache::* modules (resend)
On Mon, 2 Oct 2000, Ken Williams wrote:
ken, i have a feature request too :) i would like to be able to test if
mod_include is linked static with httpd, otherwise Makefile.PL will
disable PERL_SSI. a hash of parsed `httpd -l`, something like:
my $static_modules = Apache::test->http_static_modules;
if ($static_modules->{mod_include}) {
...
}
thanks!
Re: Patch for easy testing of Apache::* modules (resend)
On Mon, 2 Oct 2000, Ken Williams wrote:
> In looking over the changes, I found that I've done a little more work
> since the last patch I sent. I didn't send it on because I wasn't sure
> whether the first patch would be accepted or not. Anyway, I beefed up
> the fetch() method and documented it. It's fully backward compatible,
> so no changes are necessary to existing code that calls fetch(). I also
> added/fixed tiny pieces in my previous work here and there.
thanks ken, i applied this patch, but it broke modules/cgi 3-4,7, because
it calls fetch() in an array context. i applied the bandaid below to get
by for now. maybe it would be better for your more robust version of
fetch() to be called get(), and the old fetch() becomes a wrapper around
that?
Index: lib/Apache/test.pm
===
RCS file: /home/cvs/modperl/lib/Apache/test.pm,v
retrieving revision 1.18
diff -u -r1.18 test.pm
--- lib/Apache/test.pm 2000/10/02 20:25:13 1.18
+++ lib/Apache/test.pm 2000/10/02 21:05:29
@@ -210,7 +210,8 @@
sub fetch {
# Old code calls fetch() as a function, new code as a method
-shift() if UNIVERSAL::isa($_[0], __PACKAGE__);
+my $want_response;
+$want_response = shift() if UNIVERSAL::isa($_[0], __PACKAGE__);
my ($ua, $url) = (@_ == 1 ? ($UA, shift()) : @_);
my $request = ref $url ? $url : {uri=>$url};
@@ -228,7 +229,7 @@
my $req = new HTTP::Request(@{$request}{'method','uri','headers','content'});
my $response = $ua->request($req);
-return wantarray ? ($response->content, $response) : $response->content;
+return $want_response ? $response : $response->content;
}
sub simple_fetch {
Re: Patch for easy testing of Apache::* modules (resend)
[EMAIL PROTECTED] (Doug MacEachern) wrote:
>On Mon, 17 Jul 2000, Ken Williams wrote:
>
>> Hi all,
>>
>> Here's a resend of the Apache::test patch that I sent yesterday, this
>> time sent as type text/plain from a Unix mailer. Rick Myers noted
>> that the version I sent before was encoded with Macintosh BinHex,
>> which is probably not the most appropriate choice for this list. ;-)
>
>looks great ken, applied, thanks!
>btw, when i first skimmed the patch, i thought it modified the
>mod_perl Makefile.PL test foo, which is why i was holding off.
In looking over the changes, I found that I've done a little more work
since the last patch I sent. I didn't send it on because I wasn't sure
whether the first patch would be accepted or not. Anyway, I beefed up
the fetch() method and documented it. It's fully backward compatible,
so no changes are necessary to existing code that calls fetch(). I also
added/fixed tiny pieces in my previous work here and there.
===
RCS file: /home/cvspublic/modperl/lib/Apache/test.pm,v
retrieving revision 1.17
diff -u -r1.17 test.pm
--- lib/Apache/test.pm 2000/09/28 21:16:13 1.17
+++ lib/Apache/test.pm 2000/10/02 05:38:43
@@ -57,7 +57,7 @@
User $args{user}
Group $args{group}
ServerName localhost
-DocumentRoot $DIR/t/eg
+DocumentRoot $DIR/t
$args{modules}
@@ -73,7 +73,10 @@
AddType text/html .html
# Look in ./blib/lib
-PerlModule ExtUtils::testlib
+#PerlModule ExtUtils::testlib
+
+ use lib "$DIR/blib/lib", "$DIR/t/lib";
+
$args{include}
EOF
@@ -82,6 +85,7 @@
}
sub _ask {
+# Just a function for asking the user questions
my ($prompt, $default, $mustfind) = @_;
my $response;
@@ -193,8 +197,8 @@
}
}
-
sub test {
+shift() if UNIVERSAL::isa($_[0], __PACKAGE__);
my $s = $_[1] ? "ok $_[0]\n" : "not ok $_[0]\n";
if($ENV{MOD_PERL}) {
Apache->request->print($s);
@@ -205,21 +209,26 @@
}
sub fetch {
-my($ua, $url);
-if(@_ == 1) {
- $url = shift;
- $ua = $UA;
-}
-else {
- ($ua, $url) = @_;
-}
-unless ($url =~ /^http/) {
- $url = "http://$net::httpserver${url}";
-}
+# Old code calls fetch() as a function, new code as a method
+shift() if UNIVERSAL::isa($_[0], __PACKAGE__);
+my ($ua, $url) = (@_ == 1 ? ($UA, shift()) : @_);
+my $request = ref $url ? $url : {uri=>$url};
+
+# Set some defaults
+$ENV{PORT} ||= 8529; # For mod_perl's own tests
+$request->{method} ||= 'GET';
+$request->{content} = '' unless exists $request->{content};
+$request->{uri} = "http://localhost:$ENV{PORT}$request->{uri}"
+ unless $request->{uri} =~ /^http/;
+$request->{headers}{Content_Type} = 'application/x-www-form-urlencoded'
+ if (!$request->{headers} and $request->{method} eq 'POST'); # Is this
+necessary?
+
+# Create & send the request
+$request->{headers} = new HTTP::Headers(%{$request->{headers}||{}});
+my $req = new HTTP::Request(@{$request}{'method','uri','headers','content'});
+my $response = $ua->request($req);
-my $request = new HTTP::Request('GET', $url);
-my $response = $ua->request($request, undef, undef);
-$response->content;
+return wantarray ? ($response->content, $response) : $response->content;
}
sub simple_fetch {
@@ -340,6 +349,7 @@
}
sub MM_test {
+# Writes the test section for the Makefile
shift(); # Don't need package name
my %conf = @_;
@@ -569,9 +579,58 @@
*MY::test = sub { Apache::test->MM_test(%params) };
+=head2 fetch
+
+ Apache::test->fetch($request);
+ Apache::test->fetch($user_agent, $request);
+
+Call this method in a test script in order to fetch a page from the
+running web server. If you pass two arguments, the first should be an
+LWP::UserAgent object, and the second should specify the request to
+make of the server. If you only pass one argument, it specifies the
+request to make.
+
+The request can be specified either by a simple string indicating the
+URI to fetch, or by a hash reference, which gives you more control
+over the request. The following keys are recognized in the hash:
+
+=over 4
+
+=item * uri
+
+The URI to fetch from the server. If the URI does not begin with
+"http", we prepend "http://localhost:$PORT" so that we make requests
+of the test server.
+
+=item * method
+
+The request method to use. Default is 'GET'.
+
+=item * content
+
+The request content body. Typically used to simulate HTML fill-out
+form submission for POST requests. Default is null.
+
+=item * headers
+
+A hash of headers you want sent with the request. You might use this
+to send cookies or provide some application-specific header.
+
+=back
+
+If you don't provide a 'headers' parameter and you set the 'method'
+to 'POST', then we assume that you're trying to simulate HTML form
+submission and we add a 'Content_Type' header with a value of
+'application/x-www-form-urlencod
Re: Patch for easy testing of Apache::* modules (resend)
[EMAIL PROTECTED] (Doug MacEachern) wrote: >On Mon, 17 Jul 2000, Ken Williams wrote: > >> Hi all, >> >> Here's a resend of the Apache::test patch that I sent yesterday, this time >> sent as type text/plain from a Unix mailer. Rick Myers noted that the >> version I sent before was encoded with Macintosh BinHex, which is probably >> not the most appropriate choice for this list. ;-) > >looks great ken, applied, thanks! >btw, when i first skimmed the patch, i thought it modified the >mod_perl Makefile.PL test foo, which is why i was holding off. Awesome, it looks like you've applied my two biggest patches. Now I'll go off and make sure they work =). ------ Ken Williams Last Bastion of Euclidity [EMAIL PROTECTED]The Math Forum
Re: Patch for easy testing of Apache::* modules (resend)
On Mon, 17 Jul 2000, Ken Williams wrote: > Hi all, > > Here's a resend of the Apache::test patch that I sent yesterday, this time > sent as type text/plain from a Unix mailer. Rick Myers noted that the > version I sent before was encoded with Macintosh BinHex, which is probably > not the most appropriate choice for this list. ;-) looks great ken, applied, thanks! btw, when i first skimmed the patch, i thought it modified the mod_perl Makefile.PL test foo, which is why i was holding off.
Re: Patch for easy testing of Apache::* modules (resend)
Hi all,
Here's a resend of the Apache::test patch that I sent yesterday, this time
sent as type text/plain from a Unix mailer. Rick Myers noted that the
version I sent before was encoded with Macintosh BinHex, which is probably
not the most appropriate choice for this list. ;-)
-Ken
Index: test.pm
===
RCS file: /home/cvspublic/modperl/lib/Apache/test.pm,v
retrieving revision 1.16
diff -u -r1.16 test.pm
--- test.pm 2000/03/06 20:38:22 1.16
+++ test.pm 2000/07/17 05:18:12
@@ -44,6 +44,156 @@
*Apache::Constants::bootstrap = sub {};
}
+sub write_httpd_conf {
+my $pkg = shift;
+my %args = (conf_file => 't/httpd.conf', @_);
+my $DIR = `pwd`; chomp $DIR;
+
+local *CONF;
+open CONF, ">$args{conf_file}" or die "Can't create $args{conf_file}: $!";
+print CONF <);
+ $response ||= $default;
+} until (!$mustfind || (-e $response || !print("$response not found\n")));
+
+return $response;
+}
+
+sub get_test_params {
+my $pkg = shift;
+
+print("\nFor testing purposes, please give the full path to an httpd\n",
+ "with mod_perl enabled. The path defaults to \$ENV{APACHE}, if present.");
+
+my %conf;
+
+my $httpd = $ENV{'APACHE'} || which('apache') || which('httpd') ||
+'/usr/lib/httpd/httpd';
+
+$httpd = _ask("\n", $httpd, 1);
+system "$Config{lns} $httpd t/httpd";
+
+if (lc _ask("Search existing config file for dynamic module dependencies?", 'n')
+eq 'y') {
+ my %compiled;
+ for (`t/httpd -V`) {
+ if (/([\w]+)="(.*)"/) {
+ $compiled{$1} = $2;
+ }
+ }
+ $compiled{SERVER_CONFIG_FILE} =~ s,^,$compiled{HTTPD_ROOT}/,
+ unless $compiled{SERVER_CONFIG_FILE} =~ m,^/,;
+
+ my $file = _ask(" Config file", $compiled{SERVER_CONFIG_FILE}, 1);
+ $conf{modules} = $pkg->_read_existing_conf($file);
+}
+
+# Get default user (apache doesn't like to run as root, special-case it)
+my $defuser = ($< && getpwuid $<) || 'nobody';
+$conf{user} = _ask("User to run tests under", $defuser);
+
+my $defgroup = ($defuser eq 'nobody' ? 'nobody' : getgrgid((getpwnam
+$conf{user})[3]));
+$conf{group} = _ask("Group to run tests under", $defgroup);
+
+$conf{port} = _ask("Port to run tests under", 8228);
+
+return %conf;
+}
+
+sub _read_existing_conf {
+# Returns some config text
+shift;
+my ($server_conf) = @_;
+
+
+open SERVER_CONF, $server_conf or die "Couldn't open $server_conf: $!";
+my @lines = grep {!m/^\s*#/} ;
+close SERVER_CONF;
+
+my @modules = grep /^\s*(Add|Load)Module/, @lines;
+my ($server_root) = (map /^\s*ServerRoot\s*(\S+)/, @lines);
+
+# Rewrite all modules to load from an absolute path.
+foreach (@modules) {
+ s!(\s)([^/\s]\S+/)!$1$server_root/$2!;
+}
+
+# Directories where apache DSOs live.
+my (@module_dirs) = map {m,(/\S*/),} @modules;
+
+# Have to make sure that dir, autoindex and perl are loaded.
+my @required = qw(dir autoindex perl);
+
+my @l = `t/httpd -l`;
+my @compiled_in = map /^\s*(\S+)/, @l[1..@l-2];
+
+my @load;
+foreach my $module (@required) {
+ if (!grep /$module/i, @compiled_in, @modules) {
+ push @load, $module;
+ }
+}
+
+# Finally compute the directives to load modules that need to be loaded.
+ MODULE:
+foreach my $module (@load) {
+ foreach my $module_dir (@module_dirs) {
+ if (-e "$module_dir/mod_$module.so") {
+ push @modules, "LoadModule ${module}_module
+$module_dir/mod_$module.so\n"; next MODULE;
+ } elsif (-e "$module_dir/lib$module.so") {
+ push @modules, "LoadModule ${module}_module
+$module_dir/lib$module.so\n"; next MODULE;
+ } elsif (-e "$module_dir/ApacheModule\u$module.dll") {
+ push @modules, "LoadModule ${module}_module
+$module_dir/ApacheModule\u$module.dll\n"; next MODULE;
+ }
+ }
+}
+
+print "found the following modules: \n@modules";
+return join '', @modules;
+}
+
+# Find an executable in the PATH.
+sub which {
+foreach (map { "$_/$_[0]" } split /:/, $ENV{PATH}) {
+ next unless m,^/,;
+ return $_ if -x;
+}
+}
+
+
sub test {
my $s = $_[1] ? "ok $_[0]\n" : "not ok $_[0]\n";
if($ENV{MOD_PERL}) {
@@ -190,34 +340,42 @@
}
sub MM_test {
-my $script = "t/TEST";
-my $my_test = q(
+shift(); # Don't need package name
+my %conf = @_;
+
+my $section = write_httpd_conf(%params, include => $more_directives);
+ *MY::test = sub { Apache::test->MM_test(%params) };
+
+ # In t/*.t script (or test.pl)
+ (Some methods
