Clone request headers in Vanilla Perl CGI to LWP UserAgent

I have a perl CGI application that I want to take the users request headers, and turn those around into an LWP::UserAgent get request. Basically the goal is to replicate the incoming users headers and use those to make a separate request.

I've tried to create the headers myself but when I attempt to display the CGI headers and then my clone UserAgent headers, they aren't exactly the same. Here's what I got:

my $cgi = new CGI;
my %headers = map { $_ => $cgi->http($_) } $cgi->http;
my $req_headers = HTTP::Headers->new( %headers );
my $ua = LWP::UserAgent->new( default_headers => $req_headers );
print Dumper $ua->default_headers;

Basically, %headers and $ua->default_headers are not identical. $ua->default_headers has an agent that ide开发者_如何转开发ntifies itself as a perl script. I can manually set $ua->agent("") but there are other imperfections and the headers still aren't identical.

What's the best way to do what I want? There's got to be an easier solution...

It looks like the problem has to do with naming of incoming http headers compared to what HTTP::Headers uses.

The incoming parameters all have HTTP_ prefix in them where HTTP::Headers doesn't use that naming convention (which makes sense). Plus it looks like (a quick read in the code) that HTTP::Headers does the right thing in converting '-' into '_' for its own use.

I would recommended changing your map to following that removes the prefix:

# remove leading HTTP_ from keys, note: this assumes all keys have pattern
# HTTP_*
%headers = map { ( /^HTTP_(.*?)$/ ) => $cgi->http($_) } $cgi->http;

Here is the debugging script I used:

my $cgi = CGI->new;
my %headers = map { $_ => $cgi->http($_) } $cgi->http;
my $req_headers = HTTP::Headers->new( %headers );
my $ua = LWP::UserAgent->new( default_headers => $req_headers );

print "Content-type: text/plain\n\n";
print Dumper($ua->default_headers);
print Dumper( \%headers );

# remove HTTP_ from $_
%headers = map { ( /^HTTP_(.*?)$/ ) => $cgi->http($_) } $cgi->http;
$req_headers = HTTP::Headers->new( %headers );
$ua = LWP::UserAgent->new( default_headers => $req_headers );

print "headers part deux:\n";
print Dumper( $ua );

Hope that Helps