File Coverage

blib/lib/Pinto/Role/UserAgent.pm
Criterion Covered Total %
statement 40 48 83.3
branch 4 8 50.0
condition n/a
subroutine 12 14 85.7
pod 2 4 50.0
total 58 74 78.3


line stmt bran cond sub pod time code
1             # ABSTRACT: Something that makes network requests
2              
3             package Pinto::Role::UserAgent;
4              
5 56     56   30270 use Moose::Role;
  56         135  
  56         463  
6 56     56   279953 use MooseX::MarkAsMethods ( autoclean => 1 );
  56         137  
  56         522  
7              
8 56     56   413777 use URI;
  56         132  
  56         1318  
9 56     56   301 use Path::Class;
  56         130  
  56         3700  
10 56     56   336 use LWP::UserAgent;
  56         122  
  56         1553  
11 56     56   311 use HTTP::Status qw(:constants);
  56         114  
  56         23498  
12              
13 56     56   384 use Pinto::Globals;
  56         112  
  56         1709  
14 56     56   290 use Pinto::Util qw(debug throw tempdir make_uri);
  56         131  
  56         23078  
15              
16             #-----------------------------------------------------------------------------
17              
18             our $VERSION = '0.14'; # VERSION
19              
20             #-----------------------------------------------------------------------------
21              
22              
23             sub mirror {
24 196     196 1 674 my ( $self, $from, $to ) = @_;
25              
26 196         1601 $from = make_uri($from);
27 196         145534 $to = file($to);
28              
29 196 100       24727 $to->parent->mkpath if not -e $to->parent;
30 196         54285 my $response = $Pinto::Globals::UA->mirror( $from => $to );
31            
32 196 50       1182009 return 1 if $response->is_success;
33 0 0       0 return 0 if $response->code == HTTP_NOT_MODIFIED;
34              
35 0         0 throw "Failed to mirror $from: " . $response->status_line;
36             }
37              
38             #------------------------------------------------------------------------------
39              
40              
41             sub mirror_temporary {
42 50     50 1 238 my ( $self, $uri ) = @_;
43              
44 50         357 $uri = URI->new( $uri )->canonical;
45 50         7602 my $path = file( $uri->path );
46 50 50       8269 return $path if $uri->scheme() eq 'file';
47              
48 0         0 my $base = $path->basename;
49 0         0 my $tempfile = file( tempdir, $base );
50              
51 0         0 $self->mirror( $uri => $tempfile );
52              
53 0         0 return file($tempfile);
54             }
55              
56             #------------------------------------------------------------------------------
57             # TODO: Consider a better interface to the UA
58              
59             sub head {
60 5     5 0 17 my ($self, @args) = @_;
61              
62             # TODO: Argument check?
63 5     0   50 debug sub { $args[0]->as_string(0) };
  0         0  
64 5         49 return $Pinto::Globals::UA->head(@args);
65             }
66              
67             #------------------------------------------------------------------------------
68             # TODO: Consider a better interface to the UA
69              
70             sub request {
71 9     9 0 1112 my ($self, @args) = @_;
72              
73             # TODO: Argument check?
74 9     0   87 debug sub { $args[0]->as_string(0) };
  0         0  
75 9         74 return $Pinto::Globals::UA->request(@args);
76             }
77              
78             #-----------------------------------------------------------------------------
79             1;
80              
81             __END__
82              
83             =pod
84              
85             =encoding UTF-8
86              
87             =for :stopwords Jeffrey Ryan Thalhammer
88              
89             =head1 NAME
90              
91             Pinto::Role::UserAgent - Something that makes network requests
92              
93             =head1 VERSION
94              
95             version 0.14
96              
97             =head1 METHODS
98              
99             =head2 mirror(RESOURCE => PATH)
100              
101             Mirrors the resource located at C<from> to the file located at PATH, if the
102             RESOURCE is newer than the file at PATH. If the intervening directories do
103             not exist, they will be created for you. Returns a true value if the file has
104             changed, returns false if it has not changed. Throws an exception if anything
105             goes wrong.
106              
107             The RESOURCE can be either a L<URI> or L<Path::Class::File> object, or a
108             string that represents either of those. The PATH can be a
109             L<Path::Class::File> object or a string that represents one.
110              
111             =head2 mirror_temporary(RESOURCE)
112              
113             Mirrors RESOURCE to a file in a temporary directory. The file will have the
114             same basename as the RESOURCE. Returns a L<Path::Class::File> that points to
115             the new file. Throws and exception if anything goes wrong. Note the
116             temporary directory and all its contents will be deleted when the process
117             terminates.
118              
119             =head1 AUTHOR
120              
121             Jeffrey Ryan Thalhammer <jeff@stratopan.com>
122              
123             =head1 COPYRIGHT AND LICENSE
124              
125             This software is copyright (c) 2015 by Jeffrey Ryan Thalhammer.
126              
127             This is free software; you can redistribute it and/or modify it under
128             the same terms as the Perl 5 programming language system itself.
129              
130             =cut