Cloner les en-têtes de requête dans Vanilla Perl CGI à LWP UserAgent

Question

J'ai une application CGI Perl que je veux prendre les en-têtes de requête des utilisateurs, et les transformer en une requête get LWP :: UserAgent. Fondamentalement, l'objectif est de répliquer les en-têtes des utilisateurs entrants et de les utiliser pour faire une demande séparée.

J'ai essayé de créer les en-têtes moi-même mais lorsque j'essaie d'afficher les en-têtes CGI et ensuite les en-têtes UserAgent de mon clone, ils ne sont pas exactement les mêmes. Voici ce que je suis:

 
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; 

Fondamentalement, les en-têtes de% et UA- $> default_headers ne sont pas identiques. $ ua-> default_headers a un agent qui s'identifie comme un script Perl. Je peux définir manuellement $ ua-> agent ("") mais il y a d'autres imperfections et les en-têtes ne sont pas identiques.

Quelle est la meilleure façon de faire ce que je veux? Il doit y avoir une solution plus facile ...

Answer 1

Il semble que le problème soit lié à l'appellation des en-têtes http entrants par rapport à ce que les entêtes HTTP :: Headers utilisent.

Les paramètres entrants ont tous le préfixe HTTP_ dans ceux-ci où HTTP :: Headers n'utilise pas cette convention de dénomination (ce qui est logique). De plus, il semble (une lecture rapide dans le code) que HTTP :: Headers fasse la bonne chose en convertissant '-' en '_' pour son propre usage.

Je recommande de modifier votre map à suivre qui supprime le préfixe:

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

Voici le script de débogage je:

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 qui aide