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 <[email protected]> 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 _______________________________________________ Pkg-perl-cvs-commits mailing list [email protected] http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits
