File Coverage

lib/LWP/CurlLog.pm

Criterion	Covered	Total	%
statement	50	70	71.4
branch	10	20	50.0
condition	2	9	22.2
subroutine	7	7	100.0
pod			n/a
total	69	106	65.0

package LWP::CurlLog;
use strict;
use warnings;
use LWP::UserAgent ();

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

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

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

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

my $orig_sub = \&LWP::UserAgent::send_request;
*{"LWP::UserAgent::send_request"} = sub {
    my ($self, $request) = @_;

    my $cmd = "curl ";
    my $url = $request->uri();
    if ($url =~ /[=&;?]/) {
        $cmd .= "\"$url\" ";
    }
    else {
        $cmd .= "$url "
    }
    if ($opts{options}) {
        $cmd .= "$opts{options} ";
    }
    if ($request->method() && ($request->method() ne "GET" || $request->content_length())) {
        $cmd .= "-X " . $request->method() . " ";
    }
    for my $header ($request->header_field_names) {
        if ($header =~ /^(Content-Length|User-Agent)$/i) {
            next;
        }
        my $value = $request->header($header);
        $value =~ s{([\\\$"])}{\\$1}g;
        $cmd .= "-H \"$header: $value\" ";
    }
    if ($request->header("Content-Length")) {
        my $content = $request->decoded_content();
        $content =~ s{([\\\$"])}{\\$1}g;
        $cmd .= "-d \"$content\" ";
    }
    $cmd =~ s/\s*$//;

    print {$opts{fh}} "# " . localtime() . " LWP request\n";
    print {$opts{fh}} "$cmd\n";
    my $time1 = time();
    my $response = $orig_sub->(@_);
    my $time2 = time();

    if ($opts{response}) {
        print {$opts{fh}} "\n# " . localtime() . " LWP response\n";
        my $response2 = $response->as_string;
        $response2 =~ s/\s*$//g;
        print {$opts{fh}} "$response2\n";
    }
    if ($opts{timing}) {
        my $diff = $time2 - $time1;
        print {$opts{fh}} "# ${diff}s\n";
    }

    print {$opts{fh}} "\n";

    return $response;
};

1;

__END__