[EMAIL PROTECTED] (Doug MacEachern) wrote:
>On Thu, 27 Jul 2000, Ken Williams wrote:
>
>> Hi all,
>>
>> I sent a patch for Apache::test a week or so ago. I got no
>> responses, so I'm here to advocate again for its incorporation. The
>> original message is here:
>>
>> http://forum.swarthmore.edu/epigone/modperl/swonflefim
>>
>> Are any of the CVS guardians listening? Doug seems to be long absent.
>
>i'm still here, just been in read-only mode the past few weeks. i
>should be able to catch up next week, i'll look at your patch then
>before 1.25 is released.
I've done more work on this, adding some more capabilities to the
fetch() method (backward compatibility is preserved) and documenting it.
Here's the new patch against CVS.
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/08/07 07:32:11
@@ -44,6 +44,200 @@
*Apache::Constants::bootstrap = sub {};
}
+################ Methods that happen at "perl Makefile.PL" time ###############
+
+sub write_httpd_conf {
+ my $pkg = shift;
+ my %args = (conf_file => 't/httpd.conf', @_);
+ chomp (my $DIR = `pwd`);
+
+ local *CONF;
+ open CONF, ">$args{conf_file}" or die "Can't create $args{conf_file}: $!";
+ print CONF <<EOF;
+
+Port $args{port}
+User $args{user}
+Group $args{group}
+ServerName localhost
+DocumentRoot $DIR/t/eg
+
+$args{modules}
+
+ErrorLog $DIR/t/error_log
+PidFile $DIR/t/httpd.pid
+AccessConfig /dev/null
+ResourceConfig /dev/null
+LockFile $DIR/t/httpd.lock
+TypesConfig /dev/null
+TransferLog /dev/null
+ScoreBoardFile /dev/null
+
+AddType text/html .html
+
+# Look in ./blib/lib
+PerlModule ExtUtils::testlib
+
+$args{include}
+EOF
+
+ return 1;
+}
+
+sub MM_test {
+ # Writes the test section for the Makefile
+ shift(); # Don't need package name
+ my %conf = @_;
+
+ my $section = <<EOF;
+TEST_VERBOSE=0
+TEST_TYPE=test_\$(LINKTYPE)
+TEST_FILE = test.pl
+TEST_FILES = t/*.t
+TESTDB_SW = -d
+
+#test: start_httpd run_tests kill_httpd
+
+test :: pure_all start_httpd run_tests kill_httpd
+
+testdb: start_httpd run_testsdb kill_httpd
+
+kill_httpd:
+ kill `cat t/httpd.pid`
+
+start_httpd:
+ t/httpd -f `pwd`/t/httpd.conf
+
+run_tests :: pure_all
+ PERL_DL_NONLAZY=1 PORT=$conf{port}
+EOF
+ chomp $section;
+
+ $section .= <<'EOF';
+ $(FULLPERL) -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -e 'use
+Test::Harness qw(&runtests $$verbose); $$verbose=$(TEST_VERBOSE); runtests @ARGV;'
+$(TEST_FILES)
+
+run_testsdb :: pure_all
+ PERL_DL_NONLAZY=1 $(FULLPERL) $(TESTDB_SW) -I$(INST_ARCHLIB) -I$(INST_LIB)
+-I$(PERL_ARCHLIB) -I$(PERL_LIB) $(TEST_FILE)
+
+EOF
+
+ return $section;
+}
+
+sub _ask {
+ # Just a function for asking the user questions
+ my ($prompt, $default, $mustfind) = @_;
+
+ my $response;
+ do {
+ print "$prompt [$default]: ";
+ chomp($response = <STDIN>);
+ $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*#/} <SERVER_CONF>;
+ 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;
+ }
+}
+
+################# Methods that happen at "make test" time #########################
+
sub test {
my $s = $_[1] ? "ok $_[0]\n" : "not ok $_[0]\n";
if($ENV{MOD_PERL}) {
@@ -55,21 +249,25 @@
}
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
+ $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 {
@@ -189,37 +387,6 @@
Test::Harness::runtests(@tests);
}
-sub MM_test {
- my $script = "t/TEST";
- my $my_test = q(
-
-test: run_tests
-
-);
-
- join '', qq(
-MP_TEST_SCRIPT=$script
-),
- q(
-TEST_VERBOSE=0
-
-kill_httpd:
- kill `cat t/logs/httpd.pid`
-
-start_httpd:
- ./httpd -X -d `pwd`/t &
-
-rehttpd: kill_httpd start_httpd
-
-run_tests:
- $(FULLPERL) $(MP_TEST_SCRIPT) $(TEST_VERBOSE)
-
-),
-
-$my_test;
-
-}
-
sub grab {
require IO::Socket;
my(@args) = @_;
@@ -326,3 +493,179 @@
1;
__END__
+
+=head1 NAME
+
+Apache::Test - Facilitates testing of Apache::* modules
+
+=head1 SYNOPSIS
+
+ # In Makefile.PL
+ use Apache::test;
+ my %params = Apache::test->get_test_params();
+ Apache::test->write_httpd_conf(%params, include => $more_directives);
+ *MY::test = sub { Apache::test->MM_test(%params) };
+
+ # In t/*.t script (or test.pl)
+ (Some methods of Doug's that I haven't reviewed or documented yet)
+
+=head1 DESCRIPTION
+
+This module helps authors of Apache::* modules write test suites that
+can query an actual running Apache server with mod_perl and their
+modules loaded into it. Its functionality is generally separated into
+methods that go in a Makefile.PL to configure, start, and stop the
+server, and methods that go in one of the test scripts to make HTTP
+queries and manage the results.
+
+=head1 METHODS
+
+=head2 get_test_params()
+
+This will ask the user a few questions about where the httpd binary
+is, and what user/group/port should be used when running the server.
+It will return a hash of the information it discovers. This hash is
+suitable for passing to the C<write_httpd_conf()> method.
+
+=head2 write_httpd_conf(%params)
+
+This will write a basic C<httpd.conf> file suitable for starting a
+HTTP server during the 'make test' stage. A hash of key/value pairs
+that affect the written file can be passed as arguments. The
+following keys are recognized:
+
+=over 4
+
+=item * conf_file
+
+The path to the file that will be created. Default is 't/httpd.conf'.
+
+=item * port
+
+The port that the Apache server will listen on.
+
+=item * user
+
+The user that the Apache server will run as.
+
+=item * group
+
+The group that the Apache server will run as.
+
+=item * include
+
+Any additional text you want added at the end of the config file.
+Typically you'll have some C<PerlModule> and C<Perl*Handler>
+directives to pass control to the module you're testing. The C<blib/>
+directories will be added to the C<@INC> path when searching for
+modules, so that's nice.
+
+=back
+
+=head2 MM_test(%params)
+
+This method helps write a Makefile that supports running a web server
+during the 'make test' stage. When you execute 'make test', 'make'
+will run 'make start_httpd', 'make run_tests', and 'make kill_httpd'
+in sequence. You can also run these commands independently if you
+want.
+
+Pass the hash of parameters returned by C<get_test_params()> as an
+argument to C<MM_test()>.
+
+To patch into the ExtUtils::MakeMaker wizardry (voodoo?), typically
+you'll do the following in your Makefile.PL:
+
+ *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.
+
+=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-urlencoded'.
+
+In a scalar context, fetch() returns the content of the web server's
+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.
+
+=head1 EXAMPLES
+
+No good examples yet. Example submissions are welcome. In the meantime, see
+L<http://forum.swarthmore.edu/~ken/modules/Apache-AuthCookie/> , which
+I'm retrofitting to use Apache::test.
+
+=head1 TO DO
+
+The MM_test method doesn't try to be very smart, it just writes the
+text that seems to work in my configuration. I am morally against
+using the 'make' command for installing Perl modules (though of course
+I do it anyway), so I haven't looked into this very much. Send bug
+reports or better (patches).
+
+I've got lots of code in my Apache::AuthCookie module (etc.) that
+assists in actually making the queries of the running server. I plan
+to add that to this module, but first I need to compare what's already
+here that does the same stuff.
+
+=head1 KUDOS
+
+To Doug MacEachern for writing the first version of this module.
+
+To [EMAIL PROTECTED] (Rafael Kitover) for contributing the code to
+parse existing httpd.conf files for --enable-shared=max and DSOs.
+
+=head1 CAVEATS
+
+Except for making sure that the mod_perl distribution itself can run
+'make test' okay, I haven't tried very hard to keep compatibility with
+older versions of this module. In particular MM_test() has changed
+and probably isn't usable in the old ways, since some of its
+assumptions are gone. But none of this was ever documented, and
+MM_test() doesn't seem to actually be used anywhere in the mod_perl
+disribution, so I don't feel so bad about it.
+
+=head1 AUTHOR
+
+Doug MacEachern (original version)
+
+Ken Williams (latest changes and this documentation)
+
+=cut
+
