[carton] 350/472: Massive rewrite of lockfile format. Use cpanfile.snapshot!
Lucas Kanashiro
kanashiro-guest at moszumanska.debian.org
Fri Jul 24 00:39:23 UTC 2015
This is an automated email from the git hooks/post-receive script.
kanashiro-guest pushed a commit to branch master
in repository carton.
commit 16832dbcee571390a7f82fd248450e766a1de1e7
Author: Tatsuhiko Miyagawa <miyagawa at bulknews.net>
Date: Tue Jul 23 18:29:39 2013 -0700
Massive rewrite of lockfile format. Use cpanfile.snapshot!
removed intermediate prereqs object and just save merged requirements everywhere.
---
.gitignore | 2 +-
lib/Carton.pm | 14 ++---
lib/Carton/CLI.pm | 40 ++++++-------
lib/Carton/CPANfile.pm | 27 +++++++++
lib/Carton/Dependency.pm | 6 +-
lib/Carton/Dist.pm | 28 +++++----
lib/Carton/Dist/Core.pm | 8 +--
lib/Carton/Doc/FAQ.pod | 4 +-
lib/Carton/Doc/Install.pod | 16 +++---
lib/Carton/Doc/List.pod | 4 +-
lib/Carton/Environment.pm | 9 ++-
lib/Carton/Index.pm | 2 +-
lib/Carton/Lockfile.pm | 103 ++++++++++++++++++---------------
lib/Carton/Lockfile/Emitter.pm | 30 ++++++++++
lib/Carton/Lockfile/Parser.pm | 126 +++++++++++++++++++++++++++++++++++++++++
lib/Carton/Requirements.pm | 16 ++----
xt/cli/check.t | 4 +-
xt/cli/cpanfile.t | 6 +-
xt/cli/deployment.t | 2 +-
xt/cli/exec.t | 4 +-
20 files changed, 320 insertions(+), 131 deletions(-)
diff --git a/.gitignore b/.gitignore
index 1a5e611..dd0a446 100644
--- a/.gitignore
+++ b/.gitignore
@@ -3,6 +3,6 @@ META.yml
!META.json
.carton/
local/
-carton.lock
+cpanfile.snapshot
/carton-*
/.build
diff --git a/lib/Carton.pm b/lib/Carton.pm
index 9be0955..d5476a5 100644
--- a/lib/Carton.pm
+++ b/lib/Carton.pm
@@ -18,7 +18,7 @@ Carton - Perl module dependency manager (aka Bundler for Perl)
requires 'Starman', 0.2000;
> carton install
- > git add cpanfile carton.lock
+ > git add cpanfile cpanfile.snapshot
> git commit -m "add Plack and Starman"
# Other developer's machine, or on a deployment box
@@ -36,7 +36,7 @@ HAVE BEEN WARNED.>
carton is a command line tool to track the Perl module dependencies
for your Perl application. The managed dependencies are tracked in a
-I<carton.lock> file, which is meant to be version controlled, and the
+I<cpanfile.snapshot> file, which is meant to be version controlled, and the
lock file allows other developers of your application will have the
exact same versions of the modules.
@@ -50,7 +50,7 @@ exclude these directories from the version control system.
> echo .carton/ >> .gitignore
> echo local/ >> .gitignore
- > git add carton.lock
+ > git add cpanfile.snapshot
> git commit -m "Start using carton"
=head2 Tracking the dependencies
@@ -67,14 +67,14 @@ And then you can install these dependencies via:
The modules are installed into your I<local> directory, and the
dependencies tree and version information are analyzed and saved into
-I<carton.lock> in your directory.
+I<cpanfile.snapshot> in your directory.
-Make sure you add I<carton.lock> to your version controlled repository
+Make sure you add I<cpanfile.snapshot> to your version controlled repository
and commit changes as you update dependencies. This will ensure that
other developers on your app, as well as your deployment environment,
use exactly the same versions of the modules you just installed.
- > git add cpanfile carton.lock
+ > git add cpanfile cpanfile.snapshot
> git commit -m "Added Plack and Starman"
=head2 Deploying your application
@@ -85,7 +85,7 @@ I<.carton>) and run the following command:
> carton install
-This will look at the I<carton.lock> and install the exact same
+This will look at the I<cpanfile.snapshot> and install the exact same
versions of the dependencies into I<local>, and now your application
is ready to run.
diff --git a/lib/Carton/CLI.pm b/lib/Carton/CLI.pm
index 3e1f551..268fb83 100644
--- a/lib/Carton/CLI.pm
+++ b/lib/Carton/CLI.pm
@@ -4,7 +4,6 @@ use warnings;
use Config;
use Getopt::Long;
-use Module::CPANfile;
use Path::Tiny;
use Try::Tiny;
use Moo;
@@ -176,7 +175,7 @@ sub cmd_install {
$env->lockfile->load_if_exists;
if ($deployment && !$env->lockfile->loaded) {
- $self->error("--deployment requires carton.lock: Run `carton install` and make sure carton.lock is checked into your version control.\n");
+ $self->error("--deployment requires cpanfile.snapshot: Run `carton install` and make sure carton.lock is checked into your version control.\n");
}
my $builder = Carton::Builder->new(
@@ -211,8 +210,8 @@ sub cmd_install {
$builder->install($env->install_path);
unless ($deployment) {
- my $prereqs = Module::CPANfile->load($env->cpanfile)->prereqs;
- $env->lockfile->find_installs($env->install_path, $prereqs);
+ $env->cpanfile->load;
+ $env->lockfile->find_installs($env->install_path, $env->cpanfile->requirements);
$env->lockfile->save;
}
@@ -227,15 +226,15 @@ sub cmd_show {
for my $module (@args) {
my $dist = $env->lockfile->find($module)
- or $self->error("Couldn't locate $module in carton.lock\n");
- $self->print( $dist->dist . "\n" );
+ or $self->error("Couldn't locate $module in cpanfile.snapshot\n");
+ $self->print( $dist->name . "\n" );
}
}
sub cmd_list {
my($self, @args) = @_;
- my $format = 'dist';
+ my $format = 'name';
$self->parse_options(
\@args,
@@ -255,9 +254,9 @@ sub cmd_tree {
my $env = Carton::Environment->build;
$env->lockfile->load;
+ $env->cpanfile->load;
- my $cpanfile = Module::CPANfile->load($env->cpanfile);
- my $requirements = Carton::Requirements->new(lockfile => $env->lockfile, prereqs => $cpanfile->prereqs);
+ my $requirements = Carton::Requirements->new(lockfile => $env->lockfile, requirements => $env->cpanfile->requirements);
my %seen;
my $dumper = sub {
@@ -280,19 +279,18 @@ sub cmd_check {
my $env = Carton::Environment->build($cpanfile_path);
$env->lockfile->load;
-
- my $prereqs = Module::CPANfile->load($env->cpanfile)->prereqs;
+ $env->cpanfile->load;
# TODO remove lockfile
# TODO pass git spec to Requirements?
- my $requirements = Carton::Requirements->new(lockfile => $env->lockfile, prereqs => $prereqs);
+ my $requirements = Carton::Requirements->new(lockfile => $env->lockfile, requirements => $env->cpanfile->requirements);
$requirements->walk_down(sub { });
my @missing;
for my $module ($requirements->all->required_modules) {
my $install = $env->lockfile->find_or_core($module);
if ($install) {
- unless ($requirements->all->accepts_module($module => $install->version)) {
+ unless ($requirements->all->accepts_module($module => $install->version_for($module))) {
push @missing, [ $module, 1, $install->version ];
}
} else {
@@ -309,7 +307,7 @@ sub cmd_check {
$module, $version, $requirements->all->requirements_for_module($module), INFO);
} else {
$self->printf(" %s is not installed. Needs %s\n",
- $module, $requirements->all->requiements_for_module($module), INFO);
+ $module, $requirements->all->requirements_for_module($module), INFO);
}
}
$self->printf("Run `carton install` to install them.\n", INFO);
@@ -323,15 +321,11 @@ sub cmd_update {
my($self, @args) = @_;
my $env = Carton::Environment->build;
+ $env->cpanfile->load;
- my $cpanfile = Module::CPANfile->load($env->cpanfile);
- my $prereqs = $cpanfile->prereqs;
- my $reqs = CPAN::Meta::Requirements->new;
- $reqs->add_requirements($prereqs->requirements_for($_, 'requires'))
- for qw( configure build runtime test develop );
-
- @args = grep { $_ ne 'perl' } $reqs->required_modules unless @args;
+ my $cpanfile = Module::CPANfile->load($env->cpanfile);
+ @args = grep { $_ ne 'perl' } $env->cpanfile->required_modules unless @args;
$env->lockfile->load;
@@ -340,7 +334,7 @@ sub cmd_update {
my $dist = $env->lockfile->find_or_core($module)
or $self->error("Could not find module $module.\n");
next if $dist->is_core;
- push @modules, "$module~" . $reqs->requirements_for_module($module);
+ push @modules, "$module~" . $env->cpanfile->requirements_for_module($module);
}
my $builder = Carton::Builder->new(
@@ -349,7 +343,7 @@ sub cmd_update {
);
$builder->update($env->install_path, @modules);
- $env->lockfile->find_installs($env->install_path, $prereqs);
+ $env->lockfile->find_installs($env->install_path, $env->cpanfile->requirements);
$env->lockfile->save;
}
diff --git a/lib/Carton/CPANfile.pm b/lib/Carton/CPANfile.pm
new file mode 100644
index 0000000..ca72960
--- /dev/null
+++ b/lib/Carton/CPANfile.pm
@@ -0,0 +1,27 @@
+package Carton::CPANfile;
+use strict;
+use Path::Tiny ();
+use Module::CPANfile;
+use Moo;
+
+use overload q{""} => sub { $_[0]->stringify }, fallback => 1;
+
+has path => (is => 'rw', coerce => sub { Path::Tiny->new($_[0]) }, handles => [ qw(stringify dirname) ]);
+has _cpanfile => (is => 'rw', handles => [ qw(prereqs) ]);
+has requirements => (is => 'rw', lazy => 1, builder => 1, handles => [ qw(required_modules requirements_for_module) ]);
+
+sub load {
+ my $self = shift;
+ $self->_cpanfile( Module::CPANfile->load($self->path) );
+}
+
+sub _build_requirements {
+ my $self = shift;
+ my $reqs = CPAN::Meta::Requirements->new;
+ $reqs->add_requirements($self->prereqs->requirements_for($_, 'requires'))
+ for qw( configure build runtime test develop );
+ $reqs->clear_requirement('perl');
+ $reqs;
+}
+
+1;
diff --git a/lib/Carton/Dependency.pm b/lib/Carton/Dependency.pm
index f854332..17c9a9e 100644
--- a/lib/Carton/Dependency.pm
+++ b/lib/Carton/Dependency.pm
@@ -4,16 +4,16 @@ use Moo;
has module => (is => 'rw');
has requirement => (is => 'rw');
-has dist => (is => 'rw', handles => [ qw(prereqs) ]);
+has dist => (is => 'rw', handles => [ qw(requirements) ]);
sub distname {
my $self = shift;
- $self->dist->dist;
+ $self->dist->name;
}
sub version {
my $self = shift;
- $self->dist->provides->{$self->module}{version};
+ $self->dist->version_for($self->module);
}
1;
diff --git a/lib/Carton/Dist.pm b/lib/Carton/Dist.pm
index 6828820..d8f9eca 100644
--- a/lib/Carton/Dist.pm
+++ b/lib/Carton/Dist.pm
@@ -3,15 +3,12 @@ use strict;
use CPAN::Meta;
use Moo;
-# XXX name here means the name of main module
-# XXX dist means the name of dist
has name => (is => 'ro');
-has pathname => (is => 'ro');
-has provides => (is => 'ro');
-has version => (is => 'ro');
-has target => (is => 'ro');
-has dist => (is => 'ro');
-has mymeta => (is => 'ro', coerce => sub { CPAN::Meta->new($_[0], { lazy_validation => 1 }) });
+has pathname => (is => 'rw');
+has provides => (is => 'rw', default => sub { +{} });
+has version => (is => 'rw');
+has requirements => (is => 'rw', lazy => 1, builder => 1,
+ handles => [ qw(add_string_requirement required_modules requirements_for_module) ]);
sub is_core { 0 }
@@ -20,9 +17,18 @@ sub distfile {
$self->pathname;
}
-sub prereqs {
- my $self = shift;
- $self->mymeta->effective_prereqs;
+sub _build_requirements {
+ CPAN::Meta::Requirements->new;
+}
+
+sub provides_module {
+ my($self, $module) = @_;
+ exists $self->provides->{$module};
+}
+
+sub version_for {
+ my($self, $module) = @_;
+ $self->provides->{$module}{version};
}
1;
diff --git a/lib/Carton/Dist/Core.pm b/lib/Carton/Dist/Core.pm
index d5d4027..7d161b7 100644
--- a/lib/Carton/Dist/Core.pm
+++ b/lib/Carton/Dist/Core.pm
@@ -6,16 +6,16 @@ extends 'Carton::Dist';
sub BUILDARGS {
my($class, %args) = @_;
- $args{dist} = "perl-$]";
+ $args{name} = "perl-$]";
\%args;
}
sub is_core { 1 }
-sub prereqs {
- my $self = shift;
- CPAN::Meta::Prereqs->new;
+sub version_for {
+ my($self, $module) = @_;
+ $self->version;
}
1;
diff --git a/lib/Carton/Doc/FAQ.pod b/lib/Carton/Doc/FAQ.pod
index 22fd5d3..657bfec 100644
--- a/lib/Carton/Doc/FAQ.pod
+++ b/lib/Carton/Doc/FAQ.pod
@@ -51,10 +51,10 @@ centered around the installer, by implementing a wrapper for
L<cpanm|App::cpanminus>, so you can use the same commands in the
development mode and deployment mode.
-Carton automatically maintains the L<carton.lock> file, which is meant
+Carton automatically maintains the L<cpanfile.snapshot> file, which is meant
to be version controlled, inside your application directory. You don't
need a separate database, a directory or a web server to maintain
-tarballs outside your application. The I<carton.lock> file can always
+tarballs outside your application. The I<cpanfile.snapshot> file can always
be generated with C<carton install> command, and C<carton install> on
another machine can use the version in the lock.
diff --git a/lib/Carton/Doc/Install.pod b/lib/Carton/Doc/Install.pod
index 785a6e2..6a21d44 100644
--- a/lib/Carton/Doc/Install.pod
+++ b/lib/Carton/Doc/Install.pod
@@ -24,24 +24,24 @@ the modules.
=back
In either way, if you run C<carton install> for the first time
-(i.e. I<carton.lock> does not exist), carton will fetch all the
+(i.e. I<cpanfile.snapshot> does not exist), carton will fetch all the
modules specified, resolve dependencies and install all required
modules from CPAN.
-If I<carton.lock> file does exist, carton will still try to install
-modules specified or updated in I<cpanfile>, but uses I<carton.lock>
+If I<cpanfile.snapshot> file does exist, carton will still try to install
+modules specified or updated in I<cpanfile>, but uses I<cpanfile.snapshot>
for the dependency resolution, and then cascades to CPAN.
carton will analyze all the dependencies and their version
-information, and it is saved into I<carton.lock> file. It is important
-to add I<carton.lock> file into a version controlled repository and
+information, and it is saved into I<cpanfile.snapshot> file. It is important
+to add I<cpanfile.snapshot> file into a version controlled repository and
commit the changes as you update your dependencies.
=head2 DEPLOYMENT MODE
If you specify the C<--deployment> command line option or the
-I<carton.lock> exists, carton will fetch all remote modules and use
-the dependencies specified in the I<carton.lock> instead of resolving
+I<cpanfile.snapshot> exists, carton will fetch all remote modules and use
+the dependencies specified in the I<cpanfile.snapshot> instead of resolving
dependencies.
=head1 OPTIONS
@@ -77,6 +77,6 @@ to exclude, in the comma separated list.
carton install --deployment --without develop
B<NOTE>: C<--without> for the initial installation (without
-carton.lock) is not supported at this moment.
+cpanfile.snapshot) is not supported at this moment.
=back
diff --git a/lib/Carton/Doc/List.pod b/lib/Carton/Doc/List.pod
index 262a863..40c54e0 100644
--- a/lib/Carton/Doc/List.pod
+++ b/lib/Carton/Doc/List.pod
@@ -1,6 +1,6 @@
=head1 NAME
-Carton::Doc::List - List dependencies tracked in the carton.lock file
+Carton::Doc::List - List dependencies tracked in the cpanfile.snapshot file
=head1 SYNOPSIS
@@ -9,7 +9,7 @@ Carton::Doc::List - List dependencies tracked in the carton.lock file
=head1 DESCRIPTION
List the dependencies and version information tracked in the
-I<carton.lock> file. This command by default displays the name of the
+I<cpanfile.snapshot> file. This command by default displays the name of the
distribution (e.g. I<Foo-Bar-0.01>) in a flat list.
=head1 OPTIONS
diff --git a/lib/Carton/Environment.pm b/lib/Carton/Environment.pm
index 7df8e79..9c9ef42 100644
--- a/lib/Carton/Environment.pm
+++ b/lib/Carton/Environment.pm
@@ -2,6 +2,7 @@ package Carton::Environment;
use strict;
use Moo;
+use Carton::CPANfile;
use Carton::Lockfile;
use Carton::Error;
use Path::Tiny;
@@ -13,9 +14,7 @@ has vendor_cache => (is => 'lazy');
sub _build_lockfile {
my $self = shift;
- my $base = $self->cpanfile->basename eq 'cpanfile'
- ? 'carton.lock' : ("carton." . $self->cpanfile->basename . ".lock");
- Carton::Lockfile->new(path => $self->cpanfile->dirname . "/$base");
+ Carton::Lockfile->new(path => $self->cpanfile->stringify . ".snapshot");
}
sub _build_install_path {
@@ -37,7 +36,7 @@ sub build_with {
$cpanfile = Path::Tiny->new($cpanfile)->absolute;
if ($cpanfile->is_file) {
- return $class->new(cpanfile => $cpanfile);
+ return $class->new(cpanfile => Carton::CPANfile->new(path => $cpanfile));
} else {
Carton::Error::CPANfileNotFound->throw(error => "Can't locate cpanfile: $cpanfile");
}
@@ -52,7 +51,7 @@ sub build {
my $cpanfile = $self->locate_cpanfile($cpanfile_path || $ENV{PERL_CARTON_CPANFILE});
if ($cpanfile && $cpanfile->is_file) {
- $self->cpanfile($cpanfile);
+ $self->cpanfile( Carton::CPANfile->new(path => $cpanfile) );
} else {
Carton::Error::CPANfileNotFound->throw(error => "Can't locate cpanfile: (@{[ $cpanfile_path || 'cpanfile' ]})");
}
diff --git a/lib/Carton/Index.pm b/lib/Carton/Index.pm
index 328691d..ee59a05 100644
--- a/lib/Carton/Index.pm
+++ b/lib/Carton/Index.pm
@@ -25,7 +25,7 @@ sub write {
print $fh <<EOF;
File: 02packages.details.txt
URL: http://www.perl.com/CPAN/modules/02packages.details.txt
-Description: Package names found in carton.lock
+Description: Package names found in cpanfile.snapshot
Columns: package name, version, path
Intended-For: Automated fetch routines, namespace documentation.
Written-By: Carton $Carton::VERSION
diff --git a/lib/Carton/Lockfile.pm b/lib/Carton/Lockfile.pm
index f305380..e95568f 100644
--- a/lib/Carton/Lockfile.pm
+++ b/lib/Carton/Lockfile.pm
@@ -7,19 +7,22 @@ use Carton::Error;
use Carton::Package;
use Carton::Index;
use Carton::Util;
+use Carton::Lockfile::Emitter;
+use Carton::Lockfile::Parser;
use CPAN::Meta;
use CPAN::Meta::Requirements;
use File::Find ();
use Try::Tiny;
+use Path::Tiny ();
use Module::CoreList;
use Moo;
-use constant CARTON_LOCK_VERSION => '0.9';
+use constant CARTON_LOCK_VERSION => '1.0';
has path => (is => 'rw', coerce => sub { Path::Tiny->new($_[0]) });
has version => (is => 'rw', default => sub { CARTON_LOCK_VERSION });
-has modules => (is => 'rw', default => sub { +{} });
has loaded => (is => 'rw');
+has _distributions => (is => 'rw', default => sub { +[] });
sub load_if_exists {
my $self = shift;
@@ -32,17 +35,14 @@ sub load {
return 1 if $self->loaded;
if ($self->path->is_file) {
- my $data = try { Carton::Util::load_json($self->path) }
- catch { Carton::Error::LockfileParseError->throw(error => "Can't parse carton.lock", path => $self->path) };
-
- $self->version($data->{version});
- $self->modules($data->{modules});
+ my $parser = Carton::Lockfile::Parser->new;
+ $parser->parse($self->path->slurp_utf8, $self);
$self->loaded(1);
return 1;
} else {
Carton::Error::LockfileNotFound->throw(
- error => "Can't find carton.lock: Run `carton install` to build the lock file.",
+ error => "Can't find cpanfile.snapshot: Run `carton install` to build the lock file.",
path => $self->path,
);
}
@@ -50,23 +50,12 @@ sub load {
sub save {
my $self = shift;
- Carton::Util::dump_json({ modules => $self->modules, version => $self->version }, $self->path);
-}
-
-sub distributions {
- map Carton::Dist->new($_), values %{$_[0]->modules}
+ $self->path->spew_utf8( Carton::Lockfile::Emitter->new->emit($self) );
}
sub find {
my($self, $module) = @_;
-
- for my $meta (values %{$_[0]->modules}) {
- if ($meta->{provides}{$module}) {
- return Carton::Dist->new( $self->modules->{$meta->{name}} );
- }
- }
-
- return;
+ (grep $_->provides_module($module), $self->distributions)[0];
}
sub find_or_core {
@@ -96,14 +85,23 @@ sub index {
return $index;
}
+sub distributions {
+ @{$_[0]->_distributions};
+}
+
+sub add_distribution {
+ my($self, $dist) = @_;
+ push @{$self->_distributions}, $dist;
+}
+
sub packages {
my $self = shift;
my @packages;
- while (my($name, $metadata) = each %{$self->modules}) {
- while (my($package, $provides) = each %{$metadata->{provides}}) {
+ for my $dist ($self->distributions) {
+ while (my($package, $provides) = each %{$dist->provides}) {
# TODO what if duplicates?
- push @packages, Carton::Package->new($package, $provides->{version}, $metadata->{pathname});
+ push @packages, Carton::Package->new($package, $provides->{version}, $dist->pathname);
}
}
@@ -118,15 +116,11 @@ sub write_index {
}
sub find_installs {
- my($self, $path, $prereqs) = @_;
+ my($self, $path, $reqs) = @_;
my $libdir = "$path/lib/perl5/$Config{archname}/.meta";
return {} unless -e $libdir;
- my $reqs = CPAN::Meta::Requirements->new;
- $reqs->add_requirements($prereqs->requirements_for($_, 'requires'))
- for qw( configure build runtime test develop );
-
my @installs;
my $wanted = sub {
if ($_ eq 'install.json') {
@@ -136,27 +130,46 @@ sub find_installs {
File::Find::find($wanted, $libdir);
my %installs;
+
+ my $accepts = sub {
+ my $module = shift;
+
+ return 0 unless $reqs->accepts_module($module->{name}, $module->{provides}{$module->{name}}{version});
+
+ if (my $exist = $installs{$module->{name}}) {
+ my $old_ver = version->new($exist->{provides}{$module->{name}}{version});
+ my $new_ver = version->new($module->{provides}{$module->{name}}{version});
+ return $new_ver >= $old_ver;
+ } else {
+ return 1;
+ }
+ };
+
for my $file (@installs) {
my $module = Carton::Util::load_json($file->[0]);
- my $mymeta = -f $file->[1] ? CPAN::Meta->load_file($file->[1])->as_struct({ version => "2" }) : {};
- if ($reqs->accepts_module($module->{name}, $module->{provides}{$module->{name}}{version})) {
- if (my $exist = $installs{$module->{name}}) {
- my $old_ver = version->new($exist->{provides}{$module->{name}}{version});
- my $new_ver = version->new($module->{provides}{$module->{name}}{version});
- if ($new_ver >= $old_ver) {
- $installs{ $module->{name} } = { %$module, mymeta => $mymeta };
- } else {
- # Ignore same distributions older than the one we have
- }
- } else {
- $installs{ $module->{name} } = { %$module, mymeta => $mymeta };
- }
- } else {
- # Ignore installs because cpanfile doesn't accept it
+ my $prereqs = -f $file->[1] ? CPAN::Meta->load_file($file->[1])->effective_prereqs : CPAN::Meta::Prereqs->new;
+
+ my $reqs = CPAN::Meta::Requirements->new;
+ $reqs->add_requirements($prereqs->requirements_for($_, 'requires'))
+ for qw( configure build runtime );
+
+ if ($accepts->($module)) {
+ $installs{$module->{name}} = Carton::Dist->new(
+ name => $module->{dist},
+ pathname => $module->{pathname},
+ provides => $module->{provides},
+ version => $module->{version},
+ requirements => $reqs,
+ );
}
}
- $self->modules(\%installs);
+ my @new_dists;
+ for my $module (keys %installs) {
+ push @new_dists, $installs{$module};
+ }
+
+ $self->_distributions(\@new_dists);
}
1;
diff --git a/lib/Carton/Lockfile/Emitter.pm b/lib/Carton/Lockfile/Emitter.pm
new file mode 100644
index 0000000..255eaeb
--- /dev/null
+++ b/lib/Carton/Lockfile/Emitter.pm
@@ -0,0 +1,30 @@
+package Carton::Lockfile::Emitter;
+use strict;
+use Moo;
+
+sub emit {
+ my($self, $lockfile) = @_;
+
+ my $data = '';
+ $data .= "# carton snapshot format: version @{[$lockfile->version]}\n";
+ $data .= "DISTRIBUTIONS\n";
+
+ for my $dist ($lockfile->distributions) {
+ $data .= " @{[$dist->name]}\n";
+ $data .= " pathname: @{[$dist->pathname]}\n";
+
+ $data .= " provides:\n";
+ for my $package (sort keys %{$dist->provides}) {
+ $data .= " $package @{[$dist->provides->{$package}{version} || 'undef' ]}\n";
+ }
+
+ $data .= " requirements:\n";
+ for my $module ($dist->required_modules) {
+ $data .= " $module @{[ $dist->requirements_for_module($module) || '0' ]}\n";
+ }
+ }
+
+ $data;
+}
+
+1;
diff --git a/lib/Carton/Lockfile/Parser.pm b/lib/Carton/Lockfile/Parser.pm
new file mode 100644
index 0000000..92eed89
--- /dev/null
+++ b/lib/Carton/Lockfile/Parser.pm
@@ -0,0 +1,126 @@
+package Carton::Lockfile::Parser;
+use strict;
+use Carton::Dist;
+use Moo;
+
+my $machine = {
+ init => [
+ {
+ re => qr/^\# carton snapshot format: version ([\d\.]+)/,
+ code => sub {
+ my($stash, $lockfile, $ver) = @_;
+ $lockfile->version($ver);
+ },
+ goto => 'section',
+ },
+ # TODO support pasing error and version mismatch etc.
+ ],
+ section => [
+ {
+ re => qr/^DISTRIBUTIONS$/,
+ goto => 'dists',
+ },
+ {
+ re => qr/^__EOF__$/,
+ done => 1,
+ },
+ ],
+ dists => [
+ {
+ re => qr/^ (\S+)$/,
+ code => sub { $_[0]->{dist} = Carton::Dist->new(name => $1) },
+ goto => 'distmeta',
+ },
+ {
+ re => qr/^\S/,
+ goto => 'section',
+ redo => 1,
+ },
+ ],
+ distmeta => [
+ {
+ re => qr/^ pathname: (.*)$/,
+ code => sub { $_[0]->{dist}->pathname($1) },
+ },
+ {
+ re => qr/^\s{4}provides:$/,
+ code => sub { $_[0]->{property} = 'provides' },
+ goto => 'properties',
+ },
+ {
+ re => qr/^\s{4}requirements:$/,
+ code => sub {
+ $_[0]->{property} = 'requirements';
+ },
+ goto => 'properties',
+ },
+ {
+ re => qr/^\s{0,2}\S/,
+ code => sub {
+ my($stash, $lockfile) = @_;
+ $lockfile->add_distribution($stash->{dist});
+ %$stash = (); # clear
+ },
+ goto => 'dists',
+ redo => 1,
+ },
+ ],
+ properties => [
+ {
+ re => qr/^\s{6}([0-9A-Za-z_:]+) (v?[0-9\._]+|undef)/,
+ code => sub {
+ my($stash, $lockfile, $module, $version) = @_;
+
+ if ($stash->{property} eq 'provides') {
+ $stash->{dist}->provides->{$module} = { version => $version };
+ } else {
+ $stash->{dist}->add_string_requirement($module, $version);
+ }
+ },
+ },
+ {
+ re => qr/^\s{0,4}\S/,
+ goto => 'distmeta',
+ redo => 1,
+ },
+ ],
+};
+
+sub parse {
+ my($self, $data, $lockfile) = @_;
+
+ my @lines = split /\n/, $data;
+
+ my $state = $machine->{init};
+ my $stash = {};
+
+ LINE:
+ for my $line (@lines, '__EOF__') {
+ last LINE unless @$state;
+
+ STATE: {
+ for my $trans (@{$state}) {
+ if (my @match = $line =~ $trans->{re}) {
+ if (my $code = $trans->{code}) {
+ $code->($stash, $lockfile, @match);
+ }
+ if (my $goto = $trans->{goto}) {
+ $state = $machine->{$goto};
+ if ($trans->{redo}) {
+ redo STATE;
+ } else {
+ next LINE;
+ }
+ }
+
+ last STATE;
+ }
+ }
+
+ die "SOMETHING IS WRONG $line";
+ }
+
+ }
+}
+
+1;
diff --git a/lib/Carton/Requirements.pm b/lib/Carton/Requirements.pm
index 66873fa..1eb7a47 100644
--- a/lib/Carton/Requirements.pm
+++ b/lib/Carton/Requirements.pm
@@ -5,24 +5,17 @@ use Moo;
use CPAN::Meta::Requirements;
has lockfile => (is => 'ro');
-has prereqs => (is => 'ro');
+has requirements => (is => 'ro');
has all => (is => 'ro', default => sub { CPAN::Meta::Requirements->new });
sub walk_down {
my($self, $cb) = @_;
my $dumper; $dumper = sub {
- my($dependency, $prereqs, $level, $parent) = @_;
+ my($dependency, $reqs, $level, $parent) = @_;
$cb->($dependency, $level) if $dependency;
- my @phase = qw( configure build runtime );
- push @phase, qw( test develop ) unless $dependency;
-
- my $reqs = CPAN::Meta::Requirements->new;
- $reqs->add_requirements($prereqs->requirements_for($_, 'requires')) for @phase;
- $reqs->clear_requirement('perl'); # for now
-
$self->all->add_requirements($reqs) unless $self->all->is_finalized;
local $parent->{$dependency->distname} = 1 if $dependency;
@@ -31,15 +24,16 @@ sub walk_down {
my $dependency = $self->dependency_for($module, $reqs);
if ($dependency->dist) {
next if $parent->{$dependency->distname};
- $dumper->($dependency, $dependency->prereqs, $level + 1);
+ $dumper->($dependency, $dependency->requirements, $level + 1);
} else {
# no dist found in lock
}
}
};
- $dumper->(undef, $self->prereqs, 0, {});
+ $dumper->(undef, $self->requirements, 0, {});
+ $self->all->clear_requirement('perl');
$self->all->finalize;
}
diff --git a/xt/cli/check.t b/xt/cli/check.t
index 949cca8..ad57cdd 100644
--- a/xt/cli/check.t
+++ b/xt/cli/check.t
@@ -9,7 +9,7 @@ requires 'Try::Tiny', '== 0.11';
EOF
$app->run("check");
- like $app->stderr, qr/find carton\.lock/;
+ like $app->stderr, qr/find cpanfile\.snapshot/;
};
subtest 'carton install and check' => sub {
@@ -36,7 +36,7 @@ EOF
TODO: {
local $TODO = 'exec does not verify lock';
$app->run("exec", "perl", "use Try::Tiny");
- like $app->stderr, qr/lock/;
+ like $app->stderr, qr/\.snapshot/;
}
$app->run("install");
diff --git a/xt/cli/cpanfile.t b/xt/cli/cpanfile.t
index e454d1a..b663b37 100644
--- a/xt/cli/cpanfile.t
+++ b/xt/cli/cpanfile.t
@@ -10,8 +10,8 @@ EOF
$app->run("install", "--cpanfile", "cpanfile.foo");
$app->run("check", "--cpanfile", "cpanfile.foo");
-# ok !$app->dir->child('cpanfile.lock')->exists;
-# ok $app->dir->child('cpanfile.foo.lock')->exists;
+ ok !$app->dir->child('cpanfile.snapshot')->exists;
+ ok $app->dir->child('cpanfile.foo.snapshot')->exists;
like $app->stdout, qr/are satisfied/;
@@ -37,7 +37,7 @@ EOF
$app->run("list");
like $app->stdout, qr/Try-Tiny-0\.11/;
-# ok $app->dir->child('cpanfile.foo.lock')->exists;
+ ok $app->dir->child('cpanfile.foo.snapshot')->exists;
};
done_testing;
diff --git a/xt/cli/deployment.t b/xt/cli/deployment.t
index 36a2511..175f87a 100644
--- a/xt/cli/deployment.t
+++ b/xt/cli/deployment.t
@@ -9,7 +9,7 @@ requires 'Try::Tiny', '== 0.11';
EOF
$app->run("install", "--deployment");
- like $app->stderr, qr/deployment requires carton\.lock/;
+ like $app->stderr, qr/deployment requires cpanfile\.snapshot/;
$app->run("install");
$app->clean_local;
diff --git a/xt/cli/exec.t b/xt/cli/exec.t
index 72fe864..233f790 100644
--- a/xt/cli/exec.t
+++ b/xt/cli/exec.t
@@ -18,11 +18,11 @@ subtest 'exec without cpanfile', sub {
is $app->exit_code, 255;
};
-subtest 'exec without a lock', sub {
+subtest 'exec without a snapshot', sub {
my $app = cli();
$app->write_cpanfile();
$app->run("exec", "perl", "-e", 1);
- like $app->stderr, qr/carton\.lock/;
+ like $app->stderr, qr/cpanfile\.snapshot/;
is $app->exit_code, 255;
};
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/carton.git
More information about the Pkg-perl-cvs-commits
mailing list