File Coverage

lib/LWP/CurlLog.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

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

our $VERSION = "0.01";
our $log_file ||= "~/curl.log";
our $log_output = defined $log_output ? $log_output : 1;
our $curl_options = defined $curl_options ? $curl_options : "-k";
our $logfh = undef;

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

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

    open_log();
    my $cmd = "curl ";
    my $url = $request->uri();
    if ($url =~ /[=&;?]/) {
        $cmd .= "\"$url\" ";
    }
    else {
        $cmd .= "$url "
    }
    if ($curl_options) {
        $cmd .= "$curl_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 $logfh "# " . localtime() . " LWP request\n";
    print $logfh "$cmd\n";
    my $response = $orig_sub->(@_);

    if ($log_output) {
        print $logfh "# " . localtime() . " LWP response\n";
        print $logfh $response->as_string . "\n";
    }

    return $response;
};

sub open_log {
    if ($logfh) {
        return;
    }
    if ($log_file eq "STDOUT") {
        $logfh = \*STDOUT;
    }
    elsif ($log_file eq "STDERR") {
        $logfh = \*STDERR;
    }
    elsif ($log_file =~ m{^~/}) {
        my $home = (getpwuid($>))[7];
        $log_file =~ s{^~/}{$home/};
        open $logfh, ">>", $log_file or die "Can't open $log_file: $!";
    }
    else {
        open $logfh, ">>", $log_file or die "Can't open $log_file: $!";
    }
    select($logfh);
    $| = 1;
    select(STDOUT);
}

1;

__END__