1package Alien::Build::Plugin::Fetch::Wget;
2
3use strict;
4use warnings;
5use 5.008004;
6use Alien::Build::Plugin;
7use File::Temp qw( tempdir );
8use Path::Tiny qw( path );
9use File::Which qw( which );
10use Capture::Tiny qw( capture capture_merged );
11use File::chdir;
12use List::Util qw( pairmap );
13
14# ABSTRACT: Plugin for fetching files using wget
15our $VERSION = '2.45'; # VERSION
16
17
18sub _wget
19{
20  my $wget = defined $ENV{WGET} ? which($ENV{WGET}) : which('wget');
21  return undef unless defined $wget;
22  my $output = capture_merged { system $wget, '--help' };
23
24  # The wget that BusyBox implements does not follow that same interface
25  # as GNU wget and may not check ssl certs which is not good.
26  return undef if $output =~ /BusyBox/;
27  return $wget;
28}
29
30has wget_command => sub { _wget() };
31has ssl => 0;
32
33# when bootstrapping we have to specify this plugin as a prereq
34# 1 is the default so that when this plugin is used directly
35# you also get the prereq
36has bootstrap_ssl => 1;
37
38sub init
39{
40  my($self, $meta) = @_;
41
42  $meta->add_requires('configure', 'Alien::Build::Plugin::Fetch::Wget' => '1.19')
43    if $self->bootstrap_ssl;
44
45  $meta->register_hook(
46    fetch => sub {
47      my($build, $url, %options) = @_;
48      $url ||= $meta->prop->{start_url};
49
50      my($scheme) = $url =~ /^([a-z0-9]+):/i;
51
52      if($scheme eq 'http' || $scheme eq 'https')
53      {
54        local $CWD = tempdir( CLEANUP => 1 );
55
56        my @headers;
57        if(my $headers = $options{http_headers})
58        {
59          if(ref $headers eq 'ARRAY')
60          {
61            my @copy = @$headers;
62            my %headers;
63            while(@copy)
64            {
65              my $key = shift @copy;
66              my $value = shift @copy;
67              push @{ $headers{$key} }, $value;
68            }
69            @headers = pairmap { "--header=$a: @{[ join ', ', @$b ]}" } %headers;
70          }
71          else
72          {
73            $build->log("Fetch for $url with http_headers that is not an array reference");
74          }
75        }
76
77        my($stdout, $stderr) = $self->_execute(
78          $build,
79          $self->wget_command,
80          '-k', '--content-disposition', '-S',
81          @headers,
82          $url,
83        );
84
85        my($path) = path('.')->children;
86        die "no file found after wget" unless $path;
87        my($type) = $stderr =~ /Content-Type:\s*(.*?)$/m;
88        $type =~ s/;.*$// if $type;
89        if($type eq 'text/html')
90        {
91          return {
92            type    => 'html',
93            base    => $url,
94            content => scalar $path->slurp,
95          };
96        }
97        else
98        {
99          return {
100            type     => 'file',
101            filename => $path->basename,
102            path     => $path->absolute->stringify,
103          };
104        }
105      }
106      else
107      {
108        die "scheme $scheme is not supported by the Fetch::Wget plugin";
109      }
110    },
111  ) if $self->wget_command;
112}
113
114sub _execute
115{
116  my($self, $build, @command) = @_;
117  $build->log("+ @command");
118  my($stdout, $stderr, $err) = capture {
119    system @command;
120    $?;
121  };
122  if($err)
123  {
124    chomp $stderr;
125    $stderr = [split /\n/, $stderr]->[-1];
126    die "error in wget fetch: $stderr";
127  }
128  ($stdout, $stderr);
129}
130
1311;
132
133__END__
134
135=pod
136
137=encoding UTF-8
138
139=head1 NAME
140
141Alien::Build::Plugin::Fetch::Wget - Plugin for fetching files using wget
142
143=head1 VERSION
144
145version 2.45
146
147=head1 SYNOPSIS
148
149 use alienfile;
150
151 share {
152   start_url 'https://www.openssl.org/source/';
153   plugin 'Fetch::Wget';
154 };
155
156=head1 DESCRIPTION
157
158B<WARNING>: This plugin is somewhat experimental at this time.
159
160This plugin provides a fetch based on the C<wget> command.  It works with other fetch
161plugins (that is, the first one which succeeds will be used).  Most of the time the best plugin
162to use will be L<Alien::Build::Plugin::Download::Negotiate>, but for some SSL bootstrapping
163it may be desirable to try C<wget> first.
164
165Protocols supported: C<http>, C<https>
166
167=head1 PROPERTIES
168
169=head2 wget_command
170
171The full path to the C<wget> command.  The default is usually correct.
172
173=head2 ssl
174
175Ignored by this plugin.  Provided for compatibility with some other fetch plugins.
176
177=head1 SEE ALSO
178
179=over 4
180
181=item L<alienfile>
182
183=item L<Alien::Build>
184
185=back
186
187=head1 AUTHOR
188
189Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
190
191Contributors:
192
193Diab Jerius (DJERIUS)
194
195Roy Storey (KIWIROY)
196
197Ilya Pavlov
198
199David Mertens (run4flat)
200
201Mark Nunberg (mordy, mnunberg)
202
203Christian Walde (Mithaldu)
204
205Brian Wightman (MidLifeXis)
206
207Zaki Mughal (zmughal)
208
209mohawk (mohawk2, ETJ)
210
211Vikas N Kumar (vikasnkumar)
212
213Flavio Poletti (polettix)
214
215Salvador Fandiño (salva)
216
217Gianni Ceccarelli (dakkar)
218
219Pavel Shaydo (zwon, trinitum)
220
221Kang-min Liu (劉康民, gugod)
222
223Nicholas Shipp (nshp)
224
225Juan Julián Merelo Guervós (JJ)
226
227Joel Berger (JBERGER)
228
229Petr Písař (ppisar)
230
231Lance Wicks (LANCEW)
232
233Ahmad Fatoum (a3f, ATHREEF)
234
235José Joaquín Atria (JJATRIA)
236
237Duke Leto (LETO)
238
239Shoichi Kaji (SKAJI)
240
241Shawn Laffan (SLAFFAN)
242
243Paul Evans (leonerd, PEVANS)
244
245Håkon Hægland (hakonhagland, HAKONH)
246
247nick nauwelaerts (INPHOBIA)
248
249=head1 COPYRIGHT AND LICENSE
250
251This software is copyright (c) 2011-2020 by Graham Ollis.
252
253This is free software; you can redistribute it and/or modify it under
254the same terms as the Perl 5 programming language system itself.
255
256=cut
257