perl - 将 Vanilla Perl CGI 中的请求 header 克隆到 LWP UserAgent

Question

我有一个 perl CGI 应用程序，我想获取用户请求 header ，并将其转换为 LWP::UserAgent get 请求。基本上，目标是复制传入的用户 header 并使用它们来发出单独的请求。

我尝试自己创建 header ，但是当我尝试显示 CGI header 然后显示我的克隆 UserAgent header 时，它们并不完全相同。这是我得到的:

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;

基本上，%headers 和 $ua->default_headers 是不一样的。 $ua->default_headers 有一个将自己标识为 perl 脚本的代理。我可以手动设置 $ua->agent("")，但还有其他不完善之处，而且 header 仍然不相同。

做我想做的事情的最佳方式是什么？必须有一个更简单的解决方案...

Answer 1

与 HTTP::Headers 使用的名称相比，问题似乎与传入的 http header 的命名有关。

传入参数中都有 HTTP_ 前缀，其中 HTTP::Headers 不使用该命名约定(这是有道理的)。此外，看起来(快速阅读代码)HTTP::Headers 在将“-”转换为“_”以供自己使用方面做了正确的事情。

我建议将您的 map 更改为以下内容以删除前缀:

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

这是我使用的调试脚本:

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 );

希望对你有帮助