File Coverage

blib/lib/Alien/Build/Plugin/Fetch/Rewrite.pm
Criterion Covered Total %
statement 39 42 92.8
branch 4 6 66.6
condition 2 3 66.6
subroutine 10 10 100.0
pod 1 1 100.0
total 56 62 90.3


line stmt bran cond sub pod time code
1             package Alien::Build::Plugin::Fetch::Rewrite;
2              
3 2     2   178448 use strict;
  2         7  
  2         55  
4 2     2   10 use warnings;
  2         5  
  2         47  
5 2     2   36 use 5.008001;
  2         9  
6 2     2   918 use URI;
  2         6964  
  2         50  
7 2     2   881 use Alien::Build;
  2         63682  
  2         54  
8 2     2   750 use Alien::Build::Plugin;
  2         3858  
  2         11  
9 2     2   961 use Alien::Build::Plugin::Fetch::LWP;
  2         886  
  2         12  
10 2     2   890 use Alien::Build::Plugin::Decode::HTML;
  2         805  
  2         15  
11              
12             # ABSTRACT: Alien::Build plugin to rewrite network requests to local resources
13             our $VERSION = '0.01'; # VERSION
14              
15              
16             sub init
17             {
18 1     1 1 11392 my($self, $meta) = @_;
19             # this just lets people know that we have loaded
20             # this plugin.
21 1         13 Alien::Build->log("init");
22              
23 1 50       11 unless($meta->prop->{start_url})
24             {
25 0         0 Alien::Build->log("sorry! this plugin requires a default url to function");
26 0         0 Alien::Build->log("no rewrites will be possible");
27 0         0 return;
28             }
29              
30 1         17 Alien::Build::Plugin::Fetch::LWP->new->init($meta);
31 1         107 Alien::Build::Plugin::Decode::HTML->new->init($meta);
32              
33             $meta->around_hook(fetch => sub {
34 6     6   108469 my($f, $build, $url) = @_;
35              
36 6   66     35 $url ||= $build->meta_prop->{start_url};
37              
38 6 100       110 if(Alien::Build::rc->can('rewrite'))
39             {
40 4         24 my $orig = URI->new($url);
41 4         4923 my $copy = $orig->clone;
42 4         95 Alien::Build::rc::rewrite($build, $copy);
43 4 50       1972 if("$copy" ne "$orig")
44             {
45 4         45 $build->log("rewriting $orig as $copy");
46 4         198 $url = "$copy";
47             }
48             }
49            
50 6         43 return $f->($build, $url);
51 1         85 });
52             }
53              
54             1;
55              
56             __END__