New commands "require" etc. to add requirements

lib/Carton.pm

@@ -21,6 +21,10 @@ Carton - Perl module dependency manager (aka Bundler for Perl)
   > git add cpanfile cpanfile.snapshot
   > git commit -m "add Plack and Starman"
 
+  # Shortcut to add requirements to cpanfile and install modules
+  # (e.g. when you start developing with an empty local lib)
+  > carton require Plack Starman
+
   # Other developer's machine, or on a deployment box
   > carton install
   > carton exec starman -p 8080 myapp.psgi
@@ -70,6 +74,18 @@ And then you can install these dependencies via:
 
   > carton install
 
+You can also automatically add the latest module versions to the C<cpanfile>
+and install the modules in one step:
+
+  > carton require Plack Starman
+  > carton recommend --phase test Type::Tiny
+
+  # Core modules are added without version:
+  > carton require File::Spec
+
+  # To enforce the latest version of a core module:
+  > carton require --update-core File::Spec
+
 The modules are installed into your I<local> directory, and the
 dependencies tree and version information are analyzed and saved into
 I<cpanfile.snapshot> in your directory.

lib/Carton/Builder.pm

@@ -86,6 +86,24 @@ sub update {
     ) or die "Updating modules failed\n";
 }
 
+sub get_cpan_module_version {
+    my($self, $module) = @_;
+
+    my $output = $self->run_cpanm_with_output(
+        (map { ("--mirror", $_->url) } $self->effective_mirrors),
+        ( $self->index ? ("--mirror-index", $self->index) : () ),
+        ( $self->cascade ? "--cascade-search" : () ),
+        ( $self->custom_mirror ? "--mirror-only" : () ),
+        "--info", $module,
+    ) or die "Could not get version info for $module from CPAN\n";
+
+    $output =~ s/\.tar\.gz$//;
+    $output =~ s/^([^\/]+\/)+([^-]+-)+([0-9\.]+)/$3/;
+    chomp($output);
+
+    return $output;
+}
+
 sub _build_fatscript {
     my $self = shift;
 
@@ -111,4 +129,16 @@ sub run_cpanm {
     !system $^X, $self->fatscript, "--quiet", "--notest", @args;
 }
 
+sub run_cpanm_with_output {
+    my($self, @args) = @_;
+
+    local $ENV{PERL_CPANM_OPT};
+    open(CMD, '-|', $^X, $self->fatscript, "--quiet", @args);
+    my $output = do { local $/; <CMD> };
+    close CMD;
+    my $exit_value = $? >> 8;
+    return if $exit_value;
+    return $output;
+}
+
 1;

lib/Carton/CLI.pm

@@ -402,4 +402,94 @@ sub cmd_exec {
     }
 }
 
+sub cmd_require {
+    my($self, @args) = @_;
+    $self->add_dependency("requires", @args);
+}
+
+sub cmd_recommend {
+    my($self, @args) = @_;
+    $self->add_dependency("recommends", @args);
+}
+
+sub cmd_suggest {
+    my($self, @args) = @_;
+    $self->add_dependency("suggests", @args);
+}
+
+sub add_dependency {
+    my($self, $type, @args) = @_;
+
+    my $phase = "runtime";
+    my $update_core;
+
+    $self->parse_options(
+        \@args,
+        "phase=s"     => \$phase,
+        "update-core" => \$update_core,
+    );
+
+    # Check for module name(s)
+    unless (@args) {
+        $self->error("'carton require' needs one or more module names to run.\n");
+    }
+
+    # Check for valid --phase
+    my @phases = qw(configure build test runtime develop);
+    unless (grep { /\Q$phase\E/ } @phases) {
+        die sprintf("Phase must be one of: %s\n", join(", ", @phases)) ;
+    }
+
+    my $env = Carton::Environment->build;
+    $env->cpanfile->load;
+
+    my $builder = Carton::Builder->new(
+        mirror => $self->mirror,
+        cpanfile => $env->cpanfile,
+    );
+
+    # Build list (hash) of existing requirements in cpanfile
+    my $re_modules = join "|", map { qr/^\Q$_\E$/ } @args;
+    my %existing = map { $_ => 1 } grep { $_ =~ $re_modules } $env->cpanfile->prereqs->requirements_for($phase, $type)->required_modules;
+
+    # same as: my $file = $env->cpanfile->_cpanfile
+    my $cpanfile = Module::CPANfile->load($env->cpanfile->path);
+
+    for my $module (@args) {
+        my $is_core = $env->snapshot->find_in_core($module);
+
+        # Do not change existing entries
+        if ($existing{$module} and (!$is_core or !$update_core)) {
+            $self->print("$module is already a requirement, use 'carton update' to update version\n", INFO);
+            next;
+        }
+
+        my $version;
+        # Core modules: add without version
+        if ($is_core and !$update_core) {
+            $version = undef;
+            $self->print("Adding $module (core module) without version. To enforce newer version use --update-core\n", INFO);
+        }
+        # Standard modules
+        else {
+            $version = $builder->get_cpan_module_version($module);
+            $self->printf("Adding $module ($version)%s%s\n", $is_core ? " as recent version of core module" : "", $phase ne "runtime" ? " to phase $phase" : "", INFO);
+        }
+
+        $cpanfile->{_prereqs}->add_prereq(
+            phase       => $phase,
+            type        => $type,
+            module      => $module,
+            requirement => Module::CPANfile::Requirement->new(name => $module, version => $version),
+        );
+
+    }
+
+    # Save cpanfile
+    $cpanfile->save($env->cpanfile->path);
+
+    # Install newly added modules
+    $self->cmd_install;
+}
+
 1;

lib/Carton/Doc/Recommend.pod

@@ -0,0 +1,11 @@
+=head1 NAME
+
+Carton::Doc::Recommend - Add module as recommendation to cpanfile and install it
+
+=head1 SYNOPSIS
+
+  carton recommend [--phase PHASE] [--update-core] Module Module ...
+
+=head1 DESCRIPTION
+
+Please see L<Carton::Doc::Require> for details.

lib/Carton/Doc/Require.pod

@@ -0,0 +1,39 @@
+=head1 NAME
+
+Carton::Doc::Require - Add module as requirement to cpanfile and install it
+
+=head1 SYNOPSIS
+
+  carton require [--phase PHASE] [--update-core] Module Module ...
+
+=head1 DESCRIPTION
+
+Query CPAN for the latest module version and add that version as a requirement
+to the I<cpanfile>. Then C<carton install> is executed.
+
+You can specify several space separated modules at once.
+
+If a core module is given then per default no version will be added (and thus no
+update takes place) to ensure maximum compatibility. You can enforce updates of
+core modules with the C<--update-core> option.
+
+=head1 OPTIONS
+
+=over 4
+
+=item --phase PHASE
+
+Specify the phase for the requirement. PHASE must be one of C<configure>,
+C<build>, C<test>, C<runtime> or C<develop>.
+
+Default phase is C<runtime>.
+
+=back
+
+=over 4
+
+=item --update-core
+
+Enforce latest versions even for core modules. This might result in updates.
+
+=back

lib/Carton/Doc/Suggest.pod

@@ -0,0 +1,11 @@
+=head1 NAME
+
+Carton::Doc::Suggest - Add module as suggestion to cpanfile and install it
+
+=head1 SYNOPSIS
+
+  carton suggest [--phase PHASE] [--update-core] Module Module ...
+
+=head1 DESCRIPTION
+
+Please see L<Carton::Doc::Require> for details.

xt/cli/require.t

@@ -0,0 +1,101 @@
+use strict;
+use Test::More;
+use xt::CLI;
+
+
+subtest 'carton require' => sub {
+    my $app = cli();
+    $app->write_cpanfile();
+
+    $app->run("require", "Try::Tiny");
+    $app->run("tree");
+    like $app->stdout, qr/Try::Tiny/;
+};
+
+subtest 'carton require - without module name' => sub {
+    my $app = cli();
+    $app->write_cpanfile();
+
+    $app->run("require");
+    like $app->stderr, qr/module/;
+    is $app->exit_code, 255;
+};
+
+subtest 'carton require - unknown module' => sub {
+    my $app = cli();
+    $app->write_cpanfile();
+
+    $app->run("require", "CyberspaceHasGotToBeAnAnarchyAPirateConceptInAndOutAndOverMe");
+    is $app->exit_code, 255;
+
+    $app->run("tree");
+    unlike $app->stdout, qr/CyberspaceHasGotToBeAnAnarchyAPirateConceptInAndOutAndOverMe/;
+};
+
+subtest 'carton require - module already in cpanfile' => sub {
+    my $app = cli();
+    $app->write_cpanfile(<<EOF);
+requires 'Try::Tiny';
+EOF
+
+    $app->run("require", "Try::Tiny");
+    like $app->stdout, qr/already/;
+};
+
+subtest 'carton require - core module' => sub {
+    my $app = cli();
+    $app->write_cpanfile();
+
+    $app->run("require", "File::Spec");
+    like $app->stdout, qr/core/;
+    like $app->dir->child('cpanfile')->slurp, qr/requires 'File::Spec';/;
+};
+
+subtest 'carton require - new core module with forced update' => sub {
+    my $app = cli();
+    $app->write_cpanfile();
+
+    $app->run("require", "--update-core", "File::Spec");
+    like $app->stdout, qr/core/;
+    like $app->dir->child('cpanfile')->slurp, qr/requires 'File::Spec', '[0-9\.]+';/;
+};
+
+subtest 'carton require - existing core module with forced update' => sub {
+    my $app = cli();
+    $app->write_cpanfile(<<EOF);
+requires 'File::Spec';
+EOF
+
+    $app->run("require", "--update-core", "File::Spec");
+    like $app->stdout, qr/core/;
+    like $app->dir->child('cpanfile')->slurp, qr/requires 'File::Spec', '[0-9\.]+';/;
+};
+
+subtest 'carton require for develop phase' => sub {
+    my $app = cli();
+    $app->write_cpanfile();
+
+    $app->run("require", "--phase", "develop", "Try::Tiny");
+    like $app->stdout, qr/develop/;
+
+    $app->run("tree");
+    like $app->stdout, qr/Try::Tiny/;
+};
+
+subtest 'carton recommend' => sub {
+    my $app = cli();
+    $app->write_cpanfile();
+
+    $app->run("recommend", "Try::Tiny");
+    like $app->dir->child('cpanfile')->slurp, qr/recommends.*Try::Tiny/;
+};
+
+subtest 'carton suggest' => sub {
+    my $app = cli();
+    $app->write_cpanfile();
+
+    $app->run("suggest", "Try::Tiny");
+    like $app->dir->child('cpanfile')->slurp, qr/suggests.*Try::Tiny/;
+};
+
+done_testing;