diff --git a/lib/Carton.pm b/lib/Carton.pm index 1f6e0a7..8d7136d 100644 --- a/lib/Carton.pm +++ b/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 +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 directory, and the dependencies tree and version information are analyzed and saved into I in your directory. diff --git a/lib/Carton/Builder.pm b/lib/Carton/Builder.pm index de456d7..2d547f2 100644 --- a/lib/Carton/Builder.pm +++ b/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 $/; }; + close CMD; + my $exit_value = $? >> 8; + return if $exit_value; + return $output; +} + 1; diff --git a/lib/Carton/CLI.pm b/lib/Carton/CLI.pm index ed9c71e..0da1038 100644 --- a/lib/Carton/CLI.pm +++ b/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; diff --git a/lib/Carton/Doc/Recommend.pod b/lib/Carton/Doc/Recommend.pod new file mode 100644 index 0000000..154fe94 --- /dev/null +++ b/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 for details. diff --git a/lib/Carton/Doc/Require.pod b/lib/Carton/Doc/Require.pod new file mode 100644 index 0000000..af416b6 --- /dev/null +++ b/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. Then C 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, +C, C, C or C. + +Default phase is C. + +=back + +=over 4 + +=item --update-core + +Enforce latest versions even for core modules. This might result in updates. + +=back diff --git a/lib/Carton/Doc/Suggest.pod b/lib/Carton/Doc/Suggest.pod new file mode 100644 index 0000000..ecaa285 --- /dev/null +++ b/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 for details. diff --git a/xt/cli/require.t b/xt/cli/require.t new file mode 100644 index 0000000..c308cc2 --- /dev/null +++ b/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(<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(<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;