Заголовки запроса клона в CGI Vanilla Perl для агента пользователя LWP - PullRequest
3 голосов
/ 19 июня 2010

У меня есть Perl CGI-приложение, которое я хочу взять заголовки запросов пользователей и превратить их в запрос получения LWP :: UserAgent.По сути, цель состоит в том, чтобы реплицировать заголовки входящих пользователей и использовать их для создания отдельного запроса.

Я пытался создать заголовки самостоятельно, но когда я пытаюсь отобразить заголовки CGI, а затем мои клонированные заголовки UserAgent,они не совсем одинаковые.Вот что я получил:

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 (""), но есть и другие недостатки, и заголовки все еще не идентичны.

Какой лучший способ сделать то, что я хочу?Должно быть более простое решение ...

1 Ответ

3 голосов
/ 16 июня 2011

Похоже, что проблема связана с именованием входящих заголовков http по сравнению с тем, что использует HTTP :: Headers.

Все входящие параметры имеют префикс 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 );

Надеюсь, что поможет

...