File Coverage

lib/HTTP/Command/Wrapper/Curl.pm
Criterion Covered Total %
statement 33 33 100.0
branch 14 14 100.0
condition n/a
subroutine 11 11 100.0
pod 0 4 0.0
total 58 62 93.5


line stmt bran cond sub pod time code
1             package HTTP::Command::Wrapper::Curl;
2 9     9   192656 use strict;
  9         9  
  9         215  
3 9     9   26 use warnings;
  9         8  
  9         150  
4 9     9   25 use utf8;
  9         7  
  9         33  
5              
6             sub new {
7 13     13 0 134407 my ($class, $opt) = @_;
8 13         63 return bless { opt => $opt } => $class;
9             }
10              
11             sub fetch_able {
12 2     2 0 6506 my ($self, $url, $headers) = @_;
13              
14 2         12 my $command = $self->_build($headers, 1, [ '--head', qq/"$url"/ ]);
15 2         15660 `$command` =~ m/200 OK/;
16             }
17              
18             sub fetch {
19 1     1 0 7 my ($self, $url, $headers) = @_;
20              
21 1         11 my $command = $self->_build($headers, 1, [ qq/"$url"/ ]);
22 1         8057 `$command`;
23             }
24              
25             sub download {
26 1     1 0 11 my ($self, $url, $path, $headers) = @_;
27              
28 1         10 my $command = $self->_build($headers, 0, [ qq/"$url"/, '-o', qq/"$path"/ ]);
29 1         9758 system($command) == 0;
30             }
31              
32             sub _build {
33 11     11   25 my ($self, $headers, $quiet, $opts) = @_;
34 11 100       22 my @args = (
    100          
    100          
35             'curl',
36             '-L',
37             $self->_headers($headers),
38             $quiet ? undef : $self->_verbose,
39             $quiet ? '--silent' : $self->_quiet,
40             defined $opts ? @$opts : undef,
41             );
42 11         20 return join(' ', grep { $_ } @args);
  60         82  
43             }
44              
45             sub _headers {
46 12     12   19 my ($self, $headers) = @_;
47 12 100       71 return unless defined $headers;
48 8 100       27 return if @$headers == 0;
49 2         4 return map { "-H \"$_\"" } @$headers;
  2         14  
50             }
51              
52             sub _verbose {
53 6     6   7 my $self = shift;
54 6 100       28 return $self->{opt}->{verbose} ? '--verbose' : '';
55             }
56              
57             sub _quiet {
58 6     6   9 my $self = shift;
59 6 100       34 return $self->{opt}->{quiet} ? '--silent' : '';
60             }
61              
62             1;