App-perlbrew
view release on metacpan or search on metacpan
t/installation-perlbrew.t
t/installation.t
t/installation2.t
t/installation3.t
t/list_modules.t
t/sys.t
t/test.tar.gz
t/test2_helpers.pl
t/unit-files-are-the-same.t
t/util-find-similar-tokens.t
t/util-looks-like.t
lib/App/Perlbrew/Util.pm view on Meta::CPAN
package App::Perlbrew::Util;
use strict;
use warnings;
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
looks_like_url_of_skaji_relocatable_perl
looks_like_sys_would_be_compatible_with_skaji_relocatable_perl
make_skaji_relocatable_perl_url
);
sub uniq {
my %seen;
grep { !$seen{$_}++ } @_;
}
sub min(@) {
my $m = $_[0];
lib/App/Perlbrew/Util.pm view on Meta::CPAN
} @$tokens;
if (@similar_tokens) {
my $best_score = $similar_tokens[0][1];
@similar_tokens = map { $_->[0] } grep { $_->[1] == $best_score } @similar_tokens;
}
return \@similar_tokens;
}
sub looks_like_url_of_skaji_relocatable_perl {
my ($str) = @_;
# https://github.com/skaji/relocatable-perl/releases/download/5.40.0.0/perl-linux-amd64.tar.gz
my $prefix = "https://github.com/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,
lib/App/Perlbrew/Util.pm view on Meta::CPAN
sub _arch_compat {
my ($arch) = @_;
my $compat = {
x86_64 => "amd64",
i386 => "amd64",
};
return $compat->{$arch} || $arch;
}
sub looks_like_sys_would_be_compatible_with_skaji_relocatable_perl {
my ($detail, $sys) = @_;
return (
($detail->{os} eq $sys->os)
&& (_arch_compat($detail->{arch}) eq _arch_compat($sys->arch))
);
}
sub make_skaji_relocatable_perl_url {
my ($str, $sys) = @_;
lib/App/perlbrew.pm view on Meta::CPAN
require Cwd;
@INC = @oldinc;
}
use Getopt::Long ();
use CPAN::Perl::Releases ();
use JSON::PP qw( decode_json );
use File::Copy qw( copy move );
use Capture::Tiny ();
use App::Perlbrew::Util qw( files_are_the_same uniq find_similar_tokens looks_like_url_of_skaji_relocatable_perl looks_like_sys_would_be_compatible_with_skaji_relocatable_perl make_skaji_relocatable_perl_url );
use App::Perlbrew::Path ();
use App::Perlbrew::Path::Root ();
use App::Perlbrew::HTTP qw( http_download http_get );
use App::Perlbrew::Patchperl qw( maybe_patchperl );
use App::Perlbrew::Sys;
### global variables
# set $ENV{SHELL} to executable path of parent process (= shell) if it's missing
# (e.g. if this script was executed by a daemon started with "service xxx start")
lib/App/perlbrew.pm view on Meta::CPAN
return $self->sort_perl_versions( keys %dists );
}
# -> Map[ NameVersion => URL ]
sub available_perl_distributions {
my ($self) = @_;
my $perls = {};
my @perllist;
# we got impatient waiting for cpan.org to get updated to show 5.28...
# So, we also fetch from metacpan for anything that looks perlish,
# and we do our own processing to filter out the development
# releases and minor versions when needed (using
# filter_perl_available)
my $json = http_get('https://fastapi.metacpan.org/v1/release/versions/perl')
or die "\nERROR: Unable to retrieve list of perls from Metacpan.\n\n";
my $decoded = decode_json($json);
for my $release ( @{ $decoded->{releases} } ) {
next
if !$release->{authorized};
lib/App/perlbrew.pm view on Meta::CPAN
}
# $perllist is an arrayref of arrayrefs. The inner arrayrefs are of the
# format: [ <perl_name>, <perl_url> ]
# perl_name = something like perl-5.28.0
# perl_url = URL the Perl is available from.
#
# If $self->{all} is true, this just returns a list of the contents of
# the list referenced by $perllist
#
# Otherwise, this looks for even middle numbers in the version and no
# suffix (like -RC1) following the URL, and returns the list of
# arrayrefs that so match
#
# If any "newest" Perl has a
sub filter_perl_available {
my ( $self, $perllist ) = @_;
if ( $self->{all} ) { return @$perllist; }
my %max_release;
lib/App/perlbrew.pm view on Meta::CPAN
unless ($dist) {
$self->run_command_help("install");
exit(-1);
}
if ( my $url = make_skaji_relocatable_perl_url($dist, $self->sys) ) {
return $self->run_command_install($url);
}
if ( my $detail = looks_like_url_of_skaji_relocatable_perl($dist) ) {
if (looks_like_sys_would_be_compatible_with_skaji_relocatable_perl($detail, $self->sys)) {
return $self->do_install_skaji_relocatable_perl($detail);
} else {
die "ERROR: The given url points to a tarball for different os/arch.\n";
}
}
$self->{dist_name} = $dist; # for help msg generation, set to non
# normalized name
my ( $dist_type, $dist_version );
lib/App/perlbrew.pm view on Meta::CPAN
my $dist_extracted_path = $self->do_extract_tarball($dist_tarball_path);
$self->do_install_this( $dist_extracted_path, $dist_version, $installation_name );
}
sub do_install_this {
my ( $self, $dist_extracted_dir, $dist_version, $installation_name ) = @_;
my $variation = $self->{variation};
my $append = $self->{append};
my $looks_like_we_are_installing_cperl = $dist_extracted_dir =~ /\/ cperl- /x;
$self->{dist_extracted_dir} = $dist_extracted_dir;
$self->{log_file} = $self->root->child("build.${installation_name}${variation}${append}.log");
my @d_options = @{ $self->{D} };
my @u_options = @{ $self->{U} };
my @a_options = @{ $self->{A} };
my $sitecustomize = $self->{sitecustomize};
my $destdir = $self->{destdir};
$installation_name = $self->{as} if $self->{as};
lib/App/perlbrew.pm view on Meta::CPAN
for my $flavor ( keys %flavor ) {
$self->{$flavor} and push @d_options, $flavor{$flavor}{d_option};
}
my $perlpath = $self->root->perls($installation_name);
unshift @d_options, qq(prefix=$perlpath);
push @d_options, "usedevel" if $dist_version =~ /5\.\d[13579]|git|blead/;
push @d_options, "usecperl" if $looks_like_we_are_installing_cperl;
my $version = $self->comparable_perl_version($dist_version);
if ( defined $version and $version < $self->comparable_perl_version('5.6.0') ) {
# ancient perls do not support -A for Configure
@a_options = ();
}
else {
unless ( grep { /eval:scriptdir=/ } @a_options ) {
push @a_options, "'eval:scriptdir=${perlpath}/bin'";
lib/App/perlbrew.pm view on Meta::CPAN
print <<INSTALL if !$self->{verbose};
This could take a while. You can run the following command on another shell to track the status:
tail -f ${\ $self->{log_file}->stringify_with_tilde }
INSTALL
my @preconfigure_commands = ( "cd $dist_extracted_dir", "rm -f config.sh Policy.sh", );
if ((not $self->{"no-patchperl"})
&& (not $looks_like_we_are_installing_cperl)
&& (my $patchperl = maybe_patchperl($self->root))) {
push @preconfigure_commands, 'chmod -R +w .', $patchperl;
}
my $configure_flags = $self->env("PERLBREW_CONFIGURE_FLAGS") || '-de';
my @configure_commands = (
"sh Configure $configure_flags "
. join( ' ',
( map { qq{'-D$_'} } @d_options ),
script/perlbrew view on Meta::CPAN
Usage:
perlbrew install [options] <perl-release>
perlbrew install [options] /path/to/perl-5.14.0.tar.gz
perlbrew install [options] /path/to/perl/git/checkout/dir
perlbrew install [options] https://example.com/mirror/perl-5.12.3.tar.gz
Build and install the wanted perl. The last argument can be a short string designating a specific version which can be known from the output of C<perlbrew available>, a path to a pre-downloaded tarball, a path to a git-checkout of perl5 repo, or a UR...
The format of <perl-release> looks like:
=over 4
=item perl-<version>
=item perl-stable
=item perl-blead
=item <version>
script/perlbrew view on Meta::CPAN
(format is the same as in 'use 5.012')
--max n.nnnnn - maximum perl version
--halt-on-error - stop on first nonzero exit status
Execute command for each perl installations, one by one.
For example, run a Hello program:
perlbrew exec perl -e 'print "Hello from $]\n"'
The output looks like this:
perl-5.12.2
==========
Hello word from perl-5.012002
perl-5.13.10
==========
Hello word from perl-5.013010
perl-5.14.0
t/11.root_from_arg.t view on Meta::CPAN
use Test2::Tools::ClassicCompare qw/is_deeply/;
use Data::Dumper;
use FindBin;
use lib $FindBin::Bin;
use App::perlbrew;
require "test2_helpers.pl";
use File::Temp qw(tempdir);
sub looks_like_perlbrew_root;
# We will override these in the tests below
local $App::perlbrew::PERLBREW_ROOT;
local $ENV{PERLBREW_ROOT};
local $ENV{HOME};
describe "App::perlbrew#root method" => sub {
before_each init => sub {
$App::perlbrew::PERLBREW_ROOT = '/perlbrew/root';
$ENV{PERLBREW_ROOT} = '/env/root';
$ENV{HOME} = '/home';
};
it "should return \$App::perlbrew::PERLBREW_ROOT if provided" => sub {
my $app = App::perlbrew->new;
looks_like_perlbrew_root $app->root, '/perlbrew/root';
};
it "should default to \$ENV{PERLBREW_ROOT} if provided" => sub {
local $App::perlbrew::PERLBREW_ROOT;
my $app = App::perlbrew->new;
looks_like_perlbrew_root $app->root, '/env/root';
};
it "should default to \$ENV{HOME} subpath" => sub {
local $App::perlbrew::PERLBREW_ROOT;
local $ENV{PERLBREW_ROOT};
my $app = App::perlbrew->new;
looks_like_perlbrew_root $app->root, '/home/perl5/perlbrew';
};
it "should return the instance property of 'root' if set" => sub {
my $app = App::perlbrew->new;
$app->root("/fnord");
looks_like_perlbrew_root $app->root, "/fnord";
};
};
describe "App::perlbrew->new" => sub {
it "should accept --root args and treat it as the value of PERLBREW_ROOT for the instance" => sub {
my $temp_perlbrew_root = tempdir( CLEANUP => 1);
my $app = App::perlbrew->new("--root" => $temp_perlbrew_root);
looks_like_perlbrew_root $app->root, $temp_perlbrew_root;
};
};
done_testing;
sub looks_like_perlbrew_root {
my ($got, $expected) = @_;
is_deeply($got, $expected,
'Return value comparison failed') or return;
is_deeply("$got", "$App::perlbrew::PERLBREW_ROOT",
"Global \$PERLBREW_ROOT comparison failed") or return;
isa_ok($got, 'App::Perlbrew::Path::Root');
}
t/app-perlbrew-path-installation.t view on Meta::CPAN
#!/usr/bin/env perl
use Test2::V0;
use Test2::Tools::Spec;
use File::Temp qw[];
use App::Perlbrew::Path::Root;
use App::Perlbrew::Path::Installation;
use App::Perlbrew::Path::Installations;
sub looks_like_path;;
sub looks_like_perl_installation;
sub looks_like_perl_installations;
sub arrange_root;
sub arrange_installation;
describe "App::Perlbrew::Path::Root" => sub {
describe "perls()" => sub {
describe "without parameters" => sub {
it "should return Instalations object" => sub {
local $ENV{HOME};
my $path = arrange_root->perls;
is $path, looks_like_perl_installations("~/.root/perls");
};
};
describe "with one parameter" => sub {
it "should return Installation object" => sub {
local $ENV{HOME};
my $path = arrange_root->perls('blead');
is $path, looks_like_perl_installation("~/.root/perls/blead");
};
};
describe "with multiple paramters" => sub {
it "should return Path object" => sub {
local $ENV{HOME};
my $path = arrange_root->perls('blead', '.version');
is $path, looks_like_path("~/.root/perls/blead/.version");
};
}
};
};
describe "App::Perlbrew::Path::Installations" => sub {
describe "list()" => sub {
it "should list known installations" => sub {
local $ENV{HOME};
my $root = arrange_root;
arrange_installation 'perl-1';
arrange_installation 'perl-2';
my @list = $root->perls->list;
is \@list, [
looks_like_perl_installation("~/.root/perls/perl-1"),
looks_like_perl_installation("~/.root/perls/perl-2"),
];
};
};
};
describe "App::Perlbrew::Path::Installation" => sub {
describe "name()" => sub {
it "should return installation name" => sub {
local $ENV{HOME};
my $installation = arrange_installation('foo-bar');
t/app-perlbrew-path-installation.t view on Meta::CPAN
it "should provide path to version file" => sub {
local $ENV{HOME};
my $file = arrange_installation('foo-bar')->version_file;
is $file->stringify_with_tilde, '~/.root/perls/foo-bar/.version';
};
};
};
done_testing;
sub looks_like_path {
my ($path, @tests) = @_;
my $method = $path =~ m/^~/
? 'stringify_with_tilde'
: 'stringify'
;
object {
call $method => $path;
prop isa => 'App::Perlbrew::Path';
};
}
sub looks_like_perl_installation {
looks_like_path(@_, object { prop isa => 'App::Perlbrew::Path::Installation' });
}
sub looks_like_perl_installations {
looks_like_path(@_, object { prop isa => 'App::Perlbrew::Path::Installation' });
}
sub arrange_root {
$ENV{HOME} ||= File::Temp::tempdir(CLEANUP => 1);
App::Perlbrew::Path::Root->new($ENV{HOME}, '.root')->mkpath;
}
sub arrange_installation {
my ($name) = @_;
t/app-perlbrew-path.t view on Meta::CPAN
#!/usr/bin/env perl
use Test2::V0;
use Test2::Tools::Spec;
use File::Temp qw[];
use App::Perlbrew::Path;
sub looks_like_perlbrew_path;
sub arrange_testdir;
describe "App::Perlbrew::Path" => sub {
describe "new()" => sub {
it "should accept one parameter" => sub {
my $path = App::Perlbrew::Path->new("foo/bar/baz");
looks_like_perlbrew_path $path, "foo/bar/baz";
};
it "should concatenate multiple parameters into single path" => sub {
my $path = App::Perlbrew::Path->new("foo", "bar/baz");
looks_like_perlbrew_path $path, "foo/bar/baz";
};
it "should die with undefined element" => sub {
ok dies {
App::Perlbrew::Path->new('foo', undef, 'bar')
}, qr/^Received an undefined entry as a parameter/;
};
it "should concatenate long (root) path" => sub {
my $path = App::Perlbrew::Path->new('', qw(this is a long path to check if it is joined ok));
looks_like_perlbrew_path $path, '/this/is/a/long/path/to/check/if/it/is/joined/ok';
};
};
describe "basename()" => sub {
it "should return basename" => sub {
my $path = App::Perlbrew::Path->new("foo/bar/baz.tar.gz");
is $path->basename, "baz.tar.gz";
};
t/app-perlbrew-path.t view on Meta::CPAN
my $path = App::Perlbrew::Path->new("foo/bar/baz.tar.gz");
is $path->basename(qr/\.tar\.(?:gz|bz2|xz)$/), "baz";
};
};
describe "child()" => sub {
it "should create direct child" => sub {
my $path = App::Perlbrew::Path->new("foo/bar")->child(1);
looks_like_perlbrew_path $path, "foo/bar/1";
};
it "should accept multiple children" => sub {
my $path = App::Perlbrew::Path->new("foo/bar")->child(1, 2);
looks_like_perlbrew_path $path, "foo/bar/1/2";
};
it "should return chainable object" => sub {
my $path = App::Perlbrew::Path->new("foo/bar")->child(1, 2)->child(3);
looks_like_perlbrew_path $path, "foo/bar/1/2/3";
};
};
describe "children()" => sub {
it "should return empty list on empty match" => sub {
my $root = arrange_testdir;
is 0 + $root->children(), 0;
};
it "should return Path instances" => sub {
my $root = arrange_testdir;
for (qw[ aa ab ba ]) {
my $child = $root->child($_);
$child->mkpath;
looks_like_perlbrew_path $child, "$child";
}
};
};
describe "mkpath()" => sub {
it "should create recursive path" => sub {
my $path = arrange_testdir ("foo/bar/baz");
$path->mkpath;
ok -d $path;
t/app-perlbrew-path.t view on Meta::CPAN
my $path = arrange_testdir ("foo/bar/baz");
$path->mkpath;
ok lives { $path->mkpath };
};
it "should return self" => sub {
my $path = arrange_testdir ("foo/bar/baz");
looks_like_perlbrew_path $path->mkpath, "$path";
};
};
describe "readlink()" => sub {
my $test_root;
my $link;
before_each arrange_testdir => sub {
$test_root = arrange_testdir;
$link = $test_root->child('link');
t/app-perlbrew-path.t view on Meta::CPAN
before_each mkpath => sub {
$dest = $test_root->child('dest');
$dest->mkpath;
symlink $dest, $link;
};
it "should return link path" => sub {
my $read = $link->readlink;
looks_like_perlbrew_path $read, "$dest";
};
};
};
describe "rmpath()" => sub {
it "should remove path recursively" => sub {
my $path = arrange_testdir ("foo");
my $child = $path->child("bar/baz");
$child->mkpath;
t/app-perlbrew-path.t view on Meta::CPAN
it "should not die when path doesn't exist" => sub {
my $path = arrange_testdir ("foo");
ok lives { $path->rmpath };
};
it "should return self" => sub {
my $path = arrange_testdir ("foo/bar/baz");
looks_like_perlbrew_path $path, "$path";
};
};
describe "stringify_with_tilde" => sub {
it "should expand leading homedir" => sub {
local $ENV{HOME} = "/home/perlbrew";
my $path = App::Perlbrew::Path->new("/home/perlbrew/.root");
is $path->stringify_with_tilde, "~/.root";
};
t/app-perlbrew-path.t view on Meta::CPAN
$file->unlink;
ok ! -e $file;
};
};
};
done_testing;
sub looks_like_perlbrew_path {
my ($actual, $expected) = @_;
subtest "looks like a perlbrew path object", sub {
is "$actual", $expected;
is $actual->stringify(), $expected;
isa_ok $actual, 'App::Perlbrew::Path';
};
}
sub arrange_testdir {
my (@path) = @_;
App::Perlbrew::Path->new(File::Temp::tempdir (CLEANUP => 1), @path);
t/builddir.t view on Meta::CPAN
#!/usr/bin/env perl
use Test2::V0;
use Test2::Tools::Spec;
use FindBin;
use lib $FindBin::Bin;
use App::perlbrew;
require "test2_helpers.pl";
sub looks_like_perlbrew_builddir;
describe "App::perlbrew#builddir method" => sub {
it "should return path in \$App::perlbrew::PERLBREW_ROOT normally" => sub {
local $App::perlbrew::PERLBREW_ROOT = '/perlbrew/root';
my $app = App::perlbrew->new;
looks_like_perlbrew_builddir $app->builddir, '/perlbrew/root/build';
};
it "should return path relative to root" => sub {
my $app = App::perlbrew->new;
$app->root("/fnord");
looks_like_perlbrew_builddir $app->builddir, "/fnord/build";
};
};
describe "App::perlbrew->new" => sub {
it "should accept --builddir args" => sub {
local $App::perlbrew::PERLBREW_ROOT = '/perlbrew/root';
my $app = App::perlbrew->new("--builddir" => "/perlbrew/buildroot");
looks_like_perlbrew_builddir $app->builddir, "/perlbrew/buildroot";
};
};
done_testing;
sub looks_like_perlbrew_builddir {
my ($got, $expected) = @_;
is "$got", "$expected", "builddir is $expected";
isa_ok $got, 'App::Perlbrew::Path';
}
#!/usr/bin/env perl
use Test2::V0;
use FindBin;
use lib $FindBin::Bin;
use App::perlbrew;
require "test2_helpers.pl";
sub looks_like_perlbrew_home;
local $App::perlbrew::PERLBREW_HOME = '/perlbrew/home';
local $ENV{PERLBREW_HOME} = '/env/home';
local $ENV{HOME} = '/home';
subtest "App::perlbrew#home method" => sub {
subtest "it should return \$App::perlbrew::PERLBREW_HOME if provided" => sub {
my $app = App::perlbrew->new;
looks_like_perlbrew_home $app->home, '/perlbrew/home';
};
subtest "it should default to \$ENV{PERLBREW_HOME} if provided" => sub {
local $App::perlbrew::PERLBREW_HOME;
my $app = App::perlbrew->new;
looks_like_perlbrew_home $app->home, '/env/home';
};
subtest "it should default to \$ENV{HOME} subpath" => sub {
local $App::perlbrew::PERLBREW_HOME;
local $ENV{PERLBREW_HOME};
my $app = App::perlbrew->new;
looks_like_perlbrew_home $app->home, '/home/.perlbrew';
};
subtest "it should return the instance property of 'home' if set" => sub {
my $app = App::perlbrew->new;
$app->home("/fnord");
looks_like_perlbrew_home $app->home, "/fnord";
};
};
done_testing;
sub looks_like_perlbrew_home {
my ($got, $expected) = @_;
isa_ok $got, 'App::Perlbrew::Path';
is "$got", "$expected";
is "$got", "$App::perlbrew::PERLBREW_HOME";
}
t/util-looks-like.t view on Meta::CPAN
use Test2::V0;
use App::Perlbrew::Util qw(looks_like_url_of_skaji_relocatable_perl looks_like_sys_would_be_compatible_with_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://github.com/skaji/relocatable-perl/releases/download/5.40.0.0/perl-darwin-amd64.tar.gz
https://github.com/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://github.com/skaji/relocatable-perl/releases/download/5.40.0.0/perl-linux-x86_64.tar.gz
);
};
subtest "looks_like_sys_would_be_compatible_with_skaji_relocatable_perl", sub {
my $detail = looks_like_url_of_skaji_relocatable_perl("https://github.com/skaji/relocatable-perl/releases/download/5.40.0.0/perl-linux-amd64.tar.gz");
my @positiveCases = (
(mock {} =>
add => [
os => sub { "linux" },
arch => sub { "amd64" },
]),
(mock {} =>
add => [
os => sub { "linux" },
t/util-looks-like.t view on Meta::CPAN
arch => sub { "aarch64" },
]),
(mock {} =>
add => [
os => sub { "darwin" },
arch => sub { "x86_64" },
]),
);
is looks_like_sys_would_be_compatible_with_skaji_relocatable_perl($detail, $_), T()
for @positiveCases;
is looks_like_sys_would_be_compatible_with_skaji_relocatable_perl($detail, $_), F()
for @negativeCasse;
};
done_testing;
( run in 0.617 second using v1.01-cache-2.11-cpan-64827b87656 )