From d8f23139debb1745c851919177a660a203a0f906 Mon Sep 17 00:00:00 2001 From: Jens Berthold Date: Thu, 14 Jul 2016 12:27:23 +0200 Subject: [PATCH 1/4] New commands "require" etc. to add requirements to cpanfile (and install) This supports a workflow where you add and install a dependency in one go. It is similar to e.g. using Node.js' package manager "npm bla --save". --- lib/Carton/Builder.pm | 30 +++++++++++++++ lib/Carton/CLI.pm | 90 +++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 120 insertions(+) diff --git a/lib/Carton/Builder.pm b/lib/Carton/Builder.pm index de456d7..d94eea3 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..9845928 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; From 95bd84e1bb060a27d7b15bf8841ae7383388d041 Mon Sep 17 00:00:00 2001 From: Jens Berthold Date: Thu, 14 Jul 2016 13:00:24 +0200 Subject: [PATCH 2/4] Documentation for "require", "recommend" and "suggest" commands --- lib/Carton.pm | 16 +++++++++++++++ lib/Carton/Doc/Recommend.pod | 11 ++++++++++ lib/Carton/Doc/Require.pod | 39 ++++++++++++++++++++++++++++++++++++ lib/Carton/Doc/Suggest.pod | 11 ++++++++++ 4 files changed, 77 insertions(+) create mode 100644 lib/Carton/Doc/Recommend.pod create mode 100644 lib/Carton/Doc/Require.pod create mode 100644 lib/Carton/Doc/Suggest.pod 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/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. From d94a6ba474ab0e670809381b06abf970a2f43347 Mon Sep 17 00:00:00 2001 From: Jens Berthold Date: Thu, 14 Jul 2016 14:14:13 +0200 Subject: [PATCH 3/4] Test code for "require", "recommend" and "suggest" commands --- xt/cli/require.t | 85 ++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 85 insertions(+) create mode 100644 xt/cli/require.t diff --git a/xt/cli/require.t b/xt/cli/require.t new file mode 100644 index 0000000..613b153 --- /dev/null +++ b/xt/cli/require.t @@ -0,0 +1,85 @@ +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/; +}; + +done_testing; From 26c0c73fb74a74607d958b465bac7335e4532312 Mon Sep 17 00:00:00 2001 From: Jens Berthold Date: Thu, 14 Jul 2016 14:20:14 +0200 Subject: [PATCH 4/4] Fixed intendation --- lib/Carton/Builder.pm | 32 ++++++------ lib/Carton/CLI.pm | 110 +++++++++++++++++++++--------------------- xt/cli/require.t | 36 ++++++++++---- 3 files changed, 97 insertions(+), 81 deletions(-) diff --git a/lib/Carton/Builder.pm b/lib/Carton/Builder.pm index d94eea3..2d547f2 100644 --- a/lib/Carton/Builder.pm +++ b/lib/Carton/Builder.pm @@ -87,21 +87,21 @@ sub update { } sub get_cpan_module_version { - my($self, $module) = @_; + my($self, $module) = @_; - my $output = $self->run_cpanm_with_output( - (map { ("--mirror", $_->url) } $self->effective_mirrors), + 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"; + "--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); + $output =~ s/\.tar\.gz$//; + $output =~ s/^([^\/]+\/)+([^-]+-)+([0-9\.]+)/$3/; + chomp($output); - return $output; + return $output; } sub _build_fatscript { @@ -130,15 +130,15 @@ sub run_cpanm { } sub run_cpanm_with_output { - my($self, @args) = @_; + my($self, @args) = @_; - local $ENV{PERL_CPANM_OPT}; - open(CMD, '-|', $^X, $self->fatscript, "--quiet", @args); - my $output = do { local $/; }; - close CMD; + 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; + return if $exit_value; + return $output; } 1; diff --git a/lib/Carton/CLI.pm b/lib/Carton/CLI.pm index 9845928..0da1038 100644 --- a/lib/Carton/CLI.pm +++ b/lib/Carton/CLI.pm @@ -404,41 +404,41 @@ sub cmd_exec { sub cmd_require { my($self, @args) = @_; - $self->add_dependency("requires", @args); + $self->add_dependency("requires", @args); } sub cmd_recommend { my($self, @args) = @_; - $self->add_dependency("recommends", @args); + $self->add_dependency("recommends", @args); } sub cmd_suggest { my($self, @args) = @_; - $self->add_dependency("suggests", @args); + $self->add_dependency("suggests", @args); } sub add_dependency { my($self, $type, @args) = @_; - my $phase = "runtime"; - my $update_core; + my $phase = "runtime"; + my $update_core; - $self->parse_options( - \@args, - "phase=s" => \$phase, - "update-core" => \$update_core, - ); + $self->parse_options( + \@args, + "phase=s" => \$phase, + "update-core" => \$update_core, + ); - # Check for module name(s) - unless (@args) { + # 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)) ; - } + # 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; @@ -448,48 +448,48 @@ sub add_dependency { cpanfile => $env->cpanfile, ); - # Build list (hash) of existing requirements in cpanfile - my $re_modules = join "|", map { qr/^\Q$_\E$/ } @args; + # 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); + # 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; + 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/xt/cli/require.t b/xt/cli/require.t index 613b153..c308cc2 100644 --- a/xt/cli/require.t +++ b/xt/cli/require.t @@ -5,31 +5,31 @@ use xt::CLI; subtest 'carton require' => sub { my $app = cli(); - $app->write_cpanfile(); + $app->write_cpanfile(); $app->run("require", "Try::Tiny"); - $app->run("tree"); - like $app->stdout, qr/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->write_cpanfile(); $app->run("require"); - like $app->stderr, qr/module/; - is $app->exit_code, 255; + like $app->stderr, qr/module/; + is $app->exit_code, 255; }; subtest 'carton require - unknown module' => sub { my $app = cli(); - $app->write_cpanfile(); + $app->write_cpanfile(); $app->run("require", "CyberspaceHasGotToBeAnAnarchyAPirateConceptInAndOutAndOverMe"); - is $app->exit_code, 255; + is $app->exit_code, 255; $app->run("tree"); - unlike $app->stdout, qr/CyberspaceHasGotToBeAnAnarchyAPirateConceptInAndOutAndOverMe/; + unlike $app->stdout, qr/CyberspaceHasGotToBeAnAnarchyAPirateConceptInAndOutAndOverMe/; }; subtest 'carton require - module already in cpanfile' => sub { @@ -79,7 +79,23 @@ subtest 'carton require for develop phase' => sub { like $app->stdout, qr/develop/; $app->run("tree"); - like $app->stdout, qr/Try::Tiny/; + 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;