line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Alien::Build::Plugin::Decode::Mojo; |
2
|
|
|
|
|
|
|
|
3
|
2
|
|
|
2
|
|
225248
|
use strict; |
|
2
|
|
|
|
|
10
|
|
|
2
|
|
|
|
|
60
|
|
4
|
2
|
|
|
2
|
|
25
|
use warnings; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
47
|
|
5
|
2
|
|
|
2
|
|
42
|
use 5.008001; |
|
2
|
|
|
|
|
7
|
|
6
|
2
|
|
|
2
|
|
904
|
use Alien::Build::Plugin; |
|
2
|
|
|
|
|
5220
|
|
|
2
|
|
|
|
|
14
|
|
7
|
2
|
|
|
2
|
|
188
|
use Module::Load (); |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
1091
|
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
# ABSTRACT: Plugin to extract links from HTML using Mojo::DOM or Mojo::DOM58 |
10
|
|
|
|
|
|
|
our $VERSION = '0.02'; # VERSION |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
sub _load ($) |
14
|
|
|
|
|
|
|
{ |
15
|
2
|
|
|
2
|
|
6
|
eval { Module::Load::load($_[0]) }; |
|
2
|
|
|
|
|
9
|
|
16
|
2
|
50
|
|
|
|
629
|
$@ eq '' ? 1 : 0; |
17
|
|
|
|
|
|
|
} |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
has _class => sub { |
20
|
|
|
|
|
|
|
return 'Mojo::DOM58' if _load 'Mojo::DOM58'; |
21
|
|
|
|
|
|
|
return 'Mojo::DOM' if _load 'Mojo::DOM' && _load 'Mojolicious' && eval { Mojolicious->VERSION('7.00') }; |
22
|
|
|
|
|
|
|
return 'Mojo::DOM58'; |
23
|
|
|
|
|
|
|
}; |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
sub init |
26
|
|
|
|
|
|
|
{ |
27
|
3
|
|
|
3
|
1
|
23545
|
my($self, $meta) = @_; |
28
|
|
|
|
|
|
|
|
29
|
3
|
|
|
|
|
15
|
$meta->add_requires('share' => 'URI' => 0); |
30
|
3
|
|
|
|
|
51
|
$meta->add_requires('share' => 'URI::Escape' => 0); |
31
|
|
|
|
|
|
|
|
32
|
3
|
100
|
|
|
|
44
|
if($self->_class eq 'Mojo::DOM58') |
|
|
50
|
|
|
|
|
|
33
|
|
|
|
|
|
|
{ |
34
|
2
|
|
|
|
|
34
|
$meta->add_requires('share' => 'Mojo::DOM58' => '1.00'); |
35
|
|
|
|
|
|
|
} |
36
|
|
|
|
|
|
|
elsif($self->_class eq 'Mojo::DOM') |
37
|
|
|
|
|
|
|
{ |
38
|
1
|
|
|
|
|
18
|
$meta->add_requires('share' => 'Mojolicious' => '7.00'); |
39
|
1
|
|
|
|
|
14
|
$meta->add_requires('share' => 'Mojo::DOM' => '0'); |
40
|
|
|
|
|
|
|
} |
41
|
|
|
|
|
|
|
else |
42
|
|
|
|
|
|
|
{ |
43
|
0
|
|
|
|
|
0
|
die "bad class"; |
44
|
|
|
|
|
|
|
} |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
$meta->register_hook( decode => sub { |
47
|
0
|
|
|
0
|
|
|
my(undef, $res) = @_; |
48
|
|
|
|
|
|
|
|
49
|
0
|
|
|
|
|
|
die "do not know how to decode @{[ $res->{type} ]}" |
50
|
0
|
0
|
|
|
|
|
unless $res->{type} eq 'html'; |
51
|
|
|
|
|
|
|
|
52
|
0
|
|
|
|
|
|
my $dom = $self->_class->new($res->{content}); |
53
|
|
|
|
|
|
|
|
54
|
0
|
|
|
|
|
|
my $base = URI->new($res->{base}); |
55
|
|
|
|
|
|
|
|
56
|
0
|
0
|
|
|
|
|
if(my $base_element = $dom->find('head base')->first) |
57
|
|
|
|
|
|
|
{ |
58
|
0
|
|
|
|
|
|
my $href = $base_element->attr('href'); |
59
|
0
|
0
|
|
|
|
|
$base = URI->new($href) if defined $href; |
60
|
|
|
|
|
|
|
} |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
my @list = map { |
63
|
0
|
|
|
|
|
|
my $url = URI->new_abs($_, $base); |
64
|
0
|
|
|
|
|
|
my $path = $url->path; |
65
|
0
|
|
|
|
|
|
$path =~ s{/$}{}; # work around for Perl 5.8.7- gh#8 |
66
|
|
|
|
|
|
|
{ |
67
|
0
|
|
|
|
|
|
filename => URI::Escape::uri_unescape(File::Basename::basename($path)), |
68
|
|
|
|
|
|
|
url => URI::Escape::uri_unescape($url->as_string), |
69
|
|
|
|
|
|
|
} |
70
|
|
|
|
|
|
|
} |
71
|
|
|
|
|
|
|
grep !/^\.\.?\/?$/, |
72
|
0
|
0
|
|
|
|
|
map { $_->attr('href') || () } |
73
|
0
|
|
|
|
|
|
@{ $dom->find('a')->to_array }; |
|
0
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
return { |
76
|
0
|
|
|
|
|
|
type => 'list', |
77
|
|
|
|
|
|
|
list => \@list, |
78
|
|
|
|
|
|
|
}; |
79
|
|
|
|
|
|
|
}) |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
|
82
|
3
|
|
|
|
|
56
|
} |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
1; |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
__END__ |