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__ |