File Coverage

blib/lib/MooX/Role/CachedURL.pm
Criterion Covered Total %
statement 45 54 83.3
branch 12 18 66.6
condition 2 3 66.6
subroutine 11 11 100.0
pod 0 3 0.0
total 70 89 78.6


line stmt bran cond sub pod time code
1             package MooX::Role::CachedURL;
2             $MooX::Role::CachedURL::VERSION = '0.06';
3 5     5   175081 use 5.006;
  5         18  
  5         185  
4 5     5   4318 use Moo::Role;
  5         156582  
  5         36  
5 5     5   6345 use File::HomeDir;
  5         45048  
  5         444  
6 5     5   4880 use File::Spec::Functions 'catfile';
  5         4660  
  5         385  
7 5     5   6758 use HTTP::Tiny;
  5         341554  
  5         217  
8 5     5   4471 use Time::Duration::Parse qw/ parse_duration /;
  5         11598  
  5         31  
9 5     5   252 use Carp;
  5         9  
  5         2914  
10              
11             has 'url' => (is => 'ro');
12             has 'path' => (is => 'ro');
13             has 'cache_path' => (is => 'rw');
14             has 'max_age' => (is => 'ro');
15              
16             sub BUILD
17             {
18 5     5 0 18923 my $self = shift;
19              
20 5 100       42 if ($self->path) {
21 2 50       87 return if -f $self->path;
22 0         0 croak "the file you specified with 'path' doesn't exist";
23             }
24              
25             # If constructor didn't specify a local file, then mirror the file
26 3 50       32 if (not $self->cache_path) {
27 0         0 my $basename = $self->url;
28 0         0 $basename =~ s!^.*[/\\]!!;
29              
30 0         0 my $classid = ref($self);
31 0         0 $classid =~ s/::/-/g;
32              
33 0         0 $self->cache_path( catfile(File::HomeDir->my_dist_data( $classid, { create => 1 } ), $basename) );
34             }
35              
36 3 100 66     64 if (-f $self->cache_path && defined($self->max_age)) {
37 1         10 my $max_age_in_seconds = parse_duration($self->max_age);
38 1 50       56 return unless time() - $max_age_in_seconds > (stat($self->cache_path))[9];
39             }
40              
41 3         7 my $response;
42 3         7 eval { $response = HTTP::Tiny->new()->mirror($self->url, $self->cache_path) };
  3         29  
43 3 50       162326 if (not $response->{success}) {
44 0         0 croak "failed to mirror @{[ $self->url ]}: $response->{status} $response->{reason}";
  0         0  
45             }
46              
47             }
48              
49             sub open_file
50             {
51 2     2 0 1445 my $self = shift;
52              
53 2         4 my $layers = ':encoding(UTF-8)';
54 2 50       18 my $filename = defined($self->path)
55             ? $self->path
56             : $self->cache_path;
57              
58 2 100       17 if ($filename =~ /\.gz\z/) {
59 1         611 require PerlIO::gzip;
60 0         0 $layers = ':gzip'.$layers;
61             }
62              
63 1 50   1   30 open(my $fh, '<'.$layers, $filename)
  1         9  
  1         2  
  1         7  
64             || croak "can't open $filename: $!";
65              
66 1         12389 return $fh;
67             }
68              
69             sub close_file
70             {
71 1     1 0 58 my $self = shift;
72 1         3 my $fh = shift;
73              
74 1         15 close($fh);
75             }
76              
77             1;
78              
79             =head1 NAME
80              
81             MooX::Role::CachedURL - a role providing a locally cached copy of a remote file
82              
83             =head1 SYNOPSIS
84              
85             package MyClass;
86             use Moo;
87             with 'MooX::Role::CachedURL';
88             has '+url' => (default => sub { 'http://www.cpan.org/robots.txt' });
89            
90             sub my_method {
91             my $self = shift;
92             my $fh = $self->open_file;
93            
94             while (<$fh>) {
95             ...
96             }
97             $self->close_file($fh);
98             }
99              
100             Then in the user of MyClass:
101              
102             use MyClass;
103             my $object = MyClass->new(max_age => '2 days');
104            
105             print "local file is ", $object->cache_path, "\n";
106              
107             =head1 DESCRIPTION
108              
109             This role represents a remote file that you want to cache locally,
110             and then process.
111             This is common functionality that I'm pulling out of my L,
112             L and L modules.
113              
114             PAUSE::Users provides a simple interface to the C<00whois.xml> file
115             that is generated by PAUSE.
116             It caches the file locally,
117             then provides a mechanism for iterating over all users in the file.
118              
119             =head1 ATTRIBUTES
120              
121             =head2 cache_path
122              
123             The full path to the local file where the content of the remote URL
124             will be cached. You can provide your own path, but if you don't,
125             then an appropriate path for your operating system will be generated.
126              
127             =head2 path
128              
129             A full or relative path to your own copy of the cached content.
130             If you provide this, then your content will be used,
131             without checking the remote URL.
132             If the file you pass doesn't exist, the module will C.
133              
134             =head2 url
135              
136             This specifies the URL that should be cached locally.
137             It should be over-ridden in the composing class, as shown in the SYNOPSIS above.
138              
139             =head2 max_age
140              
141             Specifies the maximum age of the local copy, in seconds.
142             We won't even look for a new remote copy if the cached copy is younger than this.
143              
144             You can specify max_age using any of the notations supported by L.
145             For example:
146              
147             max_age => '2 hours',
148              
149             =head1 Support for gzip'd files
150              
151             If the C or C attribute ends in C<.gz>,
152             then the file is assumed to be gzip'd, and will be transparently handled
153             using L.
154              
155             =head1 TODO
156              
157             =over 4
158              
159             =item * Switch to LWP for general URL handling, not just HTTP
160              
161             =item * Ability for a class to transform content when caching
162              
163             =back
164              
165             =head1 REPOSITORY
166              
167             L
168              
169             =head1 AUTHOR
170              
171             Neil Bowers Eneilb@cpan.orgE
172              
173             =head1 COPYRIGHT AND LICENSE
174              
175             This software is copyright (c) 2014 by Neil Bowers .
176              
177             This is free software; you can redistribute it and/or modify it under
178             the same terms as the Perl 5 programming language system itself.
179              
180             =cut