1package Alien::Build::Plugin::Decode::Mojo;
2
3use strict;
4use warnings;
5use 5.008004;
6use Alien::Build::Plugin;
7
8# ABSTRACT: Plugin to extract links from HTML using Mojo::DOM or Mojo::DOM58
9our $VERSION = '2.45'; # VERSION
10
11
12sub _load ($;$)
13{
14  my($class, $version) = @_;
15  my $pm = "$class.pm";
16  $pm =~ s/::/\//g;
17  eval { require $pm };
18  return 0 if $@;
19  if(defined $version)
20  {
21    eval { $class->VERSION($version) };
22    return 0 if $@;
23  }
24  return 1;
25}
26
27has _class => sub {
28  return 'Mojo::DOM58' if _load 'Mojo::DOM58';
29  return 'Mojo::DOM'   if _load 'Mojo::DOM' and _load 'Mojolicious', 7.00;
30  return 'Mojo::DOM58';
31};
32
33sub init
34{
35  my($self, $meta) = @_;
36
37  $meta->add_requires('share' => 'URI' => 0);
38  $meta->add_requires('share' => 'URI::Escape' => 0);
39
40  my $class = $meta->prop->{plugin_decode_mojo_class} ||= $self->_class;
41
42  if($class eq 'Mojo::DOM58')
43  {
44    $meta->add_requires('share' => 'Mojo::DOM58' => '1.00');
45  }
46  elsif($class eq 'Mojo::DOM')
47  {
48    $meta->add_requires('share' => 'Mojolicious' => '7.00');
49    $meta->add_requires('share' => 'Mojo::DOM'   => '0');
50  }
51  else
52  {
53    die "bad class";
54  }
55
56  $meta->register_hook( decode => sub {
57    my(undef, $res) = @_;
58
59    die "do not know how to decode @{[ $res->{type} ]}"
60      unless $res->{type} eq 'html';
61
62    my $dom = $class->new($res->{content});
63
64    my $base = URI->new($res->{base});
65
66    if(my $base_element = $dom->find('head base')->first)
67    {
68      my $href = $base_element->attr('href');
69      $base = URI->new($href) if defined $href;
70    }
71
72    my @list = map {
73                 my $url = URI->new_abs($_, $base);
74                 my $path = $url->path;
75                 $path =~ s{/$}{}; # work around for Perl 5.8.7- gh#8
76                 {
77                   filename => URI::Escape::uri_unescape(File::Basename::basename($path)),
78                   url      => URI::Escape::uri_unescape($url->as_string),
79                 }
80               }
81               grep !/^\.\.?\/?$/,
82               map { $_->attr('href') || () }
83               @{ $dom->find('a')->to_array };
84
85    return {
86      type => 'list',
87      list => \@list,
88    };
89  })
90
91
92}
93
941;
95
96__END__
97
98=pod
99
100=encoding UTF-8
101
102=head1 NAME
103
104Alien::Build::Plugin::Decode::Mojo - Plugin to extract links from HTML using Mojo::DOM or Mojo::DOM58
105
106=head1 VERSION
107
108version 2.45
109
110=head1 SYNOPSIS
111
112 use alienfile;
113 plugin 'Decode::Mojo';
114
115Force using C<Decode::Mojo> via the download negotiator:
116
117 use alienfile 1.68;
118
119 configure {
120   requires 'Alien::Build::Plugin::Decode::Mojo';
121 };
122
123 plugin 'Download' => (
124   ...
125   decoder => 'Decode::Mojo',
126 );
127
128=head1 DESCRIPTION
129
130Note: in most cases you will want to use L<Alien::Build::Plugin::Download::Negotiate>
131instead.  It picks the appropriate decode plugin based on your platform and environment.
132In some cases you may need to use this plugin directly instead.
133
134This plugin decodes an HTML file listing into a list of candidates for your Prefer plugin.
135It works just like L<Alien::Build::Plugin::Decode::HTML> except it uses either L<Mojo::DOM>
136or L<Mojo::DOM58> to do its job.
137
138This plugin is much lighter than The C<Decode::HTML> plugin, and doesn't require XS.  It
139is the default decode plugin used by L<Alien::Build::Plugin::Download::Negotiate> if it
140detects that you need to parse an HTML index.
141
142=head1 AUTHOR
143
144Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
145
146Contributors:
147
148Diab Jerius (DJERIUS)
149
150Roy Storey (KIWIROY)
151
152Ilya Pavlov
153
154David Mertens (run4flat)
155
156Mark Nunberg (mordy, mnunberg)
157
158Christian Walde (Mithaldu)
159
160Brian Wightman (MidLifeXis)
161
162Zaki Mughal (zmughal)
163
164mohawk (mohawk2, ETJ)
165
166Vikas N Kumar (vikasnkumar)
167
168Flavio Poletti (polettix)
169
170Salvador Fandiño (salva)
171
172Gianni Ceccarelli (dakkar)
173
174Pavel Shaydo (zwon, trinitum)
175
176Kang-min Liu (劉康民, gugod)
177
178Nicholas Shipp (nshp)
179
180Juan Julián Merelo Guervós (JJ)
181
182Joel Berger (JBERGER)
183
184Petr Písař (ppisar)
185
186Lance Wicks (LANCEW)
187
188Ahmad Fatoum (a3f, ATHREEF)
189
190José Joaquín Atria (JJATRIA)
191
192Duke Leto (LETO)
193
194Shoichi Kaji (SKAJI)
195
196Shawn Laffan (SLAFFAN)
197
198Paul Evans (leonerd, PEVANS)
199
200Håkon Hægland (hakonhagland, HAKONH)
201
202nick nauwelaerts (INPHOBIA)
203
204=head1 COPYRIGHT AND LICENSE
205
206This software is copyright (c) 2011-2020 by Graham Ollis.
207
208This is free software; you can redistribute it and/or modify it under
209the same terms as the Perl 5 programming language system itself.
210
211=cut
212