Блог

Я использую package WWW::Curl::Easy для вызовов API, и это мой пример кода:

 use WWW::Curl::Easy;

my $curl = WWW::Curl::Easy->new();

$curl->setopt(CURLOPT_POST, 1);
$curl->setopt(CURLOPT_HEADER, 1);
$curl->setopt(CURLOPT_HTTPHEADER, ['Accept: text/xml; charset=utf-8', 'Content-Type:text/xml; charset=utf-8', 'SOAPAction: "importSheet"']);
$curl->setopt(CURLOPT_POSTFIELDS, $requestMessage);
$curl->setopt(CURLOPT_URL, $tom::{'setup'}{'api'}{'carrier'}{'url'});


my $response;
$curl->setopt(CURLOPT_WRITEDATA, $response);

main::_log(Dumper($curl));

my $ret = $curl->perform();
 

Могу ли я как-то сбросить весь запрос из $curl ?

Я пытался main::_log(Dumper($curl)); , но это не дало мне ничего полезного.

Я хотел бы видеть весь запрос, например, реальные заголовки, метод, тело запроса, данные post и т. Д. Я знаю, что могу видеть эту информацию в коде, потому что я установил ее, например, в CURLOPT_HTTPHEADER , но я хотел бы сбросить «реальный» запрос (из curl), который будет отправлен.

Самый простой способ — включить CURLOPT_VERBOSE в вашей программе.

 use WWW::Curl::Easy;

my $curl = WWW::Curl::Easy->new;

$curl->setopt(CURLOPT_HEADER,1);
$curl->setopt(CURLOPT_URL, 'http://example.com');
$curl->setopt(CURLOPT_WRITEDATA,my $response_body);

# this turns on debugging a la `curl -v http://example.com`
$curl->setopt(CURLOPT_VERBOSE, 1);

my $retcode = $curl->perform;
print("Transfer went okn") unless $retcode;
 

Вывод:

 *   Trying 93.184.216.34:80...
* TCP_NODELAY set
* Connected to example.com (93.184.216.34) port 80 (#0)
> GET / HTTP/1.1
Host: example.com
Accept: */*

* Mark bundle as not supporting multiuse
< HTTP/1.1 200 OK
< Accept-Ranges: bytes
< Age: 543595
< Cache-Control: max-age=604800
< Content-Type: text/html; charset=UTF-8
< Date: Thu, 25 Nov 2021 14:20:18 GMT
< Etag: "3147526947 gzip"
< Expires: Thu, 02 Dec 2021 14:20:18 GMT
< Last-Modified: Thu, 17 Oct 2019 07:18:26 GMT
< Server: ECS (nyb/1D0F)
< Vary: Accept-Encoding
< X-Cache: HIT
< Content-Length: 1256
< 
* Connection #0 to host example.com left intact
Transfer went ok
 

Если вы хотите чего-то более навороченного, вам придется свернуть свой собственный. Вы можете перезаписать то, что CURLOPT_VERBOSE делает, установив CURLOPT_DEBUGFUNCTION ссылку на код Perl. Это вызывается для каждой строки вывода отладки.

Подпись, похоже, отличается от той, что есть в документации для libcurl, но можно вычесть, что происходит.

 $curl->setopt(CURLOPT_VERBOSE, 1);
$curl->setopt(CURLOPT_DEBUGFUNCTION, sub {
    use Data::Dumper;
    print Dumper @_;
});
 

Первые несколько строк вывода с этим набором выглядят следующим образом.

 [
    [0] "  Trying 93.184.216.34:80...
",
    [1] undef,
    [2] 0
]
[
    [0] "TCP_NODELAY set
",
    [1] undef,
    [2] 0
]
[
    [0] "Connected to example.com (93.184.216.34) port 80 (#0)
",
    [1] undef,
    [2] 0
]
[
    [0] "GET / HTTP/1.1
Host: example.com
Accept: */*

",
    [1] undef,
    [2] 2
]
 

Первым аргументом, похоже, является текст.

Согласно документам, существует несколько типов отладочных данных.

 typedef enum {
  CURLINFO_TEXT = 0,
  CURLINFO_HEADER_IN,    /* 1 */
  CURLINFO_HEADER_OUT,   /* 2 */
  CURLINFO_DATA_IN,      /* 3 */
  CURLINFO_DATA_OUT,     /* 4 */
  CURLINFO_SSL_DATA_IN,  /* 5 */
  CURLINFO_SSL_DATA_OUT, /* 6 */
  CURLINFO_END
} curl_infotype;
 

Учитывая, что последний из моих примеров имеет a 2 , а все остальные имеют a 0 в качестве третьего аргумента, мы можем предположить, что это должен быть тип.

Я не понял, что такое второй аргумент.

Это оставляет нас с:

 $curl->setopt(CURLOPT_DEBUGFUNCTION, sub {
    my ($text, undef, $type) = @_;

    # ...
});
 

Как это бывает, эти типы были импортированы как константы с помощью WWW ::Curl::Easy . Итак, мы можем сделать что-то подобное, чтобы получить только исходящий заголовок.

 $curl->setopt(CURLOPT_DEBUGFUNCTION, sub {
    my ($text, undef, $type) = @_;

    print $text if $type == CURLINFO_HEADER_OUT;
});
 

Это выведет:

 $ /usr/bin/perl foo.pl
GET / HTTP/1.1
Host: example.com
Accept: */*

Transfer went ok
 

Входящие заголовки кажутся по одному, поэтому вы можете фильтровать.

 $curl->setopt(CURLOPT_DEBUGFUNCTION, sub {
    my ($text, undef, $type) = @_;

    if ($type == CURLINFO_HEADER_IN amp;amp; $text =~ m/Etag: "(. )"/) {
        print "Etag is $1n";
    }
});
 

Более сложным примером было бы взять весь вывод отладки и преобразовать его в HTTP::Request и HTTP::Response объекты.

 $curl->setopt(CURLOPT_WRITEDATA,$response_body);
$curl->setopt(CURLOPT_VERBOSE, 1);

my ($req, $res);
$curl->setopt(CURLOPT_DEBUGFUNCTION, sub {
    my ($text, undef, $type) = @_;

    require HTTP::Request;
    require HTTP::Response;

    if ($type == CURLINFO_HEADER_OUT) {
        $req = HTTP::Request->parse($text);
    } elsif ($type == CURLINFO_DATA_OUT) {
        $req->content($text);
    } elsif ($type == CURLINFO_HEADER_IN) {
        unless ($res) {
            $res = HTTP::Response->parse($text);
            $res->request($req);
            return 0; # this is retcode
        }

        # this is from HTTP::Message
        # (https://metacpan.org/dist/HTTP-Message/source/lib/HTTP/Message.pm#L60)
        my @hdr;
        while (1) {
            if ($text =~ s/^([^s:] )[ t]*: ?(.*)n?//) {
                push(@hdr, $1, $2);
                $hdr[-1] =~ s/rz//;
            }
            elsif (@hdr amp;amp; $text =~ s/^([ t].*)n?//) {
                $hdr[-1] .= "n$1";
                $hdr[-1] =~ s/rz//;
            }
            else {
                $text =~ s/^r?n//;
                last;
            }
        }
        $res->header(@hdr) if @hdr;
    } elsif ($type == CURLINFO_DATA_IN) {
        $res->content($text);
    }
    return 0; # this is retcode
});
 

Это даст вам HTTP::Request и еще HTTP::Response объект, каждый из которых содержит все заголовки и содержимое. Не уверен, что это полезно, но это хорошая демонстрация того, что возможно с помощью этой функции.

Отказ от ответственности: я являюсь разработчиком libwww-perl.