Add download methods to Mojo::UserAgent and Mojo::UserAgent::Transactor

kraih · kraih · commit d8ddcb370a03 · 2025-04-04T15:52:05.000+02:00
diff --git a/lib/Mojo/UserAgent.pm b/lib/Mojo/UserAgent.pm
@@ -3,6 +3,7 @@ use Mojo::Base 'Mojo::EventEmitter';
 
 # "Fry: Since when is the Internet about robbing people of their privacy?
 #  Bender: August 6, 1991."
+use Carp qw(croak);
 use Mojo::IOLoop;
 use Mojo::Promise;
 use Mojo::Util qw(monkey_patch term_escape);
@@ -48,6 +49,24 @@ sub DESTROY { shift->_cleanup unless ${^GLOBAL_PHASE} eq 'DESTRUCT' }
 sub build_tx           { shift->transactor->tx(@_) }
 sub build_websocket_tx { shift->transactor->websocket(@_) }
 
+sub download {
+  my ($self, $url, $path, $options) = @_;
+  $options //= {};
+
+  my $tx = _download_error($self->transactor->download($self->head($url => $options->{headers} // {}), $path));
+  return $tx ? !!_download_error($self->start($tx)) : 1;
+}
+
+sub _download_error {
+  my $tx = shift;
+  if (my $err = $tx->error) {
+    return undef                                   if $err->{incomplete_download} || $err->{complete_download};
+    croak "$err->{code} response: $err->{message}" if $err->{code};
+    croak "Connection error: $err->{message}";
+  }
+  return $tx;
+}
+
 sub start {
   my ($self, $tx, $cb) = @_;
 
@@ -748,6 +767,14 @@ a callback.
     warn "Connection error: $err";
   })->wait;
 
+=head2 download
+
+  my $bool = $ua->download('https://example.com/test.tar.gz', '/home/sri/test.tar.gz');
+  my $bool = $ua->download('https://example.com/test.tar.gz', '/home/sri/test.tar.gz', {headers => {Accept => '*/*'}});
+
+Download file from URL to local file, returns true once the file has been downloaded completely. Incomplete downloads
+are resumed. Note that this method is B<EXPERIMENTAL> and might change without warning!
+
 =head2 get
 
   my $tx = $ua->get('example.com');
diff --git a/lib/Mojo/UserAgent/Transactor.pm b/lib/Mojo/UserAgent/Transactor.pm
@@ -1,6 +1,7 @@
 package Mojo::UserAgent::Transactor;
 use Mojo::Base -base;
 
+use Carp qw(croak);
 use Mojo::Asset::File;
 use Mojo::Asset::Memory;
 use Mojo::Content::MultiPart;
@@ -20,6 +21,44 @@ has name       => 'Mojolicious (Perl)';
 
 sub add_generator { $_[0]->generators->{$_[1]} = $_[2] and return $_[0] }
 
+sub download {
+  my ($self, $head, $path) = @_;
+
+  my $req = $head->req;
+  my $tx  = $self->tx(GET => $req->url->clone => $req->headers->to_hash);
+  my $res = $tx->res;
+  if (my $error = $head->error) { $res->error($error) and return $tx }
+
+  my $headers       = $head->res->headers;
+  my $accept_ranges = $headers->accept_ranges =~ /bytes/;
+  croak 'Download error: Unknown file size' unless my $size = $headers->content_length;
+
+  my $current_size = 0;
+  my $file         = path($path);
+  if (-f $file) {
+    $current_size = -s $file;
+    $res->error({message => 'Download error', complete_download => 1}) and return $tx if $current_size >= $size;
+    croak "Download error: Server does not support partial requests" unless $accept_ranges;
+    $tx->req->headers->range("bytes=$current_size-$size");
+  }
+  my $fh = $file->open('+>>');
+  $res->content->unsubscribe('read')->on(
+    read => sub {
+      my ($content, $bytes) = @_;
+      $current_size += length $bytes;
+      $fh->syswrite($bytes) or croak qq/Can't write to file "$path": $!/;
+    }
+  );
+  $res->on(
+    finish => sub {
+      my $res = shift;
+      $res->error({message => 'Download error', incomplete_download => 1}) if $current_size < $size;
+    }
+  );
+
+  return $tx;
+}
+
 sub endpoint {
   my ($self, $tx) = @_;
 
@@ -371,6 +410,14 @@ Register a content generator.
 
   $t->add_generator(foo => sub ($t, $tx, @args) {...});
 
+=head2 download
+
+  my $tx = $ua->download(Mojo::Transaction::HTTP->new, '/home/sri/test.tar.gz');
+  my $tx = $ua->download(Mojo::Transaction::HTTP->new, '/home/sri/test.tar.gz', {headers => {Accept => '*/*'}});
+
+Build L<Mojo::Transaction::HTTP> follow-up request for C<HEAD> request to allow for resumable file downloads. Note that
+this method is B<EXPERIMENTAL> and might change without warning!
+
 =head2 endpoint
 
   my ($proto, $host, $port) = $t->endpoint(Mojo::Transaction::HTTP->new);
