Script 'mail_helper' called by obssrc Hello community, here is the log from the commit of package perl-App-perlbrew for openSUSE:Factory checked in at 2021-12-07 00:00:10 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/perl-App-perlbrew (Old) and /work/SRC/openSUSE:Factory/.perl-App-perlbrew.new.31177 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "perl-App-perlbrew" Tue Dec 7 00:00:10 2021 rev:29 rq:936020 version:0.94 Changes: -------- --- /work/SRC/openSUSE:Factory/perl-App-perlbrew/perl-App-perlbrew.changes 2021-04-22 18:06:29.174746485 +0200 +++ /work/SRC/openSUSE:Factory/.perl-App-perlbrew.new.31177/perl-App-perlbrew.changes 2021-12-07 00:01:36.420092313 +0100 @@ -1,0 +2,16 @@ +Sun Dec 5 03:06:08 UTC 2021 - Tina M??ller <[email protected]> + +- updated to 0.94 + see /usr/share/doc/packages/perl-App-perlbrew/Changes + + 0.94 + - Released at 2021-12-05T08:39:16+0900 + - Let `self-upgrade` print version numbers when doing upgrades. Github issue #678. + + 0.93 + - Released at 2021-11-22T23:09:25+0900 + - Let `clone-modules` takes just one arguments and mean 'cloning modules from that perl'. + - Let `list-modules` and `clone-modules` map certain output to their representative module name. Github issue #722 + - `exec` command now takes aliases explicitly specified in `--with` args and run commands with those aliases -- even if that would run the same thing twice. Github issue #725 + +------------------------------------------------------------------- Old: ---- App-perlbrew-0.92.tar.gz New: ---- App-perlbrew-0.94.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ perl-App-perlbrew.spec ++++++ --- /var/tmp/diff_new_pack.3sePVj/_old 2021-12-07 00:01:37.160089696 +0100 +++ /var/tmp/diff_new_pack.3sePVj/_new 2021-12-07 00:01:37.164089682 +0100 @@ -18,7 +18,7 @@ %define cpan_name App-perlbrew Name: perl-App-perlbrew -Version: 0.92 +Version: 0.94 Release: 0 Summary: Manage perl installations in your C<$HOME> License: MIT @@ -28,8 +28,8 @@ BuildArch: noarch BuildRequires: perl BuildRequires: perl-macros -BuildRequires: perl(CPAN::Perl::Releases) >= 5.20210320 -BuildRequires: perl(Capture::Tiny) >= 0.36 +BuildRequires: perl(CPAN::Perl::Releases) >= 5.20210620 +BuildRequires: perl(Capture::Tiny) >= 0.48 BuildRequires: perl(Devel::PatchPerl) >= 2.08 BuildRequires: perl(ExtUtils::MakeMaker) >= 7.22 BuildRequires: perl(File::Temp) >= 0.2304 @@ -48,8 +48,8 @@ BuildRequires: perl(Test::Spec) >= 0.49 BuildRequires: perl(Test::TempDir::Tiny) >= 0.016 BuildRequires: perl(local::lib) >= 2.000014 -Requires: perl(CPAN::Perl::Releases) >= 5.20210320 -Requires: perl(Capture::Tiny) >= 0.36 +Requires: perl(CPAN::Perl::Releases) >= 5.20210620 +Requires: perl(Capture::Tiny) >= 0.48 Requires: perl(Devel::PatchPerl) >= 2.08 Requires: perl(ExtUtils::MakeMaker) >= 7.22 Requires: perl(File::Temp) >= 0.2304 ++++++ App-perlbrew-0.92.tar.gz -> App-perlbrew-0.94.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/App-perlbrew-0.92/Changes new/App-perlbrew-0.94/Changes --- old/App-perlbrew-0.92/Changes 2021-04-15 16:56:02.000000000 +0200 +++ new/App-perlbrew-0.94/Changes 2021-12-05 00:42:00.000000000 +0100 @@ -1,3 +1,13 @@ +0.94 + - Released at 2021-12-05T08:39:16+0900 + - Let `self-upgrade` print version numbers when doing upgrades. Github issue #678. + +0.93 + - Released at 2021-11-22T23:09:25+0900 + - Let `clone-modules` takes just one arguments and mean 'cloning modules from that perl'. + - Let `list-modules` and `clone-modules` map certain output to their representative module name. Github issue #722 + - `exec` command now takes aliases explicitly specified in `--with` args and run commands with those aliases -- even if that would run the same thing twice. Github issue #725 + 0.92 - Released at 2021-04-15T23:53:55+0900 - Thanks to our contributors: chee diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/App-perlbrew-0.92/MANIFEST new/App-perlbrew-0.94/MANIFEST --- old/App-perlbrew-0.92/MANIFEST 2021-04-15 16:56:02.000000000 +0200 +++ new/App-perlbrew-0.94/MANIFEST 2021-12-05 00:42:00.000000000 +0100 @@ -7,6 +7,7 @@ META.yml README cpanfile +lib/App/Perlbrew/HTTP.pm lib/App/Perlbrew/Path.pm lib/App/Perlbrew/Path/Installation.pm lib/App/Perlbrew/Path/Installations.pm @@ -74,6 +75,7 @@ t/installation.t t/installation2.t t/installation3.t +t/list_modules.t t/test.tar.gz t/test_helpers.pl t/unit-files-are-the-same.t diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/App-perlbrew-0.92/META.json new/App-perlbrew-0.94/META.json --- old/App-perlbrew-0.92/META.json 2021-04-15 16:56:02.000000000 +0200 +++ new/App-perlbrew-0.94/META.json 2021-12-05 00:42:00.000000000 +0100 @@ -27,8 +27,8 @@ }, "runtime" : { "requires" : { - "CPAN::Perl::Releases" : "5.20210320", - "Capture::Tiny" : "0.36", + "CPAN::Perl::Releases" : "5.20210620", + "Capture::Tiny" : "0.48", "Devel::PatchPerl" : "2.08", "ExtUtils::MakeMaker" : "7.22", "File::Copy" : "0", @@ -55,6 +55,9 @@ } }, "provides" : { + "App::Perlbrew::HTTP" : { + "file" : "lib/App/Perlbrew/HTTP.pm" + }, "App::Perlbrew::Path" : { "file" : "lib/App/Perlbrew/Path.pm" }, @@ -72,7 +75,7 @@ }, "App::perlbrew" : { "file" : "lib/App/perlbrew.pm", - "version" : "0.92" + "version" : "0.94" } }, "release_status" : "stable", @@ -86,7 +89,7 @@ "web" : "https://github.com/gugod/App-perlbrew"; } }, - "version" : "0.92", + "version" : "0.94", "x_serialization_backend" : "JSON::PP version 4.04", "x_spdx_expression" : "MIT", "x_static_install" : "1" diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/App-perlbrew-0.92/META.yml new/App-perlbrew-0.94/META.yml --- old/App-perlbrew-0.92/META.yml 2021-04-15 16:56:02.000000000 +0200 +++ new/App-perlbrew-0.94/META.yml 2021-12-05 00:42:00.000000000 +0100 @@ -23,6 +23,8 @@ version: '1.4' name: App-perlbrew provides: + App::Perlbrew::HTTP: + file: lib/App/Perlbrew/HTTP.pm App::Perlbrew::Path: file: lib/App/Perlbrew/Path.pm App::Perlbrew::Path::Installation: @@ -35,10 +37,10 @@ file: lib/App/Perlbrew/Util.pm App::perlbrew: file: lib/App/perlbrew.pm - version: '0.92' + version: '0.94' requires: - CPAN::Perl::Releases: '5.20210320' - Capture::Tiny: '0.36' + CPAN::Perl::Releases: '5.20210620' + Capture::Tiny: '0.48' Devel::PatchPerl: '2.08' ExtUtils::MakeMaker: '7.22' File::Copy: '0' @@ -50,7 +52,7 @@ resources: bugtracker: https://github.com/gugod/App-perlbrew/issues repository: https://github.com/gugod/App-perlbrew.git -version: '0.92' +version: '0.94' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' x_spdx_expression: MIT x_static_install: '1' diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/App-perlbrew-0.92/cpanfile new/App-perlbrew-0.94/cpanfile --- old/App-perlbrew-0.92/cpanfile 2021-04-15 16:56:02.000000000 +0200 +++ new/App-perlbrew-0.94/cpanfile 2021-12-05 00:42:00.000000000 +0100 @@ -1,6 +1,8 @@ -requires 'CPAN::Perl::Releases' => '5.20210320'; -requires 'Capture::Tiny' => '0.36'; +# Always requires the latest for this two. +requires 'CPAN::Perl::Releases' => '5.20210620'; requires 'Devel::PatchPerl' => '2.08'; + +requires 'Capture::Tiny' => '0.48'; requires 'Pod::Parser' => '1.63'; requires 'Pod::Usage' => '1.68'; requires 'File::Copy' => '0'; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/App-perlbrew-0.92/lib/App/Perlbrew/HTTP.pm new/App-perlbrew-0.94/lib/App/Perlbrew/HTTP.pm --- old/App-perlbrew-0.92/lib/App/Perlbrew/HTTP.pm 1970-01-01 01:00:00.000000000 +0100 +++ new/App-perlbrew-0.94/lib/App/Perlbrew/HTTP.pm 2021-12-05 00:42:00.000000000 +0100 @@ -0,0 +1,123 @@ +package App::Perlbrew::HTTP; +use strict; +use warnings; +use 5.008; + +use Exporter 'import'; +our @EXPORT_OK = qw(http_user_agent_program http_user_agent_command http_get http_download); + +our $HTTP_USER_AGENT_PROGRAM; + +my %commands = ( + curl => { + test => '--version >/dev/null 2>&1', + get => '--silent --location --fail -o - {url}', + download => '--silent --location --fail -o {output} {url}', + order => 1, + + # Exit code is 22 on 404s etc + die_on_error => sub { die 'Page not retrieved; HTTP error code 400 or above.' if ($_[ 0 ] >> 8 == 22); }, + }, + wget => { + test => '--version >/dev/null 2>&1', + get => '--quiet -O - {url}', + download => '--quiet -O {output} {url}', + order => 2, + + # Exit code is not 0 on error + die_on_error => sub { die 'Page not retrieved: fetch failed.' if ($_[ 0 ]); }, + }, + fetch => { + test => '--version >/dev/null 2>&1', + get => '-o - {url}', + download => '-o {output} {url}', + order => 3, + + # Exit code is 8 on 404s etc + die_on_error => sub { die 'Server issued an error response.' if ($_[ 0 ] >> 8 == 8); }, + } +); + +sub http_user_agent_program { + $HTTP_USER_AGENT_PROGRAM ||= do { + my $program; + + for my $p (sort {$commands{$a}{order}<=>$commands{$b}{order}} keys %commands) { + my $code = system("$p $commands{$p}->{test}") >> 8; + if ($code != 127) { + $program = $p; + last; + } + } + + unless ($program) { + die "[ERROR] Cannot find a proper http user agent program. Please install curl or wget.\n"; + } + + $program; + }; + + die "[ERROR] Unrecognized http user agent program: $HTTP_USER_AGENT_PROGRAM. It can only be one of: ".join(",", keys %commands)."\n" unless $commands{$HTTP_USER_AGENT_PROGRAM}; + + return $HTTP_USER_AGENT_PROGRAM; +} + +sub http_user_agent_command { + my ($purpose, $params) = @_; + my $ua = http_user_agent_program; + my $cmd = $ua . " " . $commands{ $ua }->{ $purpose }; + for (keys %$params) { + $cmd =~ s!{$_}!$params->{$_}!g; + } + return ($ua, $cmd) if wantarray; + return $cmd; +} + +sub http_download { + my ($url, $path) = @_; + + if (-e $path) { + die "ERROR: The download target < $path > already exists.\n"; + } + + my $partial = 0; + local $SIG{TERM} = local $SIG{INT} = sub { $partial++ }; + + my $download_command = http_user_agent_command(download => { url => $url, output => $path }); + + my $status = system($download_command); + if ($partial) { + $path->unlink; + return "ERROR: Interrupted."; + } + unless ($status == 0) { + $path->unlink; + return "ERROR: Failed to execute the command\n\n\t$download_command\n\nReason:\n\n\t$?"; + } + return 0; +} + +sub http_get { + my ($url, $header, $cb) = @_; + + if (ref($header) eq 'CODE') { + $cb = $header; + $header = undef; + } + + my ($program, $command) = http_user_agent_command(get => { url => $url }); + + open my $fh, '-|', $command + or die "open() pipe for '$command': $!"; + + local $/; + my $body = <$fh>; + close $fh; + + # check if the download has failed and die automatically + $commands{ $program }{ die_on_error }->($?); + + return $cb ? $cb->($body) : $body; +} + +1; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/App-perlbrew-0.92/lib/App/Perlbrew/Path.pm new/App-perlbrew-0.94/lib/App/Perlbrew/Path.pm --- old/App-perlbrew-0.92/lib/App/Perlbrew/Path.pm 2021-04-15 16:56:02.000000000 +0200 +++ new/App-perlbrew-0.94/lib/App/Perlbrew/Path.pm 2021-12-05 00:42:00.000000000 +0100 @@ -3,9 +3,9 @@ package App::Perlbrew::Path; -require File::Basename; -require File::Glob; -require File::Path; +use File::Basename (); +use File::Glob (); +use File::Path (); use overload ( '""' => \& stringify, @@ -29,8 +29,7 @@ sub _children { my ($self, $package) = @_; - return map $package->new($_), - File::Glob::bsd_glob($self->child("*")) + map { $package->new($_) } File::Glob::bsd_glob($self->child("*")); } sub new { @@ -42,7 +41,7 @@ sub basename { my ($self, $suffix) = @_; - return scalar File::Basename::fileparse ($self, ($suffix) x!! defined $suffix); + return scalar File::Basename::fileparse($self, ($suffix) x!! defined $suffix); } sub child { @@ -60,19 +59,19 @@ sub dirname { my ($self) = @_; - return App::Perlbrew::Path->new(File::Basename::dirname ($self)); + return App::Perlbrew::Path->new( File::Basename::dirname($self) ); } sub mkpath { my ($self) = @_; - File::Path::mkpath ([$self->stringify], 0, 0777); + File::Path::mkpath( [$self->stringify], 0, 0777 ); return $self; } sub readlink { my ($self) = @_; - my $link = readlink $self->stringify; + my $link = CORE::readlink( $self->stringify ); $link = __PACKAGE__->new($link) if defined $link; return $link; @@ -80,7 +79,7 @@ sub rmpath { my ($self) = @_; - File::Path::rmtree([$self->stringify], 0, 0); + File::Path::rmtree( [$self->stringify], 0, 0 ); return $self; } @@ -102,15 +101,14 @@ my ($self, $destination, $force) = @_; $destination = App::Perlbrew::Path->new($destination) unless ref $destination; - CORE::unlink $destination if $force && (-e $destination || -l $destination); + CORE::unlink($destination) if $force && (-e $destination || -l $destination); - $destination if CORE::symlink $self, $destination; + $destination if CORE::symlink($self, $destination); } sub unlink { my ($self) = @_; - - CORE::unlink ($self); + CORE::unlink($self); } 1; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/App-perlbrew-0.92/lib/App/perlbrew.pm new/App-perlbrew-0.94/lib/App/perlbrew.pm --- old/App-perlbrew-0.92/lib/App/perlbrew.pm 2021-04-15 16:56:02.000000000 +0200 +++ new/App-perlbrew-0.94/lib/App/perlbrew.pm 2021-12-05 00:42:00.000000000 +0100 @@ -2,7 +2,7 @@ use strict; use warnings; use 5.008; -our $VERSION = "0.92"; +our $VERSION = "0.94"; use Config; BEGIN { @@ -23,10 +23,12 @@ use CPAN::Perl::Releases; use JSON::PP 'decode_json'; use File::Copy 'copy'; +use Capture::Tiny (); use App::Perlbrew::Util; use App::Perlbrew::Path; use App::Perlbrew::Path::Root; +use App::Perlbrew::HTTP qw(http_get http_download); ### global variables @@ -86,121 +88,6 @@ } } -{ - my %commands = ( - curl => { - test => '--version >/dev/null 2>&1', - get => '--silent --location --fail -o - {url}', - download => '--silent --location --fail -o {output} {url}', - order => 1, - - # Exit code is 22 on 404s etc - die_on_error => sub { die 'Page not retrieved; HTTP error code 400 or above.' if ($_[ 0 ] >> 8 == 22); }, - }, - wget => { - test => '--version >/dev/null 2>&1', - get => '--quiet -O - {url}', - download => '--quiet -O {output} {url}', - order => 2, - - # Exit code is not 0 on error - die_on_error => sub { die 'Page not retrieved: fetch failed.' if ($_[ 0 ]); }, - }, - fetch => { - test => '--version >/dev/null 2>&1', - get => '-o - {url}', - download => '-o {output} {url}', - order => 3, - - # Exit code is 8 on 404s etc - die_on_error => sub { die 'Server issued an error response.' if ($_[ 0 ] >> 8 == 8); }, - } - ); - - our $HTTP_USER_AGENT_PROGRAM; - sub http_user_agent_program { - $HTTP_USER_AGENT_PROGRAM ||= do { - my $program; - - for my $p (sort {$commands{$a}{order}<=>$commands{$b}{order}} keys %commands) { - my $code = system("$p $commands{$p}->{test}") >> 8; - if ($code != 127) { - $program = $p; - last; - } - } - - unless ($program) { - die "[ERROR] Cannot find a proper http user agent program. Please install curl or wget.\n"; - } - - $program; - }; - - die "[ERROR] Unrecognized http user agent program: $HTTP_USER_AGENT_PROGRAM. It can only be one of: ".join(",", keys %commands)."\n" unless $commands{$HTTP_USER_AGENT_PROGRAM}; - - return $HTTP_USER_AGENT_PROGRAM; - } - - sub http_user_agent_command { - my ($purpose, $params) = @_; - my $ua = http_user_agent_program; - my $cmd = $ua . " " . $commands{ $ua }->{ $purpose }; - for (keys %$params) { - $cmd =~ s!{$_}!$params->{$_}!g; - } - return ($ua, $cmd) if wantarray; - return $cmd; - } - - sub http_download { - my ($url, $path) = @_; - - if (-e $path) { - die "ERROR: The download target < $path > already exists.\n"; - } - - my $partial = 0; - local $SIG{TERM} = local $SIG{INT} = sub { $partial++ }; - - my $download_command = http_user_agent_command(download => { url => $url, output => $path }); - - my $status = system($download_command); - if ($partial) { - $path->unlink; - return "ERROR: Interrupted."; - } - unless ($status == 0) { - $path->unlink; - return "ERROR: Failed to execute the command\n\n\t$download_command\n\nReason:\n\n\t$?"; - } - return 0; - } - - sub http_get { - my ($url, $header, $cb) = @_; - - if (ref($header) eq 'CODE') { - $cb = $header; - $header = undef; - } - - my ($program, $command) = http_user_agent_command(get => { url => $url }); - - open my $fh, '-|', $command - or die "open() pipe for '$command': $!"; - - local $/; - my $body = <$fh>; - close $fh; - - # check if the download has failed and die automatically - $commands{ $program }{ die_on_error }->($?); - - return $cb ? $cb->($body) : $body; - } -} - ### methods sub new { my($class, @argv) = @_; @@ -1890,7 +1777,6 @@ sub do_capture { my ($self, @cmd) = @_; - require Capture::Tiny; return Capture::Tiny::capture( sub { $self->do_system(@cmd); @@ -2346,10 +2232,14 @@ } else { die "Unable to detect version of new perlbrew!\n"; } + if ($new_version <= $VERSION) { - print "Your perlbrew is up-to-date.\n"; + print "Your perlbrew is up-to-date (version $VERSION).\n" unless $self->{quiet}; return; } + + print "Upgrading from $VERSION to $new_version\n" unless $self->{quiet}; + system $TMP_PERLBREW, "self-install"; $TMP_PERLBREW->unlink; } @@ -2417,20 +2307,21 @@ } split $d, $opts{with}; @exec_with = map { $installed{$_} } @with; - } - else { - @exec_with = map { ($_, @{$_->{libs}}) } $self->installed_perls; + } else { + @exec_with = grep { + not -l $self->root->perls( $_->{name} ); # Skip Aliases + } map { ($_, @{$_->{libs}}) } $self->installed_perls; } if ($opts{min}) { # TODO use comparable version. # For now, it doesn't produce consistent results for 5.026001 and 5.26.1 @exec_with = grep { $_->{orig_version} >= $opts{min} } @exec_with; - }; + } if ($opts{max}) { @exec_with = grep { $_->{orig_version} <= $opts{max} } @exec_with; - }; + } if (0 == @exec_with) { print "No perl installation found.\n" unless $self->{quiet}; @@ -2443,7 +2334,6 @@ my $overall_success = 1; for my $i ( @exec_with ) { - next if -l $self->root->perls ($i->{name}); # Skip Aliases my %env = $self->perlbrew_env($i->{name}); next if !$env{PERLBREW_PERL}; @@ -2520,8 +2410,7 @@ $path_alias->unlink; $path_name->symlink ($path_alias); - } - elsif ($cmd eq 'delete') { + } elsif ($cmd eq 'delete') { $self->assert_known_installation($name); unless (-l $path_name) { @@ -2529,8 +2418,7 @@ } $path_name->unlink; - } - elsif ($cmd eq 'rename') { + } elsif ($cmd eq 'rename') { $self->assert_known_installation($name); unless (-l $path_name) { @@ -2542,11 +2430,9 @@ } rename($path_name, $path_alias); - } - elsif ($cmd eq 'help') { + } elsif ($cmd eq 'help') { $self->run_command_help("alias"); - } - else { + } else { die "\nERROR: Unrecognized action: `${cmd}`.\n\n"; } } @@ -2574,8 +2460,7 @@ my $sub = "run_command_lib_$subcommand"; if ($self->can($sub)) { $self->$sub(@args); - } - else { + } else { print "Unknown command: $subcommand\n"; } } @@ -2603,8 +2488,7 @@ $dir->mkpath; - print "lib '$fullname' is created.\n" - unless $self->{quiet}; + print "lib '$fullname' is created.\n" unless $self->{quiet}; return; } @@ -2633,9 +2517,8 @@ $dir->rmpath; print "lib '$fullname' is deleted.\n" - unless $self->{quiet}; - } - else { + unless $self->{quiet}; + } else { die "ERROR: '$fullname' does not exist.\n"; } @@ -2705,7 +2588,6 @@ local $self->{as} = $current->{name}; local $self->{dist_name} = $dist; - require Config ; my @d_options = map { '-D' . $flavor{$_}->{d_option}} keys %flavor ; my %sub_config = map { $_ => $Config{$_}} grep { /^config_arg\d/} keys %Config ; for my $value (values %sub_config) { @@ -2717,37 +2599,44 @@ $self->do_install_release($dist, $dist_version); } -# Executes the list-modules command. -# This routine launches a new perl instance that, thru -# ExtUtils::Installed prints out all the modules -# in the system. If an argument is passed to the -# subroutine it is managed as a filename -# to which prints the list of modules. -sub run_command_list_modules { - my ($self, $output_filename) = @_; - my $class = ref($self) || __PACKAGE__; - - # avoid something that does not seem as a filename to print - # output to... - undef $output_filename if (! scalar($output_filename)); +sub list_modules { + my ($self, $env) = @_; - my $name = $self->current_env; - if (-l (my $path = $self->root->perls ($name))) { - $name = $path->readlink->basename; - } + $env ||= $self->current_env; + my ($stdout, $stderr, $success) = Capture::Tiny::capture( + sub { + __PACKAGE__->new( + "--quiet", "exec", "--with", $env, 'perl', '-MExtUtils::Installed', '-le', + 'BEGIN{@INC=grep {$_ ne q!.!} @INC}; print for ExtUtils::Installed->new->modules;', + )->run; + } + ); - my $app = $class->new( - qw(--quiet exec --with), - $name, - 'perl', - '-MExtUtils::Installed', - '-le', - sprintf('BEGIN{@INC=grep {$_ ne q!.!} @INC}; %s print {%s} $_ for grep {$_ ne q!Perl!} ExtUtils::Installed->new->modules;', - $output_filename ? sprintf('open my $output_fh, \'>\', "%s"; ', $output_filename) : '', - $output_filename ? '$output_fh' : 'STDOUT') + unless ($success) { + unless ($self->{quiet}) { + print STDERR "Failed to retrive the list of installed modules.\n"; + if ($self->{verbose}) { + print STDERR "STDOUT\n======\n$stdout\nSTDERR\n======\n$stderr\n"; + } + } + return []; + } + + my %rename = ( + "ack" => "App::Ack", + "libwww::perl" => "LWP", + "libintl-perl" => "Locale::Messages", + "Role::Identifiable" => "Role::Identifiable::HasTags", + "TAP::Harness::Multiple" => "TAP::Harness::ReportByDescription", ); - $app->run; + return [map { $rename{$_} // $_ } grep { $_ ne "Perl" } split(/\n/, $stdout)]; +} + +sub run_command_list_modules { + my ($self) = @_; + my ($modules, $error) = $self->list_modules(); + print "$_\n" for @$modules; } sub resolve_installation_name { @@ -2806,53 +2695,28 @@ $dst_perl = pop || $self->current_env; $src_perl = pop || $self->current_env; - # check source and destination do exist undef $src_perl if (! $self->resolve_installation_name($src_perl)); undef $dst_perl if (! $self->resolve_installation_name($dst_perl)); if ( ! $src_perl || ! $dst_perl - || $src_perl eq $dst_perl ){ + || $src_perl eq $dst_perl ) { # cannot understand from where to where or # the user did specify the same versions $self->run_command_help('clone-modules'); exit(-1); } + my @modules_to_install = @{ $self->list_modules($src_perl) }; - # I need to run an application to do the module listing. - # and get the result back so to handle it and pass - # to the exec subroutine. The solution I found so far - # is to store the result in a temp file (the list_modules - # uses a sub-perl process, so there is no way to pass a - # filehandle or something similar). - my $class = ref($self); - require File::Temp; - my $modules_fh = File::Temp->new; - - # list all the modules and place them in the output file - my $src_app = $class->new( - qw(--quiet exec --with), - $src_perl, - 'perl', - '-MExtUtils::Installed', - '-le', - sprintf('BEGIN{@INC=grep {$_ ne q!.!} @INC}; open my $output_fh, ">", "%s"; print {$output_fh} $_ for ExtUtils::Installed->new->modules;', - $modules_fh->filename ) - ); - - $src_app->run; + unless (@modules_to_install) { + print "\nNo modules installed on $src_perl !\n" unless $self->{quiet}; + return; + } - # here I should have the list of modules into the - # temporary file name, so I can ask the destination - # perl instance to install such list - $modules_fh->close; - open $modules_fh, '<', $modules_fh->filename; - chomp(my @modules_to_install = <$modules_fh>); - $modules_fh->close; - die "\nNo modules installed on $src_perl !\n" if (! @modules_to_install); - print "\nInstalling $#modules_to_install modules from $src_perl to $dst_perl ...\n"; + print "\nInstalling $#modules_to_install modules from $src_perl to $dst_perl ...\n" + unless $self->{quiet}; # create a new application to 'exec' the 'cpanm' # with the specified module list @@ -2865,7 +2729,7 @@ push @args, '--notest' if $self->{notest}; push @args, @modules_to_install; - $class->new(@args)->run; + __PACKAGE__->new(@args)->run; } sub format_info_output diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/App-perlbrew-0.92/script/perlbrew new/App-perlbrew-0.94/script/perlbrew --- old/App-perlbrew-0.92/script/perlbrew 2021-04-15 16:56:02.000000000 +0200 +++ new/App-perlbrew-0.94/script/perlbrew 2021-12-05 00:42:00.000000000 +0100 @@ -640,7 +640,9 @@ =head1 COMMAND: CLONE-MODULES Usage: - perlbrew clone-modules [options] <src_version> <dst_version> + + perlbrew clone-modules [options] <destination> + perlbrew clone-modules [options] <source> <destination> Options: @@ -650,6 +652,9 @@ perlbrew clone-modules 5.26.1 5.27.7 +The argument "source" is optional and is default to the current activated one. However if none is activated (perlbrew is switched off), it it an error. + +Noted that this does not guarantee that the versions of modules stays the same in the destination. =head1 SEE ALSO diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/App-perlbrew-0.92/t/command-clone-modules.t new/App-perlbrew-0.94/t/command-clone-modules.t --- old/App-perlbrew-0.92/t/command-clone-modules.t 2021-04-15 16:56:02.000000000 +0200 +++ new/App-perlbrew-0.94/t/command-clone-modules.t 2021-12-05 00:42:00.000000000 +0100 @@ -16,23 +16,15 @@ no warnings; my ($__from, $__to, $__notest); +sub App::perlbrew::list_modules { + my ($self, $env) = @_; + $__from = $env || $self->current_env; + return ["Foo", "Bar"]; +} + sub App::perlbrew::run_command_exec { my ($self, @args) = @_; - - diag "ARGS: @args"; - - if (grep { $_ eq '-MExtUtils::Installed' } @args) { - $__from = $args[1]; - - my ($fn) = $args[5] =~ m{open .+">", "(.+?)";}; - if ($fn) { - open my $fh, ">", $fn; - print $fh "Foo\nBar\n"; - close($fh); - } else { - die "Failed to grok output path."; - } - } elsif (grep { $_ eq 'cpanm' } @args) { + if (grep { $_ eq 'cpanm' } @args) { $__to = $args[1]; ($__notest) = grep { $_ eq '--notest' } @{$self->{original_argv}}; } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/App-perlbrew-0.92/t/http-program-control.t new/App-perlbrew-0.94/t/http-program-control.t --- old/App-perlbrew-0.92/t/http-program-control.t 2021-04-15 16:56:02.000000000 +0200 +++ new/App-perlbrew-0.94/t/http-program-control.t 2021-12-05 00:42:00.000000000 +0100 @@ -1,23 +1,26 @@ #!/usr/bin/env perl use strict; use warnings; - use FindBin; use lib $FindBin::Bin; -use App::perlbrew; -require 'test_helpers.pl'; + +use App::Perlbrew::HTTP qw(http_user_agent_program); use Test::More; use Test::Exception; for my $prog (qw(curl wget fetch)) { - $App::perlbrew::HTTP_USER_AGENT_PROGRAM = $prog; - is App::perlbrew::http_user_agent_program(), $prog, "UA Program can be set to: $prog"; + subtest "UA set to $prog", sub { + local $App::Perlbrew::HTTP::HTTP_USER_AGENT_PROGRAM = $prog; + is http_user_agent_program(), $prog, "UA Program can be set to: $prog"; + }; } -$App::perlbrew::HTTP_USER_AGENT_PROGRAM = "something-that-is-not-recognized"; -dies_ok { - App::perlbrew::http_user_agent_program(); -} "should die when asked to use unrecognized http UA program"; +subtest "something not supported", sub { + local $App::Perlbrew::HTTP::HTTP_USER_AGENT_PROGRAM = "something-that-is-not-recognized"; + dies_ok { + http_user_agent_program(); + } "should die when asked to use unrecognized http UA program"; +}; done_testing; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/App-perlbrew-0.92/t/http-ua-detect-non-curl.t new/App-perlbrew-0.94/t/http-ua-detect-non-curl.t --- old/App-perlbrew-0.92/t/http-ua-detect-non-curl.t 2021-04-15 16:56:02.000000000 +0200 +++ new/App-perlbrew-0.94/t/http-ua-detect-non-curl.t 2021-12-05 00:42:00.000000000 +0100 @@ -8,7 +8,8 @@ } use File::Which qw(which); -use App::perlbrew; +use App::Perlbrew::HTTP qw(http_user_agent_program); + use Test::More; chmod 0755, "$Bin/fake-bin/curl"; @@ -28,7 +29,7 @@ } if ($expected_ua) { - my $detected_ua = App::perlbrew::http_user_agent_program(); + my $detected_ua = http_user_agent_program(); is $detected_ua, $expected_ua, "UA: $detected_ua"; } else { pass("Neither wget nor fetch can be found. This test requers at least one of them to be there."); diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/App-perlbrew-0.92/t/http-ua-detect.t new/App-perlbrew-0.94/t/http-ua-detect.t --- old/App-perlbrew-0.92/t/http-ua-detect.t 2021-04-15 16:56:02.000000000 +0200 +++ new/App-perlbrew-0.94/t/http-ua-detect.t 2021-12-05 00:42:00.000000000 +0100 @@ -2,7 +2,7 @@ use strict; use warnings; use File::Which qw(which); -use App::perlbrew; +use App::Perlbrew::HTTP qw(http_user_agent_program); use Test::More; my $expected_ua; @@ -16,7 +16,7 @@ $expected_ua = "fetch"; } -my $detected_ua = App::perlbrew::http_user_agent_program(); +my $detected_ua = http_user_agent_program(); is $detected_ua, $expected_ua, "UA: $detected_ua"; done_testing; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/App-perlbrew-0.92/t/http.t new/App-perlbrew-0.94/t/http.t --- old/App-perlbrew-0.92/t/http.t 2021-04-15 16:56:02.000000000 +0200 +++ new/App-perlbrew-0.94/t/http.t 2021-12-05 00:42:00.000000000 +0100 @@ -5,6 +5,8 @@ use File::Temp 'tempdir'; use IO::All; +use App::Perlbrew::HTTP qw(http_user_agent_program http_get http_download); + unless ($ENV{PERLBREW_DEV_TEST}) { plan skip_all => <<REASON; @@ -14,14 +16,14 @@ REASON } -my $ua = App::perlbrew::http_user_agent_program(); +my $ua = http_user_agent_program(); note "User agent program = $ua"; -describe "App::perlbrew::http_get function" => sub { +describe "http_get function" => sub { my ($output); before all => sub { - App::perlbrew::http_get( + http_get( "https://get.perlbrew.pl";, undef, sub { $output = $_[0]; } @@ -38,7 +40,7 @@ }; }; -describe "App::perlbrew::http_download function, downloading the perlbrew-installer." => sub { +describe "http_download function, downloading the perlbrew-installer." => sub { my ($dir, $output, $download_error); before all => sub { @@ -55,7 +57,7 @@ REASON } - my $download_error = App::perlbrew::http_download("https://install.perlbrew.pl";, $output); + my $download_error = http_download("https://install.perlbrew.pl";, $output); }; it "downloads to the wanted path" => sub { @@ -68,4 +70,3 @@ }; runtests unless caller; - diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/App-perlbrew-0.92/t/list_modules.t new/App-perlbrew-0.94/t/list_modules.t --- old/App-perlbrew-0.92/t/list_modules.t 1970-01-01 01:00:00.000000000 +0100 +++ new/App-perlbrew-0.94/t/list_modules.t 2021-12-05 00:42:00.000000000 +0100 @@ -0,0 +1,47 @@ +#!/usr/bin/env perl +use strict; +use warnings; + +use FindBin; +use lib $FindBin::Bin; +use App::perlbrew; +require "test_helpers.pl"; + +use Test::Spec; + +mock_perlbrew_install("perl-5.14.1"); + +describe "list_modules method," => sub { + before each => sub { + delete $ENV{PERL_MB_OPT}; + delete $ENV{PERL_MM_OPT}; + delete $ENV{PERL_LOCAL_LIB_ROOT}; + delete $ENV{PERLBREW_LIB}; + delete $ENV{PERL5LIB}; + }; + + describe "when run successfully", sub { + before each => sub { + no warnings; + sub App::perlbrew::run_command_exec { + my ($self, @args) = @_; + if (grep { $_ eq '-MExtUtils::Installed' } @args) { + print "Foo\n"; + } else { + die "Unexpected `exec`"; + } + return $self; + } + }; + + it "should return an arryref of module names ", sub { + my $app = App::perlbrew->new(); + $app->current_perl("perl-5.14.1"); + my $modules = $app->list_modules(); + is 0+@$modules, 1; + is $modules->[0], "Foo"; + }; + }; +}; + +runtests unless caller;
