[carton] 227/472: don't eat unknown options in system, effectively killing the need for --. Addresses #77

[Lucas Kanashiro]

This is an automated email from the git hooks/post-receive script.

kanashiro-guest pushed a commit to branch master
in repository carton.

commit d56de5d8a81486b75ba943c12159d475d02a6ebc
Author: Tatsuhiko Miyagawa <miyagawa at bulknews.net>
Date:   Fri May 31 10:02:42 2013 +0900

    don't eat unknown options in system, effectively killing the need for --. Addresses #77
---
 lib/Carton/CLI.pm | 19 ++++++++++++++++---
 xt/CLI.pm         |  2 ++
 xt/cli/exec.t     |  6 +++---
 3 files changed, 21 insertions(+), 6 deletions(-)

diff --git a/lib/Carton/CLI.pm b/lib/Carton/CLI.pm
index 07261c3..2288686 100644
--- a/lib/Carton/CLI.pm
+++ b/lib/Carton/CLI.pm
@@ -15,6 +15,8 @@ use Try::Tiny;
 
 use constant { SUCCESS => 0, INFO => 1, WARN => 2, ERROR => 3 };
 
+our $UseSystem = 0; # 1 for unit testing
+
 our $Colors = {
     SUCCESS, => 'green',
     WARN,    => 'yellow',
@@ -100,6 +102,18 @@ sub parse_options {
     Getopt::Long::GetOptionsFromArray($args, @spec);
 }
 
+sub parse_options_pass_through {
+    my($self, $args, @spec) = @_;
+
+    my $p = Getopt::Long::Parser->new(
+        config => [ "no_auto_abbrev", "no_ignore_case", "pass_through" ],
+    );
+    $p->getoptionsfromarray($args, @spec);
+
+    # with pass_through keeps -- in args
+    shift @$args if $args->[0] && $args->[0] eq '--';
+}
+
 sub printf {
     my $self = shift;
     my $type = pop;
@@ -260,9 +274,8 @@ sub cmd_exec {
     # allows -Ilib
     @args = map { /^(-[I])(.+)/ ? ($1,$2) : $_ } @args;
 
-    my $system; # for unit testing
     my @include;
-    $self->parse_options(\@args, 'I=s@', \@include, "system", \$system);
+    $self->parse_options_pass_through(\@args, 'I=s@', \@include);
 
     my $path = $self->carton->{path};
     my $lib  = join ",", @include, "$path/lib/perl5", ".";
@@ -270,7 +283,7 @@ sub cmd_exec {
     local $ENV{PERL5OPT} = "-Mlib::core::only -Mlib=$lib";
     local $ENV{PATH} = "$path/bin:$ENV{PATH}";
 
-    $system ? system(@args) : exec(@args);
+    $UseSystem ? system(@args) : exec(@args);
 }
 
 sub find_cpanfile {
diff --git a/xt/CLI.pm b/xt/CLI.pm
index 11295e4..27ef0eb 100644
--- a/xt/CLI.pm
+++ b/xt/CLI.pm
@@ -13,6 +13,8 @@ sub cli {
 package Carton::CLI::Tested;
 use parent qw(Carton::CLI);
 
+$Carton::CLI::UseSystem = 1;
+
 use Capture::Tiny qw(capture);
 use File::pushd;
 
diff --git a/xt/cli/exec.t b/xt/cli/exec.t
index ded5914..186ad92 100644
--- a/xt/cli/exec.t
+++ b/xt/cli/exec.t
@@ -5,7 +5,7 @@ use xt::CLI;
 {
     my $app = cli();
 
-    $app->run("exec", "--system", "--", "perl", "-e", "use Try::Tiny");
+    $app->run("exec", "--", "perl", "-e", "use Try::Tiny");
     like $app->system_error, qr/Can't locate Try\/Tiny.pm/;
 
     $app->dir->touch("cpanfile", <<EOF);
@@ -13,7 +13,7 @@ requires 'Try::Tiny';
 EOF
 
     $app->run("install");
-    $app->run("exec", "--system", "--", "perl", "-e", 'use Try::Tiny; print "OK\n"');
+    $app->run("exec", "--", "perl", "-e", 'use Try::Tiny; print "OK\n"');
 
     like $app->system_output, qr/OK/;
 
@@ -23,7 +23,7 @@ requires 'Mojolicious';
 EOF
 
     $app->run("install");
-    $app->run("exec", "--system", "--", "mojo", "version");
+    $app->run("exec", "--", "mojo", "version");
 
     like $app->system_output, qr/Mojolicious/;
 }

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/carton.git