[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
+<Perl>
+ use lib "$DIR/blib/lib", "$DIR/t/lib";
+</Perl>
$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-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. Examples are welcome. In the meantime, see
+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.
===================================================================
------------------- -------------------
Ken Williams Last Bastion of Euclidity
[EMAIL PROTECTED] The Math Forum
