Skip to content

Commit

Permalink
cleanup
Browse files Browse the repository at this point in the history
  • Loading branch information
masaki committed Jan 1, 2012
1 parent 2e45877 commit 80c55a7
Show file tree
Hide file tree
Showing 3 changed files with 37 additions and 34 deletions.
1 change: 1 addition & 0 deletions Makefile.PL
Original file line number Original file line Diff line number Diff line change
Expand Up @@ -24,6 +24,7 @@ requires 'Module::Build', 0.38;
requires 'CPAN::Meta', 2.112; requires 'CPAN::Meta', 2.112;


# bundle DarkPAN support # bundle DarkPAN support
requires 'File::chdir';
requires 'Dist::Metadata'; requires 'Dist::Metadata';
requires 'IO::Compress::Gzip'; requires 'IO::Compress::Gzip';


Expand Down
56 changes: 27 additions & 29 deletions lib/Carton.pm
Original file line number Original file line Diff line number Diff line change
Expand Up @@ -12,6 +12,7 @@ use CPAN::Meta;
use File::Path (); use File::Path ();
use File::Basename (); use File::Basename ();
use File::Spec (); use File::Spec ();
use File::Temp ();
use Capture::Tiny 'capture'; use Capture::Tiny 'capture';


use constant CARTON_LOCK_VERSION => '0.9'; use constant CARTON_LOCK_VERSION => '0.9';
Expand All @@ -32,22 +33,13 @@ sub configure {


sub lock { $_[0]->{lock} } sub lock { $_[0]->{lock} }


sub bundle_dir { File::Spec->rel2abs("$_[0]->{path}/cache") } sub local_mirror { File::Spec->rel2abs("$_[0]->{path}/cache") }


sub bundle_from_build_file { sub download_from_build_file {
my($self, $file) = @_; my($self, $build_file, $local_mirror) = @_;

my $bundle_dir = $self->bundle_dir;


my @modules = $self->list_dependencies; my @modules = $self->list_dependencies;
$self->download_conservative(\@modules, $bundle_dir, 1) $self->download_conservative(\@modules, $local_mirror, 1)
or die "Bundling modules failed\n";

my $index = $self->build_index_from_darkpan($bundle_dir);

my $index_file = "$bundle_dir/modules/02packages.details.txt.gz";
File::Path::mkpath(File::Basename::dirname($index_file));
$self->build_mirror_file($index, $index_file)
or die "Bundling modules failed\n"; or die "Bundling modules failed\n";
} }


Expand Down Expand Up @@ -109,14 +101,11 @@ sub dedupe_modules {
sub download_conservative { sub download_conservative {
my($self, $modules, $dir, $cascade) = @_; my($self, $modules, $dir, $cascade) = @_;


require File::Temp;

$modules = $self->dedupe_modules($modules); $modules = $self->dedupe_modules($modules);


local $self->{path} = File::Temp::tempdir(CLEANUP => 1); # ignore installed

my $mirror = $self->{mirror} || $DefaultMirror; my $mirror = $self->{mirror} || $DefaultMirror;


local $self->{path} = File::Temp::tempdir(CLEANUP => 1); # ignore installed
$self->run_cpanm( $self->run_cpanm(
"--mirror", $mirror, "--mirror", $mirror,
"--mirror", "http://backpan.perl.org/", # fallback "--mirror", "http://backpan.perl.org/", # fallback
Expand Down Expand Up @@ -221,24 +210,22 @@ sub build_index {
return $index; return $index;
} }


sub build_index_from_darkpan { sub build_mirror_index {
my($self, $base_dir) = @_; my($self, $local_mirror) = @_;


require File::chdir;
require Dist::Metadata; require Dist::Metadata;


my $index = {}; my $index = {};
my $author_dir = "$base_dir/authors/id";


for my $file (<$author_dir/*/*/*/*>) { local $File::chdir::CWD = "$local_mirror/authors/id";

for my $file (<*/*/*/*>) { # D/DU/DUMMY/Foo-Bar-0.01.tar.gz
my $dist = Dist::Metadata->new(file => $file); my $dist = Dist::Metadata->new(file => $file);
(my $normalized_path = $file) =~ s!$author_dir/!!;

my $provides = $dist->package_versions;
my $provides = $dist->provides; while (my($package, $version) = each %$provides) {
while (my($package, $meta) = each %$provides) { $index->{$package} = { version => $version, meta => { pathname => $file } };
$index->{$package} = +{
version => $meta->{version},
meta => { pathname => $normalized_path },
};
} }
}; };


Expand Down Expand Up @@ -354,6 +341,17 @@ sub run_cpanm {
!system "cpanm", "--quiet", "-L", $self->{path}, "--notest", @args; !system "cpanm", "--quiet", "-L", $self->{path}, "--notest", @args;
} }


sub update_mirror_index {
my($self, $local_mirror) = @_;

my $index = $self->build_mirror_index($local_mirror);

my $file = "$local_mirror/modules/02packages.details.txt.gz";
File::Path::mkpath(File::Basename::dirname($file));
$self->build_mirror_file($index, $file)
or die "Bundling modules failed\n";
}

sub update_lock_file { sub update_lock_file {
my($self, $file) = @_; my($self, $file) = @_;


Expand Down
14 changes: 9 additions & 5 deletions lib/Carton/CLI.pm
Original file line number Original file line Diff line number Diff line change
Expand Up @@ -134,16 +134,19 @@ sub cmd_version {
sub cmd_bundle { sub cmd_bundle {
my($self, @args) = @_; my($self, @args) = @_;


$self->parse_options(\@args, "p|path=s", sub { $self->carton->{path} = $_[1] }); $self->parse_options(\@args, "p|path=s" => sub { $self->carton->{path} = $_[1] });

my $local_mirror = $self->carton->local_mirror;


if (my $build_file = $self->has_build_file) { if (my $build_file = $self->has_build_file) {
$self->print("Bundling modules using $build_file\n"); $self->print("Bundling modules using $build_file\n");
$self->carton->bundle_from_build_file($build_file); $self->carton->download_from_build_file($build_file, $local_mirror);
$self->carton->update_mirror_index($local_mirror);
} else { } else {
$self->error("Can't locate build file\n"); $self->error("Can't locate build file\n");
} }


$self->printf("Complete! Modules were bundled into %s (DarkPAN)\n", $self->carton->bundle_dir, SUCCESS); $self->printf("Complete! Modules were bundled into %s (DarkPAN)\n", $local_mirror, SUCCESS);
} }


sub cmd_install { sub cmd_install {
Expand All @@ -153,15 +156,16 @@ sub cmd_install {
\@args, \@args,
"p|path=s" => sub { $self->carton->{path} = $_[1] }, "p|path=s" => sub { $self->carton->{path} = $_[1] },
"deployment!" => \$self->{deployment}, "deployment!" => \$self->{deployment},
"cached!" => \$self->{use_local_cache}, "cached!" => \$self->{use_local_mirror},
); );


my $lock = $self->find_lock; my $lock = $self->find_lock;
my $local_mirror = $self->carton->local_mirror;


$self->carton->configure( $self->carton->configure(
lock => $lock, lock => $lock,
mirror_file => $self->mirror_file, # $lock object? mirror_file => $self->mirror_file, # $lock object?
( $self->{use_local_cache} ? (mirror => $self->carton->bundle_dir) : () ), ( $self->{use_local_mirror} && -d $local_mirror ? (mirror => $local_mirror) : () ),
); );


my $build_file = $self->has_build_file; my $build_file = $self->has_build_file;
Expand Down

0 comments on commit 80c55a7

Please sign in to comment.