theory 2004/10/27 11:00:37
Modified: perl-framework/Apache-Test Changes
perl-framework/Apache-Test/lib/Apache TestRequest.pm
Log:
Separated the $RedirectOK package variable from the setting of
the same information by passing the "requests_redirectable"
parameter to the user_agent() method. This allows us to keep
finer control over when the module sets the value and when the
user sets the value. Done by adding a separate $REDIR lexical
variable to handle when it is set internally. I hope I've added
enough comments to make it clear to future hackers of this
crazy module how it's supposed to work.
Revision Changes Path
1.188 +8 -3 httpd-test/perl-framework/Apache-Test/Changes
Index: Changes
===================================================================
RCS file: /home/cvs/httpd-test/perl-framework/Apache-Test/Changes,v
retrieving revision 1.187
retrieving revision 1.188
diff -u -r1.187 -r1.188
--- Changes 23 Oct 2004 15:41:10 -0000 1.187
+++ Changes 27 Oct 2004 18:00:37 -0000 1.188
@@ -15,9 +15,14 @@
fix problem with multiple all.t files where only the final
file was being run through the test harness. [Geoffrey Young]
-Documented that redirection does not with "POST" requests in
-Apache::TestRequest unless LWP is installed. Also modified
-the redirect_ok() method to ensure that such is the case.
+Documented that redirection does not work with "POST" requests in
+Apache::TestRequest unless LWP is installed. [David Wheeler]
+
+Separated the setting of the undocumented $RedirectOK package
+variable by users of Apache::TestRequest from when it is set
+internally by passing the "requests_redirectable" parameter to
+the user_agent() method. This allows users to override the
+behavior set by the user_agent() method without replacing it.
[David Wheeler]
1.103 +20 -11
httpd-test/perl-framework/Apache-Test/lib/Apache/TestRequest.pm
Index: TestRequest.pm
===================================================================
RCS file:
/home/cvs/httpd-test/perl-framework/Apache-Test/lib/Apache/TestRequest.pm,v
retrieving revision 1.102
retrieving revision 1.103
diff -u -r1.102 -r1.103
--- TestRequest.pm 26 Oct 2004 01:48:16 -0000 1.102
+++ TestRequest.pm 27 Oct 2004 18:00:37 -0000 1.103
@@ -82,6 +82,7 @@
@ISA = qw(LWP::UserAgent);
my $UA;
+my $REDIR = $have_lwp ? undef : 1;
sub module {
my $module = shift;
@@ -116,16 +117,19 @@
if (exists $args->{requests_redirectable}) {
my $redir = $args->{requests_redirectable};
if (ref $redir and (@$redir > 1 or $redir->[0] ne 'POST')) {
- $RedirectOK = $have_lwp ? undef : 1;
+ # Set our internal flag if there's no LWP.
+ $REDIR = $have_lwp ? undef : 1;
} elsif ($redir) {
if ($have_lwp) {
$args->{requests_redirectable} = [ qw/GET HEAD POST/ ];
- $RedirectOK = undef;
+ $REDIR = undef;
} else {
- $RedirectOK = 1;
+ # Set our internal flag.
+ $REDIR = 1;
}
} else {
- $RedirectOK = 0;
+ # Make sure our internal flag is false if there's no LWP.
+ $REDIR = $have_lwp ? undef : 0;
}
}
@@ -199,14 +203,19 @@
\%wanted_args;
}
-$RedirectOK = 1;
-
sub redirect_ok {
my $self = shift;
- return $self->SUPER::redirect_ok(@_)
- if $have_lwp && ! defined $RedirectOK;
- return 0 if shift->method eq 'POST';
- $RedirectOK;
+ if ($have_lwp) {
+ # Return user setting or let LWP handle it.
+ return $RedirectOK if defined $RedirectOK;
+ return $self->SUPER::redirect_ok(@_);
+ }
+
+ # No LWP. We don't support redirect on POST.
+ return 0 if $self->method eq 'POST';
+ # Return user setting or our internal calculation.
+ return $RedirectOK if defined $RedirectOK;
+ return $REDIR;
}
my %credentials;
@@ -331,7 +340,7 @@
sub UPLOAD {
my($url, $pass, $keep) = prepare(@_);
- local $RedirectOK = exists $keep->{redirect_ok}
+ local $RedirectOK = exists $keep->{redirect_ok}
? $keep->{redirect_ok}
: $RedirectOK;
