[carton] 345/472: Merge Lock and Lockfile into Lockfile
Lucas Kanashiro
kanashiro-guest at moszumanska.debian.org
Fri Jul 24 00:39:22 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 f1f7075adf5a9a53cf516006b751d8d8981651b8
Author: Tatsuhiko Miyagawa <miyagawa at bulknews.net>
Date: Tue Jul 23 11:18:18 2013 -0700
Merge Lock and Lockfile into Lockfile
---
lib/Carton/CLI.pm | 46 +++++++-------
lib/Carton/Environment.pm | 2 +-
lib/Carton/Lock.pm | 153 ---------------------------------------------
lib/Carton/Lockfile.pm | 154 ++++++++++++++++++++++++++++++++++++++++++----
4 files changed, 168 insertions(+), 187 deletions(-)
diff --git a/lib/Carton/CLI.pm b/lib/Carton/CLI.pm
index a2e2cc9..558456e 100644
--- a/lib/Carton/CLI.pm
+++ b/lib/Carton/CLI.pm
@@ -14,7 +14,7 @@ use Scalar::Util qw(blessed);
use Carton;
use Carton::Builder;
use Carton::Mirror;
-use Carton::Lock;
+use Carton::Lockfile;
use Carton::Util;
use Carton::Environment;
use Carton::Error;
@@ -157,7 +157,7 @@ sub cmd_version {
sub cmd_bundle {
my($self, @args) = @_;
- my $lock = $self->lockfile->load;
+ $self->lockfile->load;
my $cpanfile = $self->cpanfile;
$self->print("Bundling modules using $cpanfile\n");
@@ -166,7 +166,7 @@ sub cmd_bundle {
mirror => $self->mirror,
cpanfile => $self->cpanfile,
);
- $builder->bundle($self->install_path, $self->vendor_cache, $lock);
+ $builder->bundle($self->install_path, $self->vendor_cache, $self->lockfile);
$self->printf("Complete! Modules were bundled into %s\n", $self->vendor_cache, SUCCESS);
}
@@ -188,9 +188,9 @@ sub cmd_install {
my $environment = Carton::Environment->build($cpanfile_path, $install_path);
$self->environment($environment);
- my $lock = $self->lockfile->load_if_exists;
+ $self->lockfile->load_if_exists;
- if ($deployment && !$lock) {
+ if ($deployment && !$self->lockfile->loaded) {
$self->error("--deployment requires carton.lock: Run `carton install` and make sure carton.lock is checked into your version control.\n");
}
@@ -213,8 +213,8 @@ sub cmd_install {
}
# TODO merge CPANfile git to mirror even if lock doesn't exist
- if ($lock) {
- $lock->write_index($self->index_file);
+ if ($self->lockfile->loaded) {
+ $self->lockfile->write_index($self->index_file);
$builder->index($self->index_file);
}
@@ -226,7 +226,8 @@ sub cmd_install {
unless ($deployment) {
my $prereqs = Module::CPANfile->load($cpanfile)->prereqs;
- Carton::Lock->build_from_local($self->install_path, $prereqs)->write($self->lockfile);
+ $self->lockfile->find_installs($self->install_path, $prereqs);
+ $self->lockfile->save;
}
$self->print("Complete! Modules were installed into @{[$self->install_path]}\n", SUCCESS);
@@ -235,10 +236,10 @@ sub cmd_install {
sub cmd_show {
my($self, @args) = @_;
- my $lock = $self->lockfile->load;
+ $self->lockfile->load;
for my $module (@args) {
- my $dist = $lock->find($module)
+ my $dist = $self->lockfile->find($module)
or $self->error("Couldn't locate $module in carton.lock\n");
$self->print( $dist->dist . "\n" );
}
@@ -254,9 +255,9 @@ sub cmd_list {
"distfile" => sub { $format = 'distfile' },
);
- my $lock = $self->lockfile->load;
+ $self->lockfile->load;
- for my $dist ($lock->distributions) {
+ for my $dist ($self->lockfile->distributions) {
$self->print($dist->$format . "\n");
}
}
@@ -264,10 +265,10 @@ sub cmd_list {
sub cmd_tree {
my($self, @args) = @_;
- my $lock = $self->lockfile->load;
+ $self->lockfile->load;
my $cpanfile = Module::CPANfile->load($self->cpanfile);
- my $requirements = Carton::Requirements->new(lock => $lock, prereqs => $cpanfile->prereqs);
+ my $requirements = Carton::Requirements->new(lock => $self->lockfile, prereqs => $cpanfile->prereqs);
my %seen;
my $dumper = sub {
@@ -291,18 +292,18 @@ sub cmd_check {
my $environment = Carton::Environment->build($cpanfile_path);
$self->environment($environment);
- my $lock = $self->lockfile->load;
+ $self->lockfile->load;
my $prereqs = Module::CPANfile->load($self->cpanfile)->prereqs;
- # TODO remove $lock
+ # TODO remove lockfile
# TODO pass git spec to Requirements?
- my $requirements = Carton::Requirements->new(lock => $lock, prereqs => $prereqs);
+ my $requirements = Carton::Requirements->new(lock => $self->lockfile, prereqs => $prereqs);
$requirements->walk_down(sub { });
my @missing;
for my $module ($requirements->all->required_modules) {
- my $install = $lock->find_or_core($module);
+ my $install = $self->lockfile->find_or_core($module);
if ($install) {
unless ($requirements->all->accepts_module($module => $install->version)) {
push @missing, [ $module, 1, $install->version ];
@@ -343,11 +344,11 @@ sub cmd_update {
@args = grep { $_ ne 'perl' } $reqs->required_modules unless @args;
- my $lock = $self->lockfile->load;
+ $self->lockfile->load;
my @modules;
for my $module (@args) {
- my $dist = $lock->find_or_core($module)
+ my $dist = $self->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);
@@ -359,13 +360,14 @@ sub cmd_update {
);
$builder->update($self->install_path, @modules);
- Carton::Lock->build_from_local($self->install_path, $prereqs)->write($self->lockfile);
+ $self->lockfile->find_installs($self->install_path, $prereqs);
+ $self->lockfile->save;
}
sub cmd_exec {
my($self, @args) = @_;
- my $lock = $self->lockfile->load;
+ $self->lockfile->load;
# allows -Ilib
@args = map { /^(-[I])(.+)/ ? ($1,$2) : $_ } @args;
diff --git a/lib/Carton/Environment.pm b/lib/Carton/Environment.pm
index a7efc41..7df8e79 100644
--- a/lib/Carton/Environment.pm
+++ b/lib/Carton/Environment.pm
@@ -15,7 +15,7 @@ sub _build_lockfile {
my $self = shift;
my $base = $self->cpanfile->basename eq 'cpanfile'
? 'carton.lock' : ("carton." . $self->cpanfile->basename . ".lock");
- Carton::Lockfile->new($self->cpanfile->dirname . "/$base");
+ Carton::Lockfile->new(path => $self->cpanfile->dirname . "/$base");
}
sub _build_install_path {
diff --git a/lib/Carton/Lock.pm b/lib/Carton/Lock.pm
deleted file mode 100644
index 0855df0..0000000
--- a/lib/Carton/Lock.pm
+++ /dev/null
@@ -1,153 +0,0 @@
-package Carton::Lock;
-use strict;
-use Config;
-use Carton::Dist;
-use Carton::Dist::Core;
-use Carton::Error;
-use Carton::Package;
-use Carton::Index;
-use Carton::Util;
-use CPAN::Meta;
-use CPAN::Meta::Requirements;
-use File::Find ();
-use Try::Tiny;
-use Module::CoreList;
-use Moo;
-
-has version => (is => 'ro');
-has modules => (is => 'ro', default => sub { +{} });
-
-use constant CARTON_LOCK_VERSION => '0.9';
-
-sub from_file {
- my($class, $file) = @_;
-
- my $data = try { Carton::Util::load_json($file) }
- catch { Carton::Error::LockfileParseError->throw(error => "Can't parse carton.lock", path => $file) };
-
- return $class->new($data);
-}
-
-sub write {
- my($self, $file) = @_;
- Carton::Util::dump_json({ %$self }, $file);
-}
-
-sub distributions {
- map Carton::Dist->new($_), values %{$_[0]->modules}
-}
-
-sub find {
- my($self, $module) = @_;
-
- for my $meta (values %{$_[0]->modules}) {
- if ($meta->{provides}{$module}) {
- return Carton::Dist->new( $self->modules->{$meta->{name}} );
- }
- }
-
- return;
-}
-
-sub find_or_core {
- my($self, $module) = @_;
- $self->find($module) || $self->find_in_core($module);
-}
-
-sub find_in_core {
- my($self, $module) = @_;
-
- if (exists $Module::CoreList::version{$]}{$module}) {
- my $version = $Module::CoreList::version{$]}{$module}; # maybe undef
- return Carton::Dist::Core->new(name => $module, version => $version);
- }
-
- return;
-}
-
-sub index {
- my $self = shift;
-
- my $index = Carton::Index->new;
- for my $package ($self->packages) {
- $index->add_package($package);
- }
-
- return $index;
-}
-
-sub packages {
- my $self = shift;
-
- my @packages;
- while (my($name, $metadata) = each %{$self->modules}) {
- while (my($package, $provides) = each %{$metadata->{provides}}) {
- # TODO what if duplicates?
- push @packages, Carton::Package->new($package, $provides->{version}, $metadata->{pathname});
- }
- }
-
- return @packages;
-}
-
-sub write_index {
- my($self, $file) = @_;
-
- open my $fh, ">", $file or die $!;
- $self->index->write($fh);
-}
-
-sub build_from_local {
- my($class, $path, $prereqs) = @_;
-
- my $installs = $class->find_installs($path, $prereqs);
-
- return $class->new(
- modules => $installs,
- version => CARTON_LOCK_VERSION,
- );
-}
-
-sub find_installs {
- my($class, $path, $prereqs) = @_;
-
- 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') {
- push @installs, [ $File::Find::name, "$File::Find::dir/MYMETA.json" ];
- }
- };
- File::Find::find($wanted, $libdir);
-
- my %installs;
- 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
- }
- }
-
- return \%installs;
-}
-
-1;
diff --git a/lib/Carton/Lockfile.pm b/lib/Carton/Lockfile.pm
index 2e9bf5e..f305380 100644
--- a/lib/Carton/Lockfile.pm
+++ b/lib/Carton/Lockfile.pm
@@ -1,30 +1,162 @@
package Carton::Lockfile;
use strict;
-use parent 'Path::Tiny';
+use Config;
+use Carton::Dist;
+use Carton::Dist::Core;
+use Carton::Error;
+use Carton::Package;
+use Carton::Index;
+use Carton::Util;
+use CPAN::Meta;
+use CPAN::Meta::Requirements;
+use File::Find ();
+use Try::Tiny;
+use Module::CoreList;
+use Moo;
-sub new {
- my $class = shift;
- my $self = Path::Tiny->new(@_);
- bless $self, $class; # XXX: Path::Tiny doesn't allow subclasses. Should be via Role + handles?
-}
+use constant CARTON_LOCK_VERSION => '0.9';
+
+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');
sub load_if_exists {
my $self = shift;
- Carton::Lock->from_file($self) if $self->is_file;
+ $self->load if $self->path->is_file;
}
sub load {
my $self = shift;
- if ($self->is_file) {
- Carton::Lock->from_file($self);
+ 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});
+ $self->loaded(1);
+
+ return 1;
} else {
Carton::Error::LockfileNotFound->throw(
error => "Can't find carton.lock: Run `carton install` to build the lock file.",
- path => $self->stringify,
+ path => $self->path,
);
}
}
-1;
+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}
+}
+
+sub find {
+ my($self, $module) = @_;
+
+ for my $meta (values %{$_[0]->modules}) {
+ if ($meta->{provides}{$module}) {
+ return Carton::Dist->new( $self->modules->{$meta->{name}} );
+ }
+ }
+
+ return;
+}
+
+sub find_or_core {
+ my($self, $module) = @_;
+ $self->find($module) || $self->find_in_core($module);
+}
+
+sub find_in_core {
+ my($self, $module) = @_;
+
+ if (exists $Module::CoreList::version{$]}{$module}) {
+ my $version = $Module::CoreList::version{$]}{$module}; # maybe undef
+ return Carton::Dist::Core->new(name => $module, version => $version);
+ }
+
+ return;
+}
+
+sub index {
+ my $self = shift;
+
+ my $index = Carton::Index->new;
+ for my $package ($self->packages) {
+ $index->add_package($package);
+ }
+
+ return $index;
+}
+
+sub packages {
+ my $self = shift;
+
+ my @packages;
+ while (my($name, $metadata) = each %{$self->modules}) {
+ while (my($package, $provides) = each %{$metadata->{provides}}) {
+ # TODO what if duplicates?
+ push @packages, Carton::Package->new($package, $provides->{version}, $metadata->{pathname});
+ }
+ }
+
+ return @packages;
+}
+
+sub write_index {
+ my($self, $file) = @_;
+ open my $fh, ">", $file or die $!;
+ $self->index->write($fh);
+}
+
+sub find_installs {
+ my($self, $path, $prereqs) = @_;
+
+ 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') {
+ push @installs, [ $File::Find::name, "$File::Find::dir/MYMETA.json" ];
+ }
+ };
+ File::Find::find($wanted, $libdir);
+
+ my %installs;
+ 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
+ }
+ }
+
+ $self->modules(\%installs);
+}
+
+1;
--
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