File Coverage

lib/CGI/CurlLog.pm
Criterion Covered Total %
statement 7 13 53.8
branch 1 2 50.0
condition n/a
subroutine 3 3 100.0
pod n/a
total 11 18 61.1


line stmt bran cond sub pod time code
1             package CGI::CurlLog;
2 1     1   24914 use strict;
  1         2  
  1         32  
3 1     1   3 use warnings;
  1         2  
  1         906  
4              
5             our $VERSION = "0.02";
6              
7             if (!$ENV{"GATEWAY_INTERFACE"}) {
8             return 1;
9             }
10              
11             our $log_file ||= "~/curl.log";
12             our $log_output = defined $log_output ? $log_output : 1;
13             our $curl_options = defined $curl_options ? $curl_options : "-k";
14              
15             my $cmd = "curl ";
16             my $url = $ENV{"HTTPS"} ? "https://" : "http://";
17             $url .= $ENV{"HTTP_HOST"} || $ENV{"SERVER_NAME"} || $ENV{"SERVER_ADDR"};
18             $url .= $ENV{"REQUEST_URI"};
19             if ($url =~ /[=&;?]/) {
20             $cmd .= "\"$url\" ";
21             }
22             else {
23             $cmd .= "$url ";
24             }
25             if ($curl_options) {
26             $cmd .= "$curl_options ";
27             }
28             if ($ENV{"REQUEST_METHOD"}) {
29             if ($ENV{"REQUEST_METHOD"} ne "GET" || $ENV{"CONTENT_LENGTH"}) {
30             $cmd .= "-X $ENV{REQUEST_METHOD} ";
31             }
32             }
33             if ($ENV{"CONTENT_TYPE"}) {
34             $cmd .= "-H \"Content-Type: $ENV{CONTENT_TYPE}\" ";
35             }
36             if ($ENV{"HTTP_ACCEPT"}) {
37             $cmd .= "-H \"Accept: $ENV{HTTP_ACCEPT}\" ";
38             }
39             if ($ENV{"HTTP_AUTHORIZATION"}) {
40             $cmd .= "-H \"Authorization: $ENV{HTTP_AUTHORIZATION}\" ";
41             }
42             if ($ENV{"HTTP_COOKIE"}) {
43             $cmd .= "-H \"Cookie: $ENV{HTTP_COOKIE}\" ";
44             }
45             # if ($ENV{"HTTP_USER_AGENT"}) {
46             # $cmd .= "-H \"UserAgent: $ENV{HTTP_USER_AGENT}\" ";
47             # }
48              
49             if ($ENV{"CONTENT_LENGTH"}) {
50             my $input = do {local $/; };
51             close STDIN;
52             open STDIN, "<", \$input;
53             my $input2 = $input;
54             $input2 =~ s{([\\\$"])}{\\$1}g;
55             $cmd .= "-d \"$input2\" ";
56             }
57             $cmd =~ s/\s*$//;
58              
59             my $logfh;
60             if ($log_file eq "STDOUT") {
61             $logfh = \*STDOUT;
62             }
63             elsif ($log_file eq "STDERR") {
64             $logfh = \*STDERR;
65             }
66             elsif ($log_file =~ m{^~/}) {
67             my $home = (getpwuid($>))[7];
68             $log_file =~ s{^~/}{$home/};
69             open $logfh, ">>", $log_file or die "Can't open $log_file: $!";
70             }
71             else {
72             open $logfh, ">>", $log_file or die "Can't open $log_file: $!";
73             }
74             select($logfh);
75             $| = 1;
76             select(STDOUT);
77              
78             print $logfh "# " . localtime() . " request from $ENV{REMOTE_ADDR}\n";
79             print $logfh "$cmd\n";
80             if (!$log_output) {
81             close $logfh;
82             }
83              
84             my $stdout;
85             my $output = "";
86              
87             if ($log_output) {
88             open $stdout, ">&", STDOUT;
89             close STDOUT;
90             open STDOUT, ">", \$output;
91             }
92              
93             END {
94 1 50   1   797 return if !$log_output;
95 0           open STDOUT, ">&", $stdout;
96 0           print $output;
97 0           $output =~ s/\r//g;
98 0           print $logfh "# " . localtime() . " response\n";
99 0           print $logfh $output . "\n";
100 0           close $logfh;
101             }
102              
103             1;
104              
105             __END__