Skip to content

Commit e4275de

Browse files
kraihkraih
committed
Add downloads method to Mojo::File and Mojo::UserAgent::Transactor
1 parent bd690df commit e4275de

File tree

5 files changed

+298
-0
lines changed

5 files changed

+298
-0
lines changed

‎lib/Mojo/File.pm‎

Lines changed: 25 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -38,6 +38,13 @@ sub curfile { __PACKAGE__->new(Cwd::realpath((caller)[1])) }
3838

3939
sub dirname { $_[0]->new(scalar File::Basename::dirname ${$_[0]}) }
4040

41+
sub download {
42+
my ($self, $url, $options) = (shift, shift, shift // {});
43+
my $ua = $options->{ua} || do { require Mojo::UserAgent; Mojo::UserAgent->new };
44+
my $tx = _download_error($ua->transactor->download($ua->head($url => $options->{headers} // {}), $$self));
45+
return $tx ? !!_download_error($ua->start($tx)) : 1;
46+
}
47+
4148
sub extname { shift->basename =~ /.+\.([^.]+)$/ ? $1 : '' }
4249

4350
sub is_abs { file_name_is_absolute ${shift()} }
@@ -177,6 +184,15 @@ sub touch {
177184

178185
sub with_roles { shift->Mojo::Base::with_roles(@_) }
179186

187+
sub _download_error {
188+
my $tx = shift;
189+
190+
return $tx unless my $err = $tx->error;
191+
return undef if $err->{message} eq 'Download complete' || $err->{message} eq 'Download incomplete';
192+
croak "$err->{code} response: $err->{message}" if $err->{code};
193+
croak "Download error: $err->{message}";
194+
}
195+
180196
1;
181197

182198
=encoding utf8
@@ -301,6 +317,15 @@ Return all but the last level of the path with L<File::Basename> as a L<Mojo::Fi
301317
# "/home/sri" (on UNIX)
302318
path('/home/sri/.vimrc')->dirname;
303319
320+
=head2 download
321+
322+
my $bool = $path->download('https://example.com/test.tar.gz');
323+
my $bool = $path->download('https://example.com/test.tar.gz', {headers => {Accept => '*/*'}});
324+
my $bool = $path->download('https://example.com/test.tar.gz', {ua => Mojo::UserAgent->new});
325+
326+
Download file from URL, returns true once the file has been downloaded completely. Incomplete downloads are resumed.
327+
Note that this method is B<EXPERIMENTAL> and might change without warning!
328+
304329
=head2 extname
305330
306331
my $ext = $path->extname;

‎lib/Mojo/UserAgent/Transactor.pm‎

Lines changed: 48 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -20,6 +20,47 @@ has name => 'Mojolicious (Perl)';
2020

2121
sub add_generator { $_[0]->generators->{$_[1]} = $_[2] and return $_[0] }
2222

23+
sub download {
24+
my ($self, $head, $path) = @_;
25+
26+
my $req = $head->req;
27+
my $tx = $self->tx(GET => $req->url->clone => $req->headers->to_hash);
28+
my $res = $tx->res;
29+
if (my $error = $head->error) { $res->error($error) and return $tx }
30+
31+
my $headers = $head->res->headers;
32+
my $accept_ranges = ($headers->accept_ranges // '') =~ /bytes/;
33+
my $size = $headers->content_length // 0;
34+
35+
my $current_size = 0;
36+
my $file = path($path);
37+
if (-f $file) {
38+
$current_size = -s $file;
39+
$res->error({message => 'Unknown file size'}) and return $tx unless $size;
40+
$res->error({message => 'File size mismatch'}) and return $tx if $current_size > $size;
41+
$res->error({message => 'Download complete'}) and return $tx if $current_size == $size;
42+
$res->error({message => 'Server does not support partial requests'}) and return $tx unless $accept_ranges;
43+
$tx->req->headers->range("bytes=$current_size-$size");
44+
}
45+
46+
my $fh = $file->open('>>');
47+
$res->content->unsubscribe('read')->on(
48+
read => sub {
49+
my ($content, $bytes) = @_;
50+
$current_size += length $bytes;
51+
$fh->syswrite($bytes) == length $bytes or $res->error({message => qq/Can't write to file "$path": $!/});
52+
}
53+
);
54+
$res->on(
55+
finish => sub {
56+
my $res = shift;
57+
$res->error({message => 'Download incomplete'}) if $current_size < $size;
58+
}
59+
);
60+
61+
return $tx;
62+
}
63+
2364
sub endpoint {
2465
my ($self, $tx) = @_;
2566

@@ -371,6 +412,13 @@ Register a content generator.
371412
372413
$t->add_generator(foo => sub ($t, $tx, @args) {...});
373414
415+
=head2 download
416+
417+
my $tx = $t->download(Mojo::Transaction::HTTP->new, '/home/sri/test.tar.gz');
418+
419+
Build L<Mojo::Transaction::HTTP> resumable file download request as follow-up to a C<HEAD> request. Note that this
420+
method is B<EXPERIMENTAL> and might change without warning!
421+
374422
=head2 endpoint
375423
376424
my ($proto, $host, $port) = $t->endpoint(Mojo::Transaction::HTTP->new);

‎lib/Mojolicious/Guides/Cookbook.pod‎

Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1300,6 +1300,16 @@ L<Mojo::Message/"save_to">.
13001300
my $tx = $ua->get('https://www.github.com/mojolicious/mojo/tarball/main');
13011301
$tx->result->save_to('mojo.tar.gz');
13021302

1303+
With L<Mojo::File/"download"> you can also stream file downloads directly into the target file. This allows for
1304+
interrupted downloads to be resumed at a later time.
1305+
1306+
use Mojo::File qw(path);
1307+
use Mojo::UserAgent;
1308+
1309+
# Download the latest Mojolicious tarball directly into a file (allow for redirects with custom user agent)
1310+
my $ua = Mojo::UserAgent->new(max_redirects => 5);
1311+
path('/home/sri/mojo.tar.gz')->download('https://www.github.com/mojolicious/mojo/tarball/main', {ua => $ua});
1312+
13031313
To protect you from excessively large files there is also a limit of 2GiB by default, which you can tweak with the
13041314
attribute L<Mojo::UserAgent/"max_response_size">.
13051315

‎t/mojo/file_download.t‎

Lines changed: 131 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,131 @@
1+
use Mojo::Base -strict;
2+
3+
BEGIN { $ENV{MOJO_REACTOR} = 'Mojo::Reactor::Poll' }
4+
5+
use Test::More;
6+
use Mojo::File qw(tempdir);
7+
use Mojo::UserAgent;
8+
use Mojolicious::Lite;
9+
10+
# Silence
11+
app->log->level('trace')->unsubscribe('message');
12+
13+
get '/simple' => sub {
14+
my $c = shift;
15+
$c->res->headers->accept_ranges('bytes');
16+
return $c->render(data => 'CHUNK1CHUNK2CHUNK3');
17+
};
18+
19+
get '/redirect' => sub {
20+
my $c = shift;
21+
return $c->redirect_to('/simple');
22+
};
23+
24+
get '/resume' => sub {
25+
my $c = shift;
26+
$c->res->headers->accept_ranges('bytes');
27+
return $c->render(data => 'CHUNK1CHUNK2CHUNK3') if $c->req->method eq 'HEAD';
28+
my $range = $c->req->headers->range;
29+
return $c->write('CHUNK1')->finish unless $range;
30+
return $c->write('CHUNK2')->finish if $range eq 'bytes=6-18';
31+
return $c->write('CHUNK3')->finish;
32+
};
33+
34+
get '/stream' => sub {
35+
my $c = shift;
36+
my $chunks = [qw(CHUNK1 CHUNK2 CHUNK3 CHUNK4)];
37+
$c->res->code(200);
38+
$c->res->headers->content_type('text/plain');
39+
my $cb = sub {
40+
my $content = shift;
41+
my $chunk = shift @$chunks || '';
42+
$content->write_chunk($chunk, $chunk ? __SUB__ : undef);
43+
};
44+
$c->res->content->$cb;
45+
$c->rendered;
46+
};
47+
48+
get '/header' => sub {
49+
my $c = shift;
50+
my $custom = $c->req->headers->header('X-Custom-Header') || 'MISSINGHEADER';
51+
$c->res->headers->accept_ranges('bytes');
52+
return $c->render(data => $custom);
53+
};
54+
55+
my $dir = tempdir;
56+
my $ua = Mojo::UserAgent->new;
57+
58+
subtest 'Basic file download' => sub {
59+
my $file = $dir->child('simple1.txt');
60+
ok $file->download('/simple'), 'file downloaded';
61+
ok -e $file, 'file exists';
62+
is $file->slurp, 'CHUNK1CHUNK2CHUNK3', 'right content';
63+
};
64+
65+
subtest 'File already downloaded' => sub {
66+
my $file = $dir->child('simple1.txt');
67+
is $file->slurp, 'CHUNK1CHUNK2CHUNK3', 'right content';
68+
ok $file->download('/simple'), 'file downloaded';
69+
is $file->slurp, 'CHUNK1CHUNK2CHUNK3', 'right content';
70+
};
71+
72+
subtest 'Basic file download (custom header)' => sub {
73+
my $file = $dir->child('header1.txt');
74+
ok $file->download('/header', {headers => {'X-Custom-Header' => 'CORRECTFILECONTENT'}}), 'file downloaded';
75+
ok -e $file, 'file exists';
76+
is $file->slurp, 'CORRECTFILECONTENT', 'right content';
77+
78+
my $file2 = $dir->child('header2.txt');
79+
ok $file2->download('/header'), 'file downloaded';
80+
ok -e $file2, 'file exists';
81+
is $file2->slurp, 'MISSINGHEADER', 'right content';
82+
};
83+
84+
subtest 'Basic file download (redirect)' => sub {
85+
my $file = $dir->child('redirect1.txt');
86+
ok $file->download('/redirect'), 'file downloaded';
87+
ok -e $file, 'file exists';
88+
is $file->slurp, '', 'right content';
89+
90+
my $ua2 = Mojo::UserAgent->new(max_redirects => 5);
91+
my $file2 = $dir->child('redirect2.txt');
92+
ok $file2->download('/redirect', {ua => $ua2}), 'file downloaded';
93+
ok -e $file2, 'file exists';
94+
is $file2->slurp, 'CHUNK1CHUNK2CHUNK3', 'right content';
95+
};
96+
97+
subtest 'Existing file is larger' => sub {
98+
my $file = $dir->child('simple2.txt')->spew('CHUNK1CHUNK2CHUNK3CHUNK4');
99+
eval { $file->download('/simple') };
100+
like $@, qr/Download error: File size mismatch/, 'right error';
101+
};
102+
103+
subtest 'Resumed file download' => sub {
104+
my $file = $dir->child('resume1.txt');
105+
ok !$file->download('/resume'), 'file partially downloaded';
106+
ok !$file->download('/resume'), 'file continued';
107+
ok $file->download('/resume'), 'file downloaded';
108+
ok -e $file, 'file exists';
109+
is $file->slurp, 'CHUNK1CHUNK2CHUNK3', 'right content';
110+
};
111+
112+
subtest 'Missing file' => sub {
113+
my $file = $dir->child('missing1.txt');
114+
eval { $file->download('/missing') };
115+
like $@, qr/404 response: Not Found/, 'file not found';
116+
};
117+
118+
subtest 'File of unknown size' => sub {
119+
my $file = $dir->child('stream1.txt')->spew('C');
120+
eval { $file->download('/stream') };
121+
like $@, qr/Download error: Unknown file size/, 'right error';
122+
};
123+
124+
subtest 'File of unknown size downloaded' => sub {
125+
my $file = $dir->child('stream2.txt');
126+
ok $file->download('/stream'), 'file downloaded';
127+
ok -e $file, 'file exists';
128+
is $file->slurp, 'CHUNK1CHUNK2CHUNK3CHUNK4', 'right content';
129+
};
130+
131+
done_testing();

‎t/mojo/transactor.t‎

Lines changed: 84 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -3,6 +3,7 @@ use Mojo::Base -strict;
33
use Test::More;
44
use Mojo::Asset::File;
55
use Mojo::Asset::Memory;
6+
use Mojo::File qw(tempdir);
67
use Mojo::Promise;
78
use Mojo::Transaction::WebSocket;
89
use Mojo::URL;
@@ -1016,6 +1017,89 @@ subtest '301 redirect without compression' => sub {
10161017
is $tx->res->headers->location, undef, 'no "Location" value';
10171018
};
10181019

1020+
subtest 'Download' => sub {
1021+
my $dir = tempdir;
1022+
my $no_file = $dir->child('no_file');
1023+
my $small_file = $dir->child('small_file')->spew('x');
1024+
my $large_file = $dir->child('large_file')->spew('xxxxxxxxxxx');
1025+
my $correct_file = $dir->child('correct_file')->spew('xxxxxxxxxx');
1026+
my $t = Mojo::UserAgent::Transactor->new;
1027+
1028+
subtest 'Partial file exists' => sub {
1029+
my $head = $t->tx(HEAD => 'http://mojolicious.org/release.tar.gz');
1030+
$head->res->headers->content_length(10);
1031+
$head->res->headers->accept_ranges('bytes');
1032+
my $tx = $t->download($head, $small_file);
1033+
is $tx->req->method, 'GET', 'right method';
1034+
is $tx->req->url->to_abs, 'http://mojolicious.org/release.tar.gz', 'right URL';
1035+
is $tx->req->headers->range, 'bytes=1-10', 'right "Range" value';
1036+
};
1037+
1038+
subtest 'Partial file exists (with headers)' => sub {
1039+
my $head = $t->tx(HEAD => 'http://mojolicious.org/release.tar.gz' => {Accept => 'application/json'});
1040+
$head->res->headers->content_length(10);
1041+
$head->res->headers->accept_ranges('bytes');
1042+
my $tx = $t->download($head, $small_file);
1043+
is $tx->req->method, 'GET', 'right method';
1044+
is $tx->req->url->to_abs, 'http://mojolicious.org/release.tar.gz', 'right URL';
1045+
is $tx->req->headers->range, 'bytes=1-10', 'right "Range" value';
1046+
is $tx->req->headers->accept, 'application/json', 'right "Accept" value';
1047+
};
1048+
1049+
subtest 'Failed HEAD request' => sub {
1050+
my $head = $t->tx(HEAD => 'http://mojolicious.org/release.tar.gz');
1051+
$head->res->error({message => 'Failed to connect'});
1052+
my $tx = $t->download($head, $no_file);
1053+
is $tx->error->{message}, 'Failed to connect', 'right error';
1054+
};
1055+
1056+
subtest 'Empty HEAD response' => sub {
1057+
my $head = $t->tx(HEAD => 'http://mojolicious.org/release.tar.gz');
1058+
my $tx = $t->download($head, $no_file);
1059+
is $tx->req->method, 'GET', 'right method';
1060+
is $tx->req->url->to_abs, 'http://mojolicious.org/release.tar.gz', 'right URL';
1061+
is $tx->req->headers->range, undef, 'no "Range" value';
1062+
};
1063+
1064+
subtest 'Empty HEAD response (file exists)' => sub {
1065+
my $head = $t->tx(HEAD => 'http://mojolicious.org/release.tar.gz');
1066+
my $tx = $t->download($head, $small_file);
1067+
is $tx->error->{message}, 'Unknown file size', 'right error';
1068+
};
1069+
1070+
subtest 'Target file does not exist' => sub {
1071+
my $head = $t->tx(HEAD => 'http://mojolicious.org/release.tar.gz');
1072+
$head->res->headers->content_length(10);
1073+
my $tx = $t->download($head, $no_file);
1074+
is $tx->req->method, 'GET', 'right method';
1075+
is $tx->req->url->to_abs, 'http://mojolicious.org/release.tar.gz', 'right URL';
1076+
is $tx->req->headers->range, undef, 'no "Range" value';
1077+
};
1078+
1079+
subtest 'Partial file exists (unsupported server)' => sub {
1080+
my $head = $t->tx(HEAD => 'http://mojolicious.org/release.tar.gz');
1081+
$head->res->headers->content_length(10);
1082+
my $tx = $t->download($head, $small_file);
1083+
is $tx->error->{message}, 'Server does not support partial requests', 'right error';
1084+
};
1085+
1086+
subtest 'Partial file exists (larger than download)' => sub {
1087+
my $head = $t->tx(HEAD => 'http://mojolicious.org/release.tar.gz');
1088+
$head->res->headers->content_length(10);
1089+
$head->res->headers->accept_ranges('bytes');
1090+
my $tx = $t->download($head, $large_file);
1091+
is $tx->error->{message}, 'File size mismatch', 'right error';
1092+
};
1093+
1094+
subtest 'Download already finished' => sub {
1095+
my $head = $t->tx(HEAD => 'http://mojolicious.org/release.tar.gz');
1096+
$head->res->headers->content_length(10);
1097+
$head->res->headers->accept_ranges('bytes');
1098+
my $tx = $t->download($head, $correct_file);
1099+
is $tx->error->{message}, 'Download complete', 'right error';
1100+
};
1101+
};
1102+
10191103
subtest 'Promisify' => sub {
10201104
my $promise = Mojo::Promise->new;
10211105
my (@results, @errors);

0 commit comments

Comments
 (0)