Merge pull request #818 from gugod/download-install-skaji-relocatable…

…-perl

Download + install skaji/relocable-perl

lib/App/Perlbrew/Util.pm

@@ -5,7 +5,7 @@ use 5.008;
 
 use Exporter 'import';
 our @EXPORT = qw( uniq min editdist files_are_the_same perl_version_to_integer );
-our @EXPORT_OK = qw( find_similar_tokens );
+our @EXPORT_OK = qw( find_similar_tokens looks_like_url_of_skaji_relocatable_perl );
 
 sub uniq {
  my %seen;
@@ -98,4 +98,20 @@ sub find_similar_tokens {
  return \@similar_tokens;
 }
 
+sub looks_like_url_of_skaji_relocatable_perl {
+ my ($str) = @_;
+ # https:/skaji/relocatable-perl/releases/download/5.40.0.0/perl-linux-amd64.tar.gz
+ my $prefix = "https:/skaji/relocatable-perl/releases/download";
+ my $version_re = qr/(5\.[0-9][0-9]\.[0-9][0-9]?.[0-9])/;
+ my $name_re = qr/perl-(linux|darwin)-(amd64|arm64)\.tar\.gz/;
+ return undef unless $str =~ m{ \Q$prefix\E / $version_re / $name_re }x;
+ return {
+ url => $str,
+ version => $1,
+ os => $2,
+ arch => $3,
+ original_filename => "perl-$2-$3.tar.gz",
+ };
+}
+
 1;

lib/App/perlbrew.pm

@@ -21,10 +21,10 @@ BEGIN {
 use Getopt::Long ();
 use CPAN::Perl::Releases ();
 use JSON::PP qw( decode_json );
-use File::Copy qw( copy );
+use File::Copy qw( copy move );
 use Capture::Tiny ();
 
-use App::Perlbrew::Util qw( files_are_the_same uniq find_similar_tokens );
+use App::Perlbrew::Util qw( files_are_the_same uniq find_similar_tokens looks_like_url_of_skaji_relocatable_perl );
 use App::Perlbrew::Path ();
 use App::Perlbrew::Path::Root ();
 use App::Perlbrew::HTTP qw( http_download http_get );
@@ -1227,6 +1227,10 @@ sub run_command_install {
  exit(-1);
  }
 
+ if ( my $detail = looks_like_url_of_skaji_relocatable_perl($dist) ) {
+ return $self->do_install_skaji_relocatable_perl($detail);
+ }
+
  $self->{dist_name} = $dist; # for help msg generation, set to non
  # normalized name
 
@@ -1630,6 +1634,64 @@ INSTALL
  return;
 }
 
+sub do_install_skaji_relocatable_perl {
+ my ($self, $detail) = @_;
+
+ my $installation_name = $self->{as} || ("skaji-relocatable-perl-" . $detail->{version});
+ my $installation_path = $self->root->perls->child($installation_name);
+
+ die "ERROR: Installation target \"${installation_name}\" already exists\n"
+ if $installation_path->exists;
+
+ my $path = $self->root->dists
+ ->child("skaji-relocatable-perl")
+ ->child($detail->{version})
+ ->mkpath()
+ ->child($detail->{original_filename});
+
+ if (-f $path) {
+ print "Re-using the downloaded $path\n";
+ } else {
+ my $url = $detail->{url};
+ print "Downloading $url as $path\n";
+ my $error = http_download( $detail->{url}, $path );
+ if ($error) {
+ die "Failed to download from $url\nError: $error";
+ }
+ }
+
+ my $extracted_path = $self->do_extract_skaji_relocatable_perl_tarball($detail, $path);
+
+ move $extracted_path, $installation_path;
+
+ print "$installation_name is installed at $installation_path.\n";
+
+ print "$installation_name is successfully installed.\n";
+}
+
+sub do_extract_skaji_relocatable_perl_tarball {
+ my ($self, $detail, $tarball_path) = @_;
+
+ my $workdir = $self->builddir
+ ->child("skaji-relocatable-perl")
+ ->child($detail->{version});
+
+ $workdir->rmpath()
+ if $workdir->exists();
+
+ $workdir->mkpath();
+
+ my $tarx = "tar xzf";
+ my $extract_command = "cd $workdir; $tarx $tarball_path";
+
+ system($extract_command) == 0
+ or die "Failed to extract $tarball_path";
+
+ my ($extracted_path) = $workdir->children;
+
+ return $extracted_path;
+}
+
 sub do_install_program_from_url {
  my ( $self, $url, $program_name, $body_filter ) = @_;
 

t/util-looks-like.t

@@ -0,0 +1,32 @@
+use Test2::V0;
+use App::Perlbrew::Util qw(looks_like_url_of_skaji_relocatable_perl);
+
+subtest "looks_like_url_of_skaji_relocatable_perl", sub {
+ is(
+ looks_like_url_of_skaji_relocatable_perl($_),
+ hash {
+ field url => string($_);
+ field version => string('5.40.0.0');
+ field os => in_set(
+ string('darwin'),
+ string('linux'),
+ );
+ field arch => string("amd64");
+ field original_filename => match(qr/^perl-(.+?)-amd64\.tar\.gz$/);
+ end();
+ },
+ "positive case: $_"
+ ) for qw(
+ https:/skaji/relocatable-perl/releases/download/5.40.0.0/perl-darwin-amd64.tar.gz
+ https:/skaji/relocatable-perl/releases/download/5.40.0.0/perl-linux-amd64.tar.gz
+ );
+
+ is(looks_like_url_of_skaji_relocatable_perl($_), F(), "negative case: $_")
+ for qw(
+ https://example.com/
+ https://gugod.org/
+ https:/skaji/relocatable-perl/releases/download/5.40.0.0/perl-linux-x86_64.tar.gz
+ );
+};
+
+done_testing;