File Coverage

blib/lib/Alien/Build/Plugin/Decode/HTML.pm
Criterion Covered Total %
statement 36 37 97.3
branch 6 8 75.0
condition 3 6 50.0
subroutine 7 7 100.0
pod 1 1 100.0
total 53 59 89.8


line stmt bran cond sub pod time code
1             package Alien::Build::Plugin::Decode::HTML;
2              
3 3     3   1298 use strict;
  3         7  
  3         90  
4 3     3   15 use warnings;
  3         5  
  3         67  
5 3     3   44 use 5.008004;
  3         11  
6 3     3   709 use Alien::Build::Plugin;
  3         6  
  3         17  
7 3     3   19 use File::Basename ();
  3         6  
  3         1250  
8              
9             # ABSTRACT: Plugin to extract links from HTML
10             our $VERSION = '2.45'; # VERSION
11              
12              
13             sub init
14             {
15 6     6 1 23 my($self, $meta) = @_;
16              
17 6         19 $meta->add_requires('share' => 'HTML::LinkExtor' => 0);
18 6         16 $meta->add_requires('share' => 'URI' => 0);
19 6         16 $meta->add_requires('share' => 'URI::Escape' => 0);
20              
21             $meta->register_hook( decode => sub {
22 3     3   11 my(undef, $res) = @_;
23              
24 0         0 die "do not know how to decode @{[ $res->{type} ]}"
25 3 50       15 unless $res->{type} eq 'html';
26              
27 3         33 my $base = URI->new($res->{base});
28              
29 3         10725 my @list;
30              
31             my $p = HTML::LinkExtor->new(sub {
32 29         5991 my($tag, %links) = @_;
33 29 100 66     157 if($tag eq 'base' && $links{href})
    50 33        
34             {
35 1         5 $base = URI->new($links{href});
36             }
37             elsif($tag eq 'a' && $links{href})
38             {
39 28         49 my $href = $links{href};
40 28 100       110 return if $href =~ m!^\.\.?/?$!;
41 24         70 my $url = URI->new_abs($href, $base);
42 24         6599 my $path = $url->path;
43 24         257 $path =~ s{/$}{}; # work around for Perl 5.8.7- gh#8
44 24         696 push @list, {
45             filename => URI::Escape::uri_unescape(File::Basename::basename($path)),
46             url => URI::Escape::uri_unescape($url->as_string),
47             };
48             }
49 3         53 });
50              
51 3         408 $p->parse($res->{content});
52              
53             return {
54 3         284 type => 'list',
55             list => \@list,
56             };
57 6         39 });
58              
59 6         10 $self;
60             }
61              
62             1;
63              
64             __END__