I have a use case in which a service to which I am posting form data may sometimes redirect me to another page, and sometimes it sends a response directly. I have to be able to detect when the redirection happens so I can respond appropriately. Actually, if the redirectiong happens, I have to pass it back to the client that made a request to my cgi script (storing one thing in my DB), and if not, then I pass my own page back to the client while storing something else in my DB.

Here are excerpts from the little cgi script I made to dynamically redirect or not depending on a request parameter

use strict;
use CGI;

my $TITLE = 'Redirection Test';
my $cgi = new CGI;
my $rp = $cgi->param('r');
print $cgi->header unless defined $rp;
...
if (defined $rp) {
  if ($rp > 0) {
    my $full_url = $cgi->url();
#    print $cgi->redirect($full_url");
    print $cgi->header("Location: $full_url");exit(0);
  }
}
&print_html_header;
&print_content;
&print_end;
exit(0);

sub print_html_header {
    print $cgi->start_html($TITLE);
}

sub print_end {
    print $cgi->end_html;
}

sub print_content {
  print "<p><a href=\"http://www.google.ca\">Go To Google</a></p>";
}
[download]

And here is my client code:

use strict;
use Log::Log4perl qw(:easy get_logger);
use LWP::UserAgent;
use HTTP::Request;
use HTTP::Request::Common;
use HTTP::Response;
use HTTP::Status;

$| = 1;
$ua->add_handler("request_send",  sub { log_it("Request: ".shift->dump
+); return });
$ua->add_handler("response_done", sub { my $rsp = shift; my @red = $rs
+p->redirects; my $r; foreach $r (@red) {log_it("Response redirect: ".
+$r)}; log_it("Response last request: ".$rsp->request->uri); log_it("R
+esponse headers: ".$rsp->headers_as_string); log_it("Response code: "
+.$rsp->code); my $msg = status_message($rsp->code); log_it("Response 
+status: ".$msg) if defined $msg; log_it("Response status: ".$rsp->sta
+tus_line); return });

# Define configuration
my $conf = q(
        log4perl.logger                    = TRACE, FileApp, ScreenApp
        log4perl.appender.FileApp          = Log::Log4perl::Appender::
+File
        log4perl.appender.FileApp.filename = lwp.log
        log4perl.appender.FileApp.layout   = PatternLayout
        log4perl.appender.FileApp.layout.ConversionPattern = %d> %m%n
        log4perl.appender.ScreenApp          = Log::Log4perl::Appender
+::Screen
        log4perl.appender.ScreenApp.stderr   = 0
        log4perl.appender.ScreenApp.layout   = PatternLayout
        log4perl.appender.ScreenApp.layout.ConversionPattern = %d> %m%
+n
);

# Initialize logging behaviour
Log::Log4perl->init( \$conf );
Log::Log4perl->infiltrate_lwp();

my $logger = get_logger();

my $req_url = $ARGV[0];
$req_url = "\"$req_url \"";
my $response = $ua->request(GET "$req_url");
print "Redirects: ",$response->redirects,"\n";
print "Header field names: ",$response->header_field_names,"\n";
my $prev = $response->previous;
$prev = 'undef' unless defined $prev;
print "Previous: $prev\n";
if ( $response->is_redirect  ) {
    print $response->previous . " redirected to location " .  $respons
+e->header('Location') .  "\n";
    print "The content is: ",$response->content,"\n";
    $logger->info($response->previous . " redirected to location " .  
+$response->header('Location'));
} else {
  if ($response->is_success) {
    print "The content is: ",$response->content,"\n";
    $logger->info("The URL $req_url was successfully retrieved.");
    if (lc($response->content)=~m/'error_response'/){
      $logger->warn("Response problematic content: ".$response->conten
+t);
    }
  } else {
    $logger->warn("The URL $req_url was not successfully retrieved.");
  }
}


sub log_it {
  my $tmp = shift;
  $tmp =~ s/\n+/,\t/g;
  $tmp =~ s/,\t$//;
  $logger->info($tmp);
  return;
}
[download]

Now here is typical output

2012/09/26 15:52:32> Request: GET http://localhost:9080/cgi-bin/cgi.re
+direct.pl?r=1,    User-Agent: libwww-perl/6.02,    (no content)
2012/09/26 15:52:32> Response last request: http://localhost:9080/cgi-
+bin/cgi.redirect.pl?r=1
2012/09/26 15:52:32> Response headers: Connection: close,    Date: Wed
+, 26 Sep 2012 19:52:32 GMT,    Server: Apache/2.2.16 (Win32) mod_ssl/
+2.2.16 OpenSSL/0.9.8o PHP/5.3.3,    Content-Length: 0,    Content-Typ
+e: location: http://localhost:9080/cgi-bin/cgi.redirect.pl; charset=I
+SO-8859-1,    Client-Date: Wed, 26 Sep 2012 19:52:32 GMT,    Client-P
+eer: 127.0.0.1:9080,    Client-Response-Num: 1
2012/09/26 15:52:32> Response code: 200
2012/09/26 15:52:32> Response status: OK
2012/09/26 15:52:32> Response status: 200 OK
Redirects: 
Header field names: ConnectionDateServerContent-LengthContent-TypeClie
+nt-DateClient-PeerClient-Response-Num
Previous: undef
The content is: 
2012/09/26 15:52:32> The URL "http://localhost:9080/cgi-bin/cgi.redire
+ct.pl?r=1 " was successfully retrieved.
[download]

Now, you can see from the log output that the request used a parameter that ought to have produced the redirect URL. NB: I used " print $cgi->header("Location: $full_url");" because "print $cgi->redirect($full_url");" generated a server error complaining about a malformed header.

I do not know why LWP is not following the redirection. I suspect that failure is why I get nothing from the previous or redirects functions. I got the functions I am trying to use from the Activestate perl documentation, but they do not seem to be working.

Did I miss something? Or is there something missing or incorrect in the documentation?

Any assistance you can provide would be greatly appreciated.

Thanks

Ted