This is an automated email from the git hooks/post-receive script. kanashiro-guest pushed a commit to branch master in repository carton.
commit a718db33fee285d5161a81123f2761fe12c8e905 Author: Tatsuhiko Miyagawa <miyag...@bulknews.net> Date: Thu May 30 17:31:43 2013 +0900 Move the 02packages writer to Lock module --- lib/Carton.pm | 47 +++++------------------------------------------ lib/Carton/CLI.pm | 4 ++-- lib/Carton/Lock.pm | 48 ++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 55 insertions(+), 44 deletions(-) diff --git a/lib/Carton.pm b/lib/Carton.pm index 9cb57a4..16e3b8b 100644 --- a/lib/Carton.pm +++ b/lib/Carton.pm @@ -61,9 +61,7 @@ sub bundle { my($self, $cpanfile, $lock) = @_; my @modules = $self->list_dependencies; - - my $index = $self->build_index($lock->{modules}); - $self->build_mirror_file($index, $self->{mirror_file}); + $lock->write_mirror_index($self->{mirror_file}); my $mirror = $self->{mirror} || $DefaultMirror; my $local_cache = $self->local_cache; # because $self->{path} is localized @@ -86,8 +84,7 @@ sub install { my @modules = $self->list_dependencies; if ($lock) { - my $index = $self->build_index($lock->{modules}); - $self->build_mirror_file($index, $self->{mirror_file}); + $lock->write_mirror_index($self->{mirror_file}); } my $mirror = $self->{mirror} || $DefaultMirror; @@ -109,40 +106,6 @@ sub install { ) or die "Installing modules failed\n"; } -sub build_mirror_file { - my($self, $index, $file) = @_; - - my @packages = $self->build_packages($index); - - open my $fh, ">", $file or die $!; - print $fh <<EOF; -File: 02packages.details.txt -URL: http://www.perl.com/CPAN/modules/02packages.details.txt -Description: Package names found in carton.lock -Columns: package name, version, path -Intended-For: Automated fetch routines, namespace documentation. -Written-By: Carton $Carton::VERSION -Line-Count: @{[ scalar(@packages) ]} -Last-Updated: @{[ scalar localtime ]} - -EOF - for my $p (@packages) { - print $fh sprintf "%s %s %s\n", pad($p->[0], 32), pad($p->[1] || 'undef', 10, 1), $p->[2]; - } - - return $file; -} - -sub pad { - my($str, $len, $left) = @_; - - my $howmany = $len - length($str); - return $str if $howmany <= 0; - - my $pad = " " x $howmany; - return $left ? "$pad$str" : "$str$pad"; -} - sub build_packages { my($self, $index) = @_; @@ -156,11 +119,11 @@ sub build_packages { } sub build_index { - my($self, $modules) = @_; + my($self, $lock) = @_; my $index; - while (my($name, $metadata) = each %$modules) { + while (my($name, $metadata) = each %{$lock->{modules}}) { for my $mod (keys %{$metadata->{provides}}) { $index->{$mod} = { %{$metadata->{provides}{$mod}}, meta => $metadata }; } @@ -279,7 +242,7 @@ sub check_satisfies { my($self, $lock, $deps) = @_; my @unsatisfied; - my $index = $self->build_index($lock->{modules}); + my $index = $self->build_index($lock); my %pool = %{$lock->{modules}}; # copy my @root = map { [ split /~/, $_, 2 ] } @$deps; diff --git a/lib/Carton/CLI.pm b/lib/Carton/CLI.pm index 1fc95f6..d7b5200 100644 --- a/lib/Carton/CLI.pm +++ b/lib/Carton/CLI.pm @@ -196,7 +196,7 @@ sub cmd_show { my $lock = $self->find_lock or $self->error("Can't find carton.lock: Run `carton install`\n"); - my $index = $self->carton->build_index($lock->{modules}); + my $index = $self->carton->build_index($lock); for my $module (@args) { my $meta = $index->{$module}{meta} @@ -211,7 +211,7 @@ sub cmd_list { my $lock = $self->find_lock or $self->error("Can't find carton.lock: Run `carton install` to rebuild the lock file.\n"); - for my $module (values %{$lock->{modules} || {}}) { + for my $module ($lock->modules) { $self->print("$module->{dist}\n"); } } diff --git a/lib/Carton/Lock.pm b/lib/Carton/Lock.pm index 066d58a..2c2dd47 100644 --- a/lib/Carton/Lock.pm +++ b/lib/Carton/Lock.pm @@ -1,8 +1,56 @@ package Carton::Lock; +use strict; sub new { my($class, $data) = @_; bless $data, $class; } +sub modules { + values %{$_[0]->{modules} || {}}; +} + +sub write_mirror_index { + my($self, $file) = @_; + + my $index; + while (my($name, $metadata) = each %{$self->{modules}}) { + for my $mod (keys %{$metadata->{provides}}) { + $index->{$mod} = { %{$metadata->{provides}{$mod}}, meta => $metadata }; + } + } + + my @packages; + for my $package (sort keys %$index) { + my $module = $index->{$package}; + push @packages, [ $package, $module->{version}, $module->{meta}{pathname} ]; + } + + open my $fh, ">", $file or die $!; + print $fh <<EOF; +File: 02packages.details.txt +URL: http://www.perl.com/CPAN/modules/02packages.details.txt +Description: Package names found in carton.lock +Columns: package name, version, path +Intended-For: Automated fetch routines, namespace documentation. +Written-By: Carton $Carton::VERSION +Line-Count: @{[ scalar(@packages) ]} +Last-Updated: @{[ scalar localtime ]} + +EOF + for my $p (@packages) { + print $fh sprintf "%s %s %s\n", pad($p->[0], 32), pad($p->[1] || 'undef', 10, 1), $p->[2]; + } +} + +sub pad { + my($str, $len, $left) = @_; + + my $howmany = $len - length($str); + return $str if $howmany <= 0; + + my $pad = " " x $howmany; + return $left ? "$pad$str" : "$str$pad"; +} + 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 Pkg-perl-cvs-commits@lists.alioth.debian.org http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits