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


line stmt bran cond sub pod time code
1             package LWP::CurlLog;
2 1     1   16338 use strict;
  1         2  
  1         27  
3 1     1   4 use warnings;
  1         2  
  1         25  
4 1     1   975 use LWP::UserAgent ();
  0            
  0            
5              
6             our $VERSION = "0.01";
7             our $log_file ||= "~/curl.log";
8             our $log_output = defined $log_output ? $log_output : 1;
9             our $curl_options = defined $curl_options ? $curl_options : "-k";
10             our $logfh = undef;
11              
12             no strict "refs";
13             no warnings "redefine";
14              
15             my $orig_sub = \&LWP::UserAgent::send_request;
16             *{"LWP::UserAgent::send_request"} = sub {
17             my ($self, $request) = @_;
18              
19             open_log();
20             my $cmd = "curl ";
21             my $url = $request->uri();
22             if ($url =~ /[=&;?]/) {
23             $cmd .= "\"$url\" ";
24             }
25             else {
26             $cmd .= "$url "
27             }
28             if ($curl_options) {
29             $cmd .= "$curl_options ";
30             }
31             if ($request->method() && ($request->method() ne "GET" || $request->content_length())) {
32             $cmd .= "-X " . $request->method() . " ";
33             }
34             for my $header ($request->header_field_names) {
35             if ($header =~ /^(Content-Length|User-Agent)$/i) {
36             next;
37             }
38             my $value = $request->header($header);
39             $value =~ s{([\\\$"])}{\\$1}g;
40             $cmd .= "-H \"$header: $value\" ";
41             }
42             if ($request->header("Content-Length")) {
43             my $content = $request->decoded_content();
44             $content =~ s{([\\\$"])}{\\$1}g;
45             $cmd .= "-d \"$content\" ";
46             }
47             $cmd =~ s/\s*$//;
48              
49             print $logfh "# " . localtime() . " LWP request\n";
50             print $logfh "$cmd\n";
51             my $response = $orig_sub->(@_);
52              
53             if ($log_output) {
54             print $logfh "# " . localtime() . " LWP response\n";
55             print $logfh $response->as_string . "\n";
56             }
57              
58             return $response;
59             };
60              
61             sub open_log {
62             if ($logfh) {
63             return;
64             }
65             if ($log_file eq "STDOUT") {
66             $logfh = \*STDOUT;
67             }
68             elsif ($log_file eq "STDERR") {
69             $logfh = \*STDERR;
70             }
71             elsif ($log_file =~ m{^~/}) {
72             my $home = (getpwuid($>))[7];
73             $log_file =~ s{^~/}{$home/};
74             open $logfh, ">>", $log_file or die "Can't open $log_file: $!";
75             }
76             else {
77             open $logfh, ">>", $log_file or die "Can't open $log_file: $!";
78             }
79             select($logfh);
80             $| = 1;
81             select(STDOUT);
82             }
83              
84             1;
85              
86             __END__