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   201583 use strict;
  9         9  
  9         201  
3 9     9   26 use warnings;
  9         10  
  9         145  
4 9     9   23 use utf8;
  9         8  
  9         30  
5              
6             sub new {
7 13     13 0 188320 my ($class, $opt) = @_;
8 13         61 return bless { opt => $opt } => $class;
9             }
10              
11             sub fetch_able {
12 2     2 0 26025 my ($self, $url, $headers) = @_;
13              
14 2         36 my $command = $self->_build($headers, 1, [ '--head', qq/"$url"/ ]);
15 2         68742 `$command` =~ m/200 OK/;
16             }
17              
18             sub fetch {
19 1     1 0 4 my ($self, $url, $headers) = @_;
20              
21 1         7 my $command = $self->_build($headers, 1, [ qq/"$url"/ ]);
22 1         7552 `$command`;
23             }
24              
25             sub download {
26 1     1 0 12 my ($self, $url, $path, $headers) = @_;
27              
28 1         11 my $command = $self->_build($headers, 0, [ qq/"$url"/, '-o', qq/"$path"/ ]);
29 1         7599 system($command) == 0;
30             }
31              
32             sub _build {
33 11     11   28 my ($self, $headers, $quiet, $opts) = @_;
34 11 100       27 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         19 return join(' ', grep { $_ } @args);
  60         93  
43             }
44              
45             sub _headers {
46 12     12   21 my ($self, $headers) = @_;
47 12 100       95 return unless defined $headers;
48 8 100       26 return if @$headers == 0;
49 2         4 return map { "-H \"$_\"" } @$headers;
  2         12  
50             }
51              
52             sub _verbose {
53 6     6   5 my $self = shift;
54 6 100       28 return $self->{opt}->{verbose} ? '--verbose' : '';
55             }
56              
57             sub _quiet {
58 6     6   6 my $self = shift;
59 6 100       25 return $self->{opt}->{quiet} ? '--silent' : '';
60             }
61              
62             1;