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