Merge pull request #656 from dallaylaen/201812-min-version

Add --min and --max perl version to 'exec' command
gugod · May 9, 2019 · 870a083 · 870a083
2 parents 1640a8e + c6d647b
commit 870a083
Show file tree

Hide file tree

Showing 3 changed files with 62 additions and 2 deletions.
diff --git a/lib/App/perlbrew.pm b/lib/App/perlbrew.pm
@@ -2435,7 +2435,7 @@ sub run_command_exec {
     local (@ARGV) = @{$self->{original_argv}};
 
     Getopt::Long::Configure ('require_order');
-    my @command_options = ('with=s', 'halt-on-error');
+    my @command_options = ('with=s', 'halt-on-error', 'min=s', 'max=s');
 
     $self->parse_cmdline (\%opts, @command_options);
     shift @ARGV; # "exec"
@@ -2458,6 +2458,16 @@ sub run_command_exec {
         @exec_with = 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};
     }

diff --git a/script/perlbrew b/script/perlbrew
@@ -384,7 +384,15 @@ Usage: perlbrew alias delete <alias>
 
 =head1 COMMAND: EXEC
 
-Usage: perlbrew exec [--with perl-name[,perl-name...]] <command> <args...>
+Usage: perlbrew exec [options] <command> <args...>
+
+Options for C<exec> command:
+
+    --with perl-version,... - only use these versions
+    --min n.nnnnn           - minimum perl version
+                              (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.
 

diff --git a/t/command-exec.t b/t/command-exec.t
@@ -265,7 +265,49 @@ OUT
     };
 };
 
+describe "minimal perl version" => sub {
+    it "only executes the needed version" => sub {
 
+        my @perl_paths;
+        my $app = App::perlbrew->new(qw(exec --min 5.014), qw(perl -E), "say 42");
+        $app->expects("do_system_with_exit_code")->exactly(2)->returns(sub {
+            my ($self, @args) = @_;
+            my ($perlbrew_bin_path, $perlbrew_perl_bin_path, @paths) = split(":", $ENV{PATH});
+            push @perl_paths, $perlbrew_perl_bin_path;
+            return 0;
+        });
+
+        $app->run;
+
+        # Don't care about the order, just the fact all of them were visited
+        is_deeply [sort @perl_paths], [sort (
+            App::Perlbrew::Path->new($App::perlbrew::PERLBREW_ROOT, "perls", "perl-5.14.2", "bin"),
+            App::Perlbrew::Path->new($App::perlbrew::PERLBREW_ROOT, "perls", "perl-5.14.1", "bin"),
+        )];
+    };
+};
+
+describe "maximum perl version" => sub {
+    it "only executes the needed version" => sub {
+
+        my @perl_paths;
+        my $app = App::perlbrew->new(qw(exec --max 5.014), qw(perl -E), "say 42");
+        $app->expects("do_system_with_exit_code")->exactly(2)->returns(sub {
+            my ($self, @args) = @_;
+            my ($perlbrew_bin_path, $perlbrew_perl_bin_path, @paths) = split(":", $ENV{PATH});
+            push @perl_paths, $perlbrew_perl_bin_path;
+            return 0;
+        });
+
+        $app->run;
+
+        # Don't care about the order, just the fact all of them were visited
+        is_deeply [sort @perl_paths], [sort (
+            App::Perlbrew::Path->new($App::perlbrew::PERLBREW_ROOT, "perls", "perl-5.12.4", "bin"),
+            App::Perlbrew::Path->new($App::perlbrew::PERLBREW_ROOT, "perls", "perl-5.12.3", "bin"),
+        )];
+    };
+};
 
 
 runtests unless caller;