view release on metacpan or  search on metacpan

lib/LWP/CurlLog.pm  view on Meta::CPAN

package LWP::CurlLog;
use strict;
use warnings;

BEGIN {
    eval {
        require LWP::UserAgent;
    };
    eval {
        require HTTP::Tiny;
    };
}

our $VERSION = "0.04";
our %opts = (
    file => undef,
    response => 1,
    options => "-k",
    timing => 0,
    trace => 0,
);

sub import {
    my ($package, %args) = @_;
    for my $key (keys %args) {
        $opts{$key} = $args{$key};
    }

    if (!$opts{file}) {
        $opts{fh} = \*STDERR;
    }
    else {
        my $expanded_file = $opts{file};
        if ($expanded_file =~ m{^~/}) {
            my $home = $ENV{HOME} || (getpwuid($<))[7];
            $expanded_file =~ s{^~/}{$home/};
        }
        open $opts{fh}, ">>", $expanded_file or die "Can't open $opts{file}: $!";
    }
    select($opts{fh});
    $| = 1;
    select(STDOUT);
}

no strict "refs";
no warnings "redefine";

my $orig_lusr = \&LWP::UserAgent::send_request;
*{"LWP::UserAgent::send_request"} = sub {
    my ($self, $req) = @_;
    my $headers = {};
    for my $name ($req->headers()->header_field_names()) {
        $headers->{$name} = $req->{headers}{$name};
    }
    my $content = $req->decoded_content();
    my $res = request("LWP", $orig_lusr, \@_, $req->method(), $req->uri(), $headers, $content);
    return $res;
};

my $orig_htr = \&HTTP::Tiny::_request;
*{"HTTP::Tiny::_request"} = sub {
    my ($self, $method, $url, $args) = @_;
    my $res = request("HT", $orig_htr, \@_, $method, $url, $args->{headers}, $args->{content});
    return $res;
};

sub request {
    my ($module, $orig_sub, $orig_args, $method, $url, $headers, $content) = @_;

    my $cmd = "curl ";
    if ($url =~ /[=&;?]/) {
        $cmd .= "\"$url\" ";
    }
    else {
        $cmd .= "$url ";
    }
    if ($opts{options}) {
        $cmd .= "$opts{options} ";
    }

    if ($method && ($method ne "GET" || length $content)) {
        $cmd .= "-X $method ";
    }

    for my $name (keys %$headers) {
        if ($name =~ /^(Content-Length|User-Agent)$/i) {
            next;
        }
        my $value = $headers->{$name};
        $value =~ s{([\\\$"])}{\\$1}g;
        $cmd .= "-H \"$name: $value\" ";
    }

    if (defined $content && length $content) {
        $content =~ s{([\\\$"])}{\\$1}g;