1package Alien::Build::Plugin::Decode::HTML;
2
3use strict;
4use warnings;
5use 5.008004;
6use Alien::Build::Plugin;
7use File::Basename ();
8
9# ABSTRACT: Plugin to extract links from HTML
10our $VERSION = '2.45'; # VERSION
11
12
13sub init
14{
15  my($self, $meta) = @_;
16
17  $meta->add_requires('share' => 'HTML::LinkExtor' => 0);
18  $meta->add_requires('share' => 'URI' => 0);
19  $meta->add_requires('share' => 'URI::Escape' => 0);
20
21  $meta->register_hook( decode => sub {
22    my(undef, $res) = @_;
23
24    die "do not know how to decode @{[ $res->{type} ]}"
25      unless $res->{type} eq 'html';
26
27    my $base = URI->new($res->{base});
28
29    my @list;
30
31    my $p = HTML::LinkExtor->new(sub {
32      my($tag, %links) = @_;
33      if($tag eq 'base' && $links{href})
34      {
35        $base = URI->new($links{href});
36      }
37      elsif($tag eq 'a' && $links{href})
38      {
39        my $href = $links{href};
40        return if $href =~ m!^\.\.?/?$!;
41        my $url = URI->new_abs($href, $base);
42        my $path = $url->path;
43        $path =~ s{/$}{}; # work around for Perl 5.8.7- gh#8
44        push @list, {
45          filename => URI::Escape::uri_unescape(File::Basename::basename($path)),
46          url      => URI::Escape::uri_unescape($url->as_string),
47        };
48      }
49    });
50
51    $p->parse($res->{content});
52
53    return {
54      type => 'list',
55      list => \@list,
56    };
57  });
58
59  $self;
60}
61
621;
63
64__END__
65
66=pod
67
68=encoding UTF-8
69
70=head1 NAME
71
72Alien::Build::Plugin::Decode::HTML - Plugin to extract links from HTML
73
74=head1 VERSION
75
76version 2.45
77
78=head1 SYNOPSIS
79
80 use alienfile;
81 plugin 'Decode::HTML';
82
83=head1 DESCRIPTION
84
85Note: in most case you will want to use L<Alien::Build::Plugin::Download::Negotiate>
86instead.  It picks the appropriate decode plugin based on your platform and environment.
87In some cases you may need to use this plugin directly instead.
88
89This plugin decodes an HTML file listing into a list of candidates for your Prefer plugin.
90
91=head1 SEE ALSO
92
93L<Alien::Build::Plugin::Download::Negotiate>, L<Alien::Build>, L<alienfile>, L<Alien::Build::MM>, L<Alien>
94
95=head1 AUTHOR
96
97Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
98
99Contributors:
100
101Diab Jerius (DJERIUS)
102
103Roy Storey (KIWIROY)
104
105Ilya Pavlov
106
107David Mertens (run4flat)
108
109Mark Nunberg (mordy, mnunberg)
110
111Christian Walde (Mithaldu)
112
113Brian Wightman (MidLifeXis)
114
115Zaki Mughal (zmughal)
116
117mohawk (mohawk2, ETJ)
118
119Vikas N Kumar (vikasnkumar)
120
121Flavio Poletti (polettix)
122
123Salvador Fandiño (salva)
124
125Gianni Ceccarelli (dakkar)
126
127Pavel Shaydo (zwon, trinitum)
128
129Kang-min Liu (劉康民, gugod)
130
131Nicholas Shipp (nshp)
132
133Juan Julián Merelo Guervós (JJ)
134
135Joel Berger (JBERGER)
136
137Petr Písař (ppisar)
138
139Lance Wicks (LANCEW)
140
141Ahmad Fatoum (a3f, ATHREEF)
142
143José Joaquín Atria (JJATRIA)
144
145Duke Leto (LETO)
146
147Shoichi Kaji (SKAJI)
148
149Shawn Laffan (SLAFFAN)
150
151Paul Evans (leonerd, PEVANS)
152
153Håkon Hægland (hakonhagland, HAKONH)
154
155nick nauwelaerts (INPHOBIA)
156
157=head1 COPYRIGHT AND LICENSE
158
159This software is copyright (c) 2011-2020 by Graham Ollis.
160
161This is free software; you can redistribute it and/or modify it under
162the same terms as the Perl 5 programming language system itself.
163
164=cut
165