App-perlbrew
view release on metacpan or search on metacpan
lib/App/perlbrew.pm view on Meta::CPAN
}
}
print <<INSTRUCTION;
perlbrew root ($root_dir) is initialized.
Append the following piece of code to the end of your ~/${yourshrc} and start a
new shell, perlbrew should be up and fully functional from there:
$code
Simply run `perlbrew` for usage details.
Happy brewing!
INSTRUCTION
}
}
sub run_command_init_in_bash {
print BASHRC_CONTENT();
}
sub run_command_self_install {
my $self = shift;
my $executable = $0;
my $target = $self->root->bin("perlbrew");
if ( files_are_the_same( $executable, $target ) ) {
print "You are already running the installed perlbrew:\n\n $executable\n";
exit;
}
$self->root->bin->mkpath;
open my $fh, "<", $executable;
my $head;
read( $fh, $head, 3, 0 );
if ( $head eq "#!/" ) {
seek( $fh, 0, 0 );
my @lines = <$fh>;
close $fh;
$lines[0] = $self->system_perl_shebang . "\n";
open $fh, ">", $target;
print $fh $_ for @lines;
close $fh;
}
else {
close($fh);
copy( $executable, $target );
}
chmod( 0755, $target );
my $path = $target->stringify_with_tilde;
print "perlbrew is installed: $path\n" unless $self->{quiet};
$self->run_command_init();
return;
}
sub do_install_git {
my ( $self, $dist ) = @_;
my $dist_name;
my $dist_git_describe;
my $dist_version;
opendir my $cwd_orig, ".";
chdir $dist;
if ( `git describe` =~ /v((5\.\d+\.\d+(?:-RC\d)?)(-\d+-\w+)?)$/ ) {
$dist_name = 'perl';
$dist_git_describe = "v$1";
$dist_version = $2;
}
chdir $cwd_orig;
require File::Spec;
my $dist_extracted_dir = File::Spec->rel2abs($dist);
$self->do_install_this( App::Perlbrew::Path->new($dist_extracted_dir), $dist_version, "$dist_name-$dist_version" );
return;
}
sub do_install_url {
my ( $self, $dist ) = @_;
my $dist_name = 'perl';
# need the period to account for the file extension
my ($dist_version) = $dist =~ m/-([\d.]+(?:-RC\d+)?|git)\./;
my ($dist_tarball) = $dist =~ m{/([^/]*)$};
if ( !$dist_version && $dist =~ /blead\.tar.gz$/ ) {
$dist_version = "blead";
}
my $dist_tarball_path = $self->root->dists($dist_tarball);
my $dist_tarball_url = $dist;
$dist = "$dist_name-$dist_version"; # we install it as this name later
if ( $dist_tarball_url =~ m/^file/ ) {
print "Installing $dist from local archive $dist_tarball_url\n";
$dist_tarball_url =~ s/^file:\/+/\//;
$dist_tarball_path = $dist_tarball_url;
}
else {
print "Fetching $dist as $dist_tarball_path\n";
my $error = http_download( $dist_tarball_url, $dist_tarball_path );
die "ERROR: Failed to download $dist_tarball_url\n$error\n" if $error;
}
lib/App/perlbrew.pm view on Meta::CPAN
$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};
$installation_name .= "$variation$append";
$self->{installation_name} = $installation_name;
if ($sitecustomize) {
die "Could not read sitecustomize file '$sitecustomize'\n"
unless -r $sitecustomize;
push @d_options, "usesitecustomize";
}
if ( $self->{noman} ) {
push @d_options, qw/man1dir=none man3dir=none/;
}
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'";
}
}
print "Installing $dist_extracted_dir into "
. $self->root->perls($installation_name)->stringify_with_tilde . "\n\n";
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 ),
( map { qq{'-U$_'} } @u_options ),
( map { qq{'-A$_'} } @a_options ),
),
( defined $version and $version < $self->comparable_perl_version('5.8.9') )
? ("$^X -i -nle 'print unless /command-line/' makefile x2p/makefile")
: ()
);
my $make = $ENV{MAKE} || ( $^O eq "solaris" ? 'gmake' : 'make' );
my @build_commands = ( $make . ' ' . ( $self->{j} ? "-j$self->{j}" : "" ) );
# Test via "make test_harness" if available so we'll get
# automatic parallel testing via $HARNESS_OPTIONS. The
# "test_harness" target was added in 5.7.3, which was the last
# development release before 5.8.0.
my $use_harness = ( $dist_version =~ /^5\.(\d+)\.(\d+)/
&& ( $1 >= 8 || $1 == 7 && $2 == 3 ) )
|| $dist_version eq "blead";
my $test_target = $use_harness ? "test_harness" : "test";
local $ENV{TEST_JOBS} = $self->{j}
if $test_target eq "test_harness" && ( $self->{j} || 1 ) > 1;
my @install_commands = ( "${make} install" . ( $destdir ? " DESTDIR=$destdir" : q|| ) );
unshift @install_commands, "${make} $test_target" unless $self->{notest};
# Whats happening here? we optionally join with && based on $self->{force}, but then subsequently join with && anyway?
@install_commands = join " && ", @install_commands unless ( $self->{force} );
my $cmd = join " && ", ( @preconfigure_commands, @configure_commands, @build_commands, @install_commands );
$self->{log_file}->unlink;
if ( $self->{verbose} ) {
$cmd = "($cmd) 2>&1 | tee $self->{log_file}";
print "$cmd\n" if $self->{verbose};
}
else {
$cmd = "($cmd) >> '$self->{log_file}' 2>&1 ";
}
delete $ENV{$_} for qw(PERL5LIB PERL5OPT AWKPATH NO_COLOR);
if ( $self->do_system($cmd) ) {
my $newperl = $self->root->perls($installation_name)->perl;
unless ( -e $newperl ) {
$self->run_command_symlink_executables($installation_name);
}
eval { $self->append_log('##### Brew Finished #####') };
if ($sitecustomize) {
lib/App/perlbrew.pm view on Meta::CPAN
->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 ) = @_;
my $out = $self->root->bin($program_name);
if ( -f $out && !$self->{force} && !$self->{yes} ) {
require ExtUtils::MakeMaker;
my $ans = ExtUtils::MakeMaker::prompt( "\n$out already exists, are you sure to override ? [y/N]", "N" );
if ( $ans !~ /^Y/i ) {
print "\n$program_name installation skipped.\n\n" unless $self->{quiet};
return;
}
}
my $body = http_get($url)
or die "\nERROR: Failed to retrieve $program_name executable.\n\n";
unless ( $body =~ m{\A#!/}s ) {
my $x = App::Perlbrew::Path->new( $self->env('TMPDIR') || "/tmp", "${program_name}.downloaded.$$" );
my $message =
"\nERROR: The downloaded $program_name program seem to be invalid. Please check if the following URL can be reached correctly\n\n\t$url\n\n...and try again latter.";
unless ( -f $x ) {
open my $OUT, ">", $x;
print $OUT $body;
close($OUT);
$message .= "\n\nThe previously downloaded file is saved at $x for manual inspection.\n\n";
}
die $message;
}
if ( $body_filter && ref($body_filter) eq "CODE" ) {
$body = $body_filter->($body);
}
$self->root->bin->mkpath;
open my $OUT, '>', $out or die "cannot open file($out): $!";
print $OUT $body;
close $OUT;
chmod 0755, $out;
print "\n$program_name is installed to\n\n $out\n\n" unless $self->{quiet};
}
sub do_exit_with_error_code {
my ( $self, $code ) = @_;
exit($code);
}
sub do_system_with_exit_code {
my ( $self, @cmd ) = @_;
return system(@cmd);
}
sub do_system {
my ( $self, @cmd ) = @_;
return !$self->do_system_with_exit_code(@cmd);
}
sub do_capture {
my ( $self, @cmd ) = @_;
return Capture::Tiny::capture(
sub {
$self->do_system(@cmd);
}
);
}
sub do_capture_current_perl {
my ( $self, @cmd ) = @_;
return $self->do_capture(
$self->installed_perl_executable( $self->current_perl ),
@cmd,
);
}
sub format_perl_version {
my $self = shift;
my $version = shift;
return sprintf "%d.%d.%d", substr( $version, 0, 1 ), substr( $version, 2, 3 ), substr( $version, 5 ) || 0;
}
sub installed_perls {
my $self = shift;
my @result;
my $root = $self->root;
for my $installation ( $root->perls->list ) {
my $name = $installation->name;
my $executable = $installation->perl;
next unless -f $executable;
my $version_file = $installation->version_file;
my $ctime = localtime( ( stat $executable )[10] ); # localtime in scalar context!
my $orig_version;
if ( -e $version_file ) {
open my $fh, '<', $version_file;
local $/;
$orig_version = <$fh>;
lib/App/perlbrew.pm view on Meta::CPAN
print $self->shell_env({ $self->perlbrew_env($name) });
}
sub run_command_symlink_executables {
my ( $self, @perls ) = @_;
my $root = $self->root;
unless (@perls) {
@perls = map { $_->name } grep { -d $_ && !-l $_ } $root->perls->list;
}
for my $perl (@perls) {
for my $executable ( $root->perls($perl)->bin->children ) {
my ( $name, $version ) = $executable =~ m/bin\/(.+?)(5\.\d.*)?$/;
next unless $version;
$executable->symlink( $root->perls($perl)->bin($name) );
$executable->symlink( $root->perls($perl)->perl ) if $name eq "cperl";
}
}
}
sub run_command_install_patchperl {
my ($self) = @_;
$self->do_install_program_from_url(
'https://raw.githubusercontent.com/gugod/patchperl-packing/master/patchperl',
'patchperl',
sub {
my ($body) = @_;
$body =~ s/\A#!.+?\n/ $self->system_perl_shebang . "\n" /se;
return $body;
}
);
}
sub run_command_install_cpanm {
my ($self) = @_;
$self->do_install_program_from_url(
'https://raw.githubusercontent.com/miyagawa/cpanminus/master/cpanm' => 'cpanm' );
}
sub run_command_install_cpm {
my ($self) = @_;
$self->do_install_program_from_url( 'https://raw.githubusercontent.com/skaji/cpm/main/cpm' => 'cpm' );
}
sub run_command_self_upgrade {
my ($self) = @_;
require FindBin;
unless ( -w $FindBin::Bin ) {
die "Your perlbrew installation appears to be system-wide. Please upgrade through your package manager.\n";
}
my $TMPDIR = $ENV{TMPDIR} || "/tmp";
my $TMP_PERLBREW = App::Perlbrew::Path->new( $TMPDIR, "perlbrew" );
http_download( 'https://raw.githubusercontent.com/gugod/App-perlbrew/master/perlbrew', $TMP_PERLBREW );
chmod 0755, $TMP_PERLBREW;
my $new_version = qx($TMP_PERLBREW version);
chomp $new_version;
if ( $new_version =~ /App::perlbrew\/(\d+\.\d+)$/ ) {
$new_version = $1;
}
else {
$TMP_PERLBREW->unlink;
die "Unable to detect version of new perlbrew!\n";
}
if ( $new_version <= $VERSION ) {
print "Your perlbrew is up-to-date (version $VERSION).\n" unless $self->{quiet};
$TMP_PERLBREW->unlink;
return;
}
print "Upgrading from $VERSION to $new_version\n" unless $self->{quiet};
system $TMP_PERLBREW, "self-install";
$TMP_PERLBREW->unlink;
}
sub run_command_uninstall {
my ( $self, $target ) = @_;
unless ($target) {
$self->run_command_help("uninstall");
exit(-1);
}
my @installed = $self->installed_perls(@_);
my ($to_delete) = grep { $_->{name} eq $target } @installed;
die "'$target' is not installed\n" unless $to_delete;
my @dir_to_delete;
for ( @{ $to_delete->{libs} } ) {
push @dir_to_delete, $_->{dir};
}
push @dir_to_delete, $to_delete->{dir};
my $ans = ( $self->{yes} ) ? "Y" : undef;
if ( !defined($ans) ) {
require ExtUtils::MakeMaker;
$ans = ExtUtils::MakeMaker::prompt(
"\nThe following perl+lib installation(s) will be deleted:\n\n\t"
. join( "\n\t", @dir_to_delete )
. "\n\n... are you sure ? [y/N]",
"N"
);
}
if ( $ans =~ /^Y/i ) {
for (@dir_to_delete) {
print "Deleting: $_\n" unless $self->{quiet};
App::Perlbrew::Path->new($_)->rmpath;
print "Deleted: $_\n" unless $self->{quiet};
}
}
lib/App/perlbrew.pm view on Meta::CPAN
$out .= "Using system perl." . "\n";
$out .= "Shebang: " . $self->system_perl_shebang . "\n";
}
$out .= "\nperlbrew:\n";
$out .= " version: " . $self->VERSION . "\n";
$out .= " ENV:\n";
for ( map { "PERLBREW_$_" } qw(ROOT HOME PATH MANPATH) ) {
$out .= " $_: " . ( $self->env($_) || "" ) . "\n";
}
if ($module) {
my $code =
qq{eval "require $module" and do { (my \$f = "$module") =~ s<::></>g; \$f .= ".pm"; print "$module\n Location: \$INC{\$f}\n Version: " . ($module->VERSION ? $module->VERSION : "no VERSION specified" ) } or do { print "$module could not be found, is...
$out .=
"\nModule: " . $self->do_capture_current_perl( '-le', $code );
}
$out;
}
sub run_command_info {
my ($self) = shift;
print $self->format_info_output(@_);
}
sub run_command_make_shim {
my ($self, $program) = @_;
unless ($program) {
$self->run_command_help("make-shim");
return;
}
my $output = $self->{output} || $program;
if (-f $output) {
die "ERROR: $program already exists under current directory.\n";
}
my $current_env = $self->current_env
or die "ERROR: perlbrew is not activated. make-shim requires an perlbrew environment to be activated.\nRead the usage by running: perlbrew help make-shim\n";
my %env = $self->perlbrew_env( $current_env );
my $shebang = '#!' . $self->env('SHELL');
my $preemble = $self->shell_env(\%env);
my $path = $self->shell_env({ PATH => $env{"PERLBREW_PATH"} . ":" . $self->env("PATH") });
my $shim = join(
"\n",
$shebang,
$preemble,
$path,
'exec ' . $program . ' "$@"',
"\n"
);
open my $fh, ">", "$output" or die $!;
print $fh $shim;
close $fh;
chmod 0755, $output;
if ( $self->{verbose} ) {
print "The shim $output is made.\n";
}
}
sub run_command_make_pp {
my ($self, $program) = @_;
my $current_env = $self->current_env
or die "ERROR: perlbrew is not activated. make-pp requires an perlbrew environment to be activated.\nRead the usage by running: perlbrew help make-pp\n";
my $path_pp = $self->whereis_in_env("pp", $current_env)
or die "ERROR: pp cannot be found in $current_env";
my $input = $self->{input};
my $output = $self->{output};
unless ($input && $output) {
$self->run_command_help("make-pp");
return;
}
unless (-f $input) {
die "ERROR: The specified input $input do not exists\n";
}
if (-f $output) {
die "ERROR: $output already exists.\n";
}
my $sitelib = $self->do_capture_current_perl(
'-MConfig',
'-e',
'print $Config{sitelibexp}',
);
my $privlib = $self->do_capture_current_perl(
'-MConfig',
'-e',
'print $Config{privlibexp}',
);
my $locallib;
if ($self->current_lib) {
require local::lib;
my ($current_lib) = grep { $_->{is_current} } $self->local_libs();
my @llpaths = sort { length($a) <=> length($b) }
local::lib->lib_paths_for( $current_lib->{dir} );
$locallib = $llpaths[0];
}
my $perlversion = $self->do_capture_current_perl(
'-MConfig',
'-e',
'print $Config{version}',
);
my @cmd = (
$path_pp,
"-B", # core modules
( run in 1.312 second using v1.01-cache-2.11-cpan-d7f47b0818f )