File Coverage

blib/lib/Carmel/App.pm
Criterion Covered Total %
statement 60 410 14.6
branch 0 98 0.0
condition 0 37 0.0
subroutine 20 87 22.9
pod 0 48 0.0
total 80 680 11.7


line stmt bran cond sub pod time code
1             package Carmel::App;
2 1     1   422 use strict;
  1         2  
  1         19  
3 1     1   4 use warnings;
  1         1  
  1         18  
4              
5 1     1   4 use Carmel;
  1         1  
  1         12  
6 1     1   273 use Carmel::Runner;
  1         2  
  1         21  
7 1     1   5 use Carp ();
  1         1  
  1         12  
8 1     1   343 use Carmel::Builder;
  1         4  
  1         31  
9 1     1   321 use Carmel::CPANfile;
  1         3  
  1         28  
10 1     1   394 use Carmel::Repository;
  1         3  
  1         31  
11 1     1   344 use Carmel::Resolver;
  1         3  
  1         38  
12 1     1   344 use Carmel::ProgressBar qw(progress);
  1         3  
  1         50  
13 1     1   7 use Config qw(%Config);
  1         2  
  1         31  
14 1     1   3 use CPAN::Meta::Requirements;
  1         2  
  1         28  
15 1     1   4 use File::pushd qw(pushd);
  1         3  
  1         37  
16 1     1   559 use Getopt::Long ();
  1         7753  
  1         30  
17 1     1   8 use Module::CPANfile;
  1         1  
  1         19  
18 1     1   503 use Module::Metadata;
  1         4458  
  1         34  
19 1     1   6 use Path::Tiny ();
  1         3  
  1         12  
20 1     1   392 use Pod::Usage ();
  1         37525  
  1         29  
21 1     1   9 use Try::Tiny;
  1         2  
  1         109  
22              
23             # prefer Parse::CPAN::Meta in XS, PP order with JSON.pm
24             $ENV{PERL_JSON_BACKEND} = 1
25             unless defined $ENV{PERL_JSON_BACKEND};
26              
27             use Class::Tiny {
28 0           verbose => sub { 0 },
29 0           perl_arch => sub { "$Config{version}-$Config{archname}" },
30 1     1   5 };
  1         2  
  1         13  
31              
32             sub parse_options {
33 0     0 0   my($self, $args) = @_;
34              
35 0 0 0       return if $args->[0] && $args->[0] eq 'exec';
36              
37 0           my $cmd;
38 0           my $parser = Getopt::Long::Parser->new(
39             config => [ "no_ignore_case", "pass_through" ],
40             );
41             $parser->getoptionsfromarray(
42             $args,
43 0     0     "h|help" => sub { $cmd = 'help' },
44 0     0     "version" => sub { $cmd = 'version' },
45 0     0     "v|verbose!" => sub { $Carmel::DEBUG = $self->verbose($_[1]) },
46 0           );
47              
48 0 0         unshift @$args, $cmd if $cmd;
49             }
50              
51             sub run {
52 0     0 0   my($self, @args) = @_;
53              
54 0           $self->parse_options(\@args);
55              
56 0   0       my $cmd = shift @args || 'install';
57 0 0         my $call = $self->can("cmd_$cmd")
58             or die "Can't find command '$cmd': run `carmel help` to see the list of commands.\n";
59              
60 0 0         if ($cmd eq 'run') {
61 0           return $self->cmd_run(@args);
62             }
63              
64 0           my $code = 0;
65             try {
66 0     0     $self->$call(@args);
67             } catch {
68 0     0     warn $_;
69 0           $code = 1;
70 0           };
71              
72 0           return $code;
73             }
74              
75             sub repository_base {
76 0     0 0   my $self = shift;
77              
78 0   0       my $home = $ENV{HOME} || $ENV{HOMEPATH};
79 0   0       Path::Tiny->new($ENV{PERL_CARMEL_REPO} || "$home/.carmel/" . $self->perl_arch);
80             }
81              
82             sub repo {
83 0     0 0   my $self = shift;
84 0   0       $self->{repo} ||= $self->build_repo;
85             }
86              
87             sub build_repo {
88 0     0 0   my $self = shift;
89 0           Carmel::Repository->new(path => $self->repository_base->child('builds'));
90             }
91              
92             sub cmd_help {
93 0     0 0   my $self = shift;
94 0           print "Carmel version $Carmel::VERSION\n\n";
95 0           Pod::Usage::pod2usage(1);
96             }
97              
98             sub cmd_version {
99 0     0 0   my $self = shift;
100 0           print "Carmel version $Carmel::VERSION\n";
101             }
102              
103             sub cmd_inject {
104 0     0 0   my($self, @args) = @_;
105              
106 0           my $reqs = CPAN::Meta::Requirements->new;
107 0           for my $arg (@args) {
108 0           my($module, $version) = split /@/, $arg, 2;
109 0 0         $reqs->add_string_requirement($module, $version ? "== $version" : 0);
110             }
111              
112 0           my $cpanfile = Module::CPANfile->from_prereqs({
113             runtime => {
114             requires => $reqs->as_string_hash,
115             },
116             });
117              
118             # FIXME: $builder->install() reads mirror info from cpanfile_path
119 0           my $path = Path::Tiny->tempfile;
120 0           $cpanfile->save($path);
121              
122 0           my @artifacts = $self->builder(cpanfile => $cpanfile, cpanfile_path => $path)->install;
123              
124 0           my @failed;
125             MODULE:
126 0           for my $module ($reqs->required_modules) {
127 0           my $want = $reqs->requirements_for_module($module);
128 0           for my $artifact (@artifacts) {
129 0 0         if ($artifact->provides->{$module}) {
130 0           my $version = $artifact->version_for($module);
131 0 0         $reqs->accepts_module($module => $version)
132             or die "Installed version for $module ($version) doesn't satisfy the requirement: $want\n";
133 0           next MODULE;
134             }
135             }
136              
137 0           push @failed, $module;
138             }
139              
140 0 0         if (@failed) {
141 0           die "Couldn't install module(s): ", join(", ", @failed), "\n";
142             }
143             }
144              
145             sub cmd_pin {
146 0     0 0   my($self, @args) = @_;
147 0           die "carmel pin is deprecated. Use `carmel update @args` instead\n";
148             }
149              
150             sub cmd_update {
151 0     0 0   my($self, @args) = @_;
152              
153 0 0         my $snapshot = $self->snapshot
154             or die "Can't run carmel update without snapshot. Run `carmel install` first.\n";
155              
156 0           print "---> Checking updates...\n";
157              
158 0           $self->update_or_install($snapshot, @args);
159             }
160              
161             sub update_or_install {
162 0     0 0   my($self, $snapshot, @args) = @_;
163              
164 0           my $builder = $self->builder;
165 0           my $requirements = $self->requirements;
166              
167             my $check = sub {
168 0     0     my($module, $pathname, $in_args, $version) = @_;
169              
170 0 0         return if $module eq 'perl';
171              
172 0           my $dist = $builder->search_module($module, $version);
173 0 0         unless ($dist) {
174 0 0         if ($version) {
175 0           die "Can't find $module ($version) on CPAN\n";
176             } else {
177             # workaround bad main package e.g. LWP => libwww::perl
178 0           warn "Can't find $module on CPAN\n";
179 0           return;
180             }
181             }
182              
183             # non-dual core module like "strict.pm"
184             # TODO should be $dist->is_perl
185 0 0         return if $dist->name =~ /^perl-5\.\d+\.\d+$/;
186              
187 0 0         if (defined $version) {
188             try {
189 0           $requirements->add_string_requirement($module, $version);
190             } catch {
191 0           my($err) = /illegal requirements(?: .*?): (.*) at/;
192 0           my $old = $requirements->requirements_for_module($module);
193 0           die "Requested version for $module '$version' conflicts with version required in cpanfile '$old': $err\n";
194 0           };
195             } else {
196 0           my $want_ver = $dist->version_for($module);
197             try {
198 0           $requirements->add_string_requirement($module, $want_ver);
199             } catch {
200             # there's an update but it conflicts with specs in cpanfile, ignoring
201 0 0         if ($in_args) {
202 0           my($err) = /illegal requirements(?: .*?): (.*) at/;
203 0           my $old = $requirements->requirements_for_module($module);
204 0           die "The update for $module '$want_ver' conflicts with version required in cpanfile '$old' $err\n";
205             }
206 0           };
207             }
208 0           };
209              
210 0 0         if (@args) {
211 0           for my $arg (@args) {
212 0           my($module, $version) = split '@', $arg, 2;
213 0 0         my $dist = $snapshot ? $snapshot->find($module) : undef;
214 0 0         if ($dist) {
    0          
215 0 0         $check->($module, $dist->pathname, 1, $version ? "== $version" : undef);
216             } elsif (defined $requirements->requirements_for_module($module)) {
217 0 0         $check->($module, '', 1, $version ? "== $version" : undef);
218             } else {
219 0           die "$module is not found in cpanfile or cpanfile.snapshot\n";
220             }
221             }
222             } else {
223 0           my $missing = $requirements->clone;
224              
225 0           my @checks;
226             my $resolver = $self->resolver(
227             root => $self->requirements->clone,
228             snapshot => $snapshot,
229             found => sub {
230 0     0     my $artifact = shift;
231 0           for my $pkg (keys %{$artifact->provides}) {
  0            
232 0           $missing->clear_requirement($pkg);
233             }
234 0           push @checks, [ $artifact->package, $artifact->install->{pathname}, 0 ];
235             },
236             missing => sub {
237 0     0     my($module, $want_version) = @_;
238 0           $missing->add_string_requirement($module => $want_version);
239             },
240 0           );
241 0           $resolver->resolve;
242              
243             # snapshot not supplied (first carmel install), or
244             # specified in cpanfile but not in snapshot, possibly core module
245 0           for my $module ($missing->required_modules) {
246 0           push @checks, [ $module, '', 0 ];
247             }
248              
249 0     0     progress \@checks, sub { $check->(@{$_[0]}) };
  0            
  0            
250             }
251              
252             # rebuild the snapshot
253 0           $self->update_dependencies($requirements, $snapshot);
254             }
255              
256             sub cmd_install {
257 0     0 0   my($self, @args) = @_;
258              
259 0 0         die "Usage: carmel install\n" if @args;
260              
261 0           my $snapshot = $self->snapshot;
262 0 0         if ($snapshot) {
263 0           $self->update_dependencies($self->requirements, $snapshot);
264             } else {
265 0           print "---> Installing modules...\n";
266 0           $self->update_or_install($snapshot);
267             }
268             }
269              
270             sub update_dependencies {
271 0     0 0   my($self, $root_reqs, $snapshot) = @_;
272              
273 0           my @artifacts = $self->install($root_reqs, $snapshot);
274 0           $self->dump_bootstrap(\@artifacts);
275 0           $self->save_snapshot(\@artifacts);
276             }
277              
278             sub resolve_dependencies {
279 0     0 0   my($self, $root_reqs, $missing, $snapshot) = @_;
280              
281 0           my @artifacts;
282             $self->resolver(
283             root => $root_reqs,
284             snapshot => $snapshot,
285             found => sub {
286 0     0     my $artifact = shift;
287 0   0       printf "Using %s (%s)\n", $artifact->package, $artifact->version || '0';
288 0           push @artifacts, $artifact;
289             },
290             missing => sub {
291 0     0     my($module, $want_version) = @_;
292 0           $missing->add_string_requirement($module => $want_version);
293             },
294 0           )->resolve;
295              
296 0           return @artifacts;
297             }
298              
299             sub is_identical_requirement {
300 0     0 0   my($self, $old, $new) = @_;
301              
302 0 0         return unless $old;
303              
304             # not super accurate but enough
305 0           join(',', sort $old->required_modules) eq join(',', sort $new->required_modules);
306             }
307              
308             sub try_install {
309 0     0 0   my($self, $root_reqs, $snapshot) = @_;
310              
311 0           my $prev;
312 0           while (1) {
313 0           my $missing = CPAN::Meta::Requirements->new;
314 0           my @artifacts = $self->resolve_dependencies($root_reqs, $missing, $snapshot);
315              
316 0 0         if (!$missing->required_modules) {
317 0           return @artifacts;
318             }
319              
320 0 0         if ($self->is_identical_requirement($prev, $missing)) {
321 0           my $prereqs = $missing->as_string_hash;
322 0   0       my $requirements = join ", ", map "$_ => @{[ $prereqs->{$_} || '0' ]}", keys %$prereqs;
  0            
323 0           die "Can't find an artifact for $requirements\n" .
324             "You need to run `carmel install` first to get the modules installed and artifacts built.\n";
325             }
326              
327 0           $prev = $missing;
328              
329 0           my $cpanfile = Module::CPANfile->from_prereqs({
330             runtime => {
331             requires => $missing->as_string_hash,
332             },
333             });
334 0           print "---> Installing new dependencies: ", join(", ", $missing->required_modules), "\n";
335 0           my $builder = $self->builder(cpanfile => $cpanfile, snapshot => $snapshot);
336 0           $builder->install;
337             }
338             }
339              
340             sub install {
341 0     0 0   my($self, $root_reqs, $snapshot) = @_;
342              
343 0           my @artifacts = $self->try_install($root_reqs, $snapshot);
344              
345             # $root_reqs has been mutated at this point. Reload requirements
346             printf "---> Complete! %d cpanfile dependencies. %d modules installed.\n",
347 0           scalar(grep { $_ ne 'perl' } $self->requirements->required_modules), scalar(@artifacts);
  0            
348              
349 0           return @artifacts;
350             }
351              
352             sub cmd_reinstall {
353 0     0 0   my($self, @args) = @_;
354              
355 0 0         my @modules = @args ? @args : $self->requirements->required_modules;
356              
357 0 0         my $snapshot = $self->snapshot
358             or die "Can't run carmel reinstall without snapshot. Run `carmel install` first.\n";
359              
360 0           my $reqs = CPAN::Meta::Requirements->new;
361 0           for my $module (@modules) {
362 0 0         if (my $dist = $snapshot->find($module)) {
    0          
363 0           $reqs->add_string_requirement($module, $dist->version_for($module));
364             } elsif (@args) {
365 0           die "$module is not found in cpanfile.snapshot\n";
366             }
367             }
368              
369 0           my $cpanfile = Module::CPANfile->from_prereqs({
370             runtime => {
371             requires => $reqs->as_string_hash,
372             },
373             });
374              
375 0           $self->builder(cpanfile => $cpanfile, snapshot => $snapshot)->install;
376 0           $self->cmd_install;
377             }
378              
379             sub builder {
380 0     0 0   my($self, @args) = @_;
381              
382             Carmel::Builder->new(
383             repository_base => $self->repository_base,
384             cpanfile_path => $self->cpanfile_path,
385 0     0     collect_artifact => sub { $self->repo->import_artifact(@_) },
386 0           @args,
387             );
388             }
389              
390             sub quote {
391 0     0 0   my $indent = shift;
392 0           $indent = " " x $indent;
393              
394 0           require Data::Dumper;
395 0           my $val = Data::Dumper->new([transform(@_)], [])
396             ->Sortkeys(1)->Terse(1)->Indent(1)->Dump;
397              
398 0           chomp $val;
399 0 0         $val =~ s/^/$indent/mg if $indent;
400 0           $val =~ s/^ *//;
401 0           $val;
402             }
403              
404             sub transform {
405 0     0 0   my $data = shift;
406              
407             # stringify elements
408 0 0         if (ref $data eq 'ARRAY') {
    0          
409 0           [map transform($_), @$data];
410             } elsif (ref $data eq 'HASH') {
411 0           my %value = map { $_ => transform($data->{$_}) } keys %$data;
  0            
412 0           \%value;
413             } else {
414 0           "$data";
415             }
416             }
417              
418             sub save_snapshot {
419 0     0 0   my($self, $artifacts) = @_;
420              
421 0           require Carton::Snapshot;
422 0           require Carton::Dist;
423              
424 0           my $snapshot = Carton::Snapshot->new(path => $self->cpanfile->snapshot_path);
425              
426 0           for my $artifact (@$artifacts) {
427             my $dist = Carton::Dist->new(
428             name => $artifact->distname,
429             pathname => $artifact->install->{pathname},
430 0           provides => $artifact->provides,
431             version => $artifact->version,
432             # compatibility with Carton snapshot
433             requirements => $artifact->requirements_for([qw( configure build runtime )], ['requires']),
434             );
435 0           $snapshot->add_distribution($dist);
436             }
437              
438 0           $snapshot->save;
439             }
440              
441             sub dump_bootstrap {
442 0     0 0   my($self, $artifacts) = @_;
443              
444 0           my @inc = map $_->nonempty_libs, @$artifacts;
445 0           my @path = map $_->nonempty_paths, @$artifacts;
446              
447 0           my(%execs);
448 0           for my $artifact (@$artifacts) {
449 0           my %bins = $artifact->executables;
450 0 0         $execs{$artifact->package} = \%bins if %bins;
451             }
452              
453 0           my %modules;
454 0           for my $artifact (@$artifacts) {
455 0           %modules = (%modules, $artifact->module_files);
456             }
457              
458 0           my $prereqs = $self->cpanfile->load->prereqs->as_string_hash;
459 0           my $package = "Carmel::MySetup"; # hide from PAUSE
460              
461 0           my $file = Path::Tiny->new(".carmel/MySetup.pm");
462 0           $file->parent->mkpath;
463 0           $file->spew(<
464             # DO NOT EDIT! Auto-generated via carmel install.
465             package $package;
466              
467             our %environment = (
468 0           'inc' => @{[ quote 2, \@inc ]},
469 0           'path' => @{[ quote 2, \@path ]},
470 0           'execs' => @{[ quote 2, \%execs ]},
471 0           'base' => @{[ quote(2, Path::Tiny->cwd) ]},
472 0           'modules' => @{[ quote 2, \%modules ]},
473 0           'prereqs' => @{[ quote 2, $prereqs ]},
474             );
475              
476             1;
477             EOF
478             }
479              
480             sub cmd_export {
481 0     0 0   my($self) = @_;
482 0           my %env = Carmel::Runner->new->env;
483 0           print "export ", join(" ", map qq($_="$env{$_}"), sort keys %env), "\n";
484             }
485              
486             sub cmd_env {
487 0     0 0   my($self) = @_;
488 0           my %env = Carmel::Runner->new->env;
489 0           print join "", map qq($_=$env{$_}\n), sort keys %env;
490             }
491              
492             sub cmd_run {
493 0     0 0   my($self, @args) = @_;
494 0           Carmel::Runner->new->run(@args);
495             }
496              
497             # Usually carmel exec is handled in carmel script, not here
498             sub cmd_exec {
499 0     0 0   my($self, @args) = @_;
500 0           Carmel::Runner->new->execute(@args);
501             }
502              
503             sub cmd_find {
504 0     0 0   my($self, $module, $requirement) = @_;
505              
506 0   0       my @artifacts = $self->repo->find_all($module, $requirement || '0');
507 0           for my $artifact (@artifacts) {
508 0   0       printf "%s (%s) in %s\n", $artifact->package, $artifact->version || '0', $artifact->path;
509             }
510             }
511              
512             sub cmd_show {
513 0     0 0   my($self, $module) = @_;
514              
515 0 0         $module or die "Usage: carmel show Module\n";
516              
517 0           my $artifact = $self->artifact_for($module);
518 0 0 0       printf "%s (%s) in %s\n", $artifact->package, $artifact->version || '0', $artifact->path
519             if $artifact;
520             }
521              
522             sub cmd_info {
523 0     0 0   my $self = shift;
524 0           $self->cmd_show(@_);
525             }
526              
527             sub cmd_list {
528 0     0 0   my $self = shift;
529              
530 0           my @artifacts;
531 0     0     $self->resolve(sub { push @artifacts, $_[0] });
  0            
532              
533 0           for my $artifact (sort { $a->package cmp $b->package } @artifacts) {
  0            
534 0   0       printf "%s (%s)\n", $artifact->package, $artifact->version || '0';
535             }
536             }
537              
538             sub cmd_look {
539 0     0 0   my($self, $module) = @_;
540              
541 0 0         $module or die "Usage: carmel look Module\n";
542              
543             my $shell = $ENV{SHELL}
544 0 0         or die "Can't determine shell from SHELL variable\n";
545              
546 0           my $artifact = $self->artifact_for($module);
547              
548 0           my $dir = pushd $artifact->path;
549 0           system $shell;
550             }
551              
552             sub cmd_diff {
553 0     0 0   my $self = shift;
554              
555 0           my $snapshot_path = $self->cpanfile->snapshot_path->relative;
556              
557             # Don't check if .git exists, and let git(2) handle the error
558              
559 0 0         if ($ENV{PERL_CARMEL_USE_DIFFTOOL}) {
560 0           my $cmd = 'carmel difftool';
561 0 0         $cmd .= ' -v' if $self->verbose;
562              
563 0           system 'git', 'difftool', '--no-prompt',
564             '--extcmd', $cmd, $snapshot_path;
565             } else {
566 0           require Carmel::Difftool;
567              
568 0 0         my $content = `git show HEAD:$snapshot_path`
569             or die "Can't retrieve snapshot content (not in git repository?)\n";
570 0           my $path = Path::Tiny->tempfile;
571 0           $path->spew($content);
572              
573 0           my $diff = Carmel::Difftool->new;
574 0           $diff->diff($path, $snapshot_path);
575             }
576             }
577              
578             sub cmd_difftool {
579 0     0 0   my($self, @args) = @_;
580              
581 0           require Carmel::Difftool;
582              
583 0           my $diff = Carmel::Difftool->new;
584 0           $diff->diff(@args);
585             }
586              
587             sub resolve {
588 0     0 0   my($self, $cb) = @_;
589 0           $self->resolver(found => $cb)->resolve;
590             }
591              
592             sub resolver {
593 0     0 0   my($self, @args) = @_;
594              
595             Carmel::Resolver->new(
596             repo => $self->repo,
597             root => $self->requirements,
598             snapshot => scalar $self->snapshot,
599 0     0     missing => sub { $self->missing_default(@_) },
600 0           @args,
601             );
602             }
603              
604             sub missing_default {
605 0     0 0   my($self, $module, $want_version, $depth) = @_;
606 0           die "Can't find an artifact for $module => $want_version\n" .
607             "You need to run `carmel install` first to get the modules installed and artifacts built.\n";
608             }
609              
610             sub artifact_for {
611 0     0 0   my($self, $module) = @_;
612              
613 0           my $found;
614 0           eval {
615             $self->resolve(sub {
616 0     0     my $artifact = shift;
617 0 0         if (exists $artifact->provides->{$module}) {
618 0           $found = $artifact;
619 0           die "__FOUND__\n";
620             }
621 0           });
622 0           die "Can't find a module named '$module' in the cpanfile dependencies.\n";
623             };
624              
625 0 0 0       die $@ if $@ && $@ ne "__FOUND__\n";
626 0           return $found;
627             }
628              
629             sub cmd_tree {
630 0     0 0   my($self) = @_;
631              
632             $self->resolve(sub {
633 0     0     my($artifact, $depth) = @_;
634 0   0       printf "%s%s (%s)\n", (" " x $depth), $artifact->package, $artifact->version || '0';
635 0           });
636             }
637              
638             sub cmd_rollout {
639 0     0 0   my $self = shift;
640              
641 0           my @artifacts;
642 0     0     $self->resolve(sub { push @artifacts, $_[0] });
  0            
643              
644             # TODO safe atomic rename
645 0           my $install_base = Path::Tiny->new("local")->absolute;
646 0 0         $install_base->remove_tree({ safe => 0 }) if $install_base->exists;
647              
648 0           $self->builder->rollout($install_base, \@artifacts);
649              
650 0           $install_base->child(".carmel")->touch;
651             }
652              
653             sub cmd_package {
654 0     0 0   my $self = shift;
655              
656 0           my $index = $self->build_index;
657              
658 0           my $source_base = $self->repository_base->child('cache');
659 0           my $target_base = Path::Tiny->new('vendor/cache');
660              
661 0           my %done;
662             my @found;
663 0           for my $package ($index->packages) {
664 0 0         next if $done{$package->pathname}++;
665              
666 0           my $source = $source_base->child('authors/id', $package->pathname);
667 0           my $target = $target_base->child('authors/id', $package->pathname);
668              
669 0 0         if ($source->exists) {
670             push @found, sub {
671 0     0     print "Copying ", $package->pathname, "\n";
672 0           $target->parent->mkpath;
673 0           $source->copy($target);
674 0           };
675             } else {
676 0           die sprintf "%s not found in %s.\n" .
677             "Run `carmel install` to fix this. If that didn't resolve the issue, try removing %s\n",
678             $package->pathname, $source_base, $self->repository_base;
679             }
680             }
681              
682 0           for my $copy (@found) {
683 0           $copy->();
684             }
685              
686 0           require IO::Compress::Gzip;
687 0           my $index_file = $target_base->child('modules/02packages.details.txt.gz');
688 0           $index_file->parent->mkpath;
689              
690 0           warn "Writing $index_file\n";
691 0 0         my $out = IO::Compress::Gzip->new($index_file->openw)
692             or die "gzip failed: $IO::Compress::Gzip::GzipError";
693 0           $index->write($out);
694              
695 0           print "---> Complete! ", scalar(@found), " distributions are packaged in vendor/cache\n";
696             }
697              
698             sub cmd_index {
699 0     0 0   my $self = shift;
700 0           $self->build_index->write(*STDOUT);
701             }
702              
703             sub build_index {
704 0     0 0   my $self = shift;
705              
706 0           require Carton::Index;
707 0           require Carton::Package;
708              
709 0           my $index = Carton::Index->new(generator => "Carmel $Carmel::VERSION");
710              
711             $self->resolve(sub {
712 0     0     my $artifact = shift;
713 0           while (my($pkg, $data) = each %{$artifact->provides}) {
  0            
714 0           my $package = Carton::Package->new($pkg, $data->{version}, $artifact->install->{pathname});
715 0           $index->add_package($package);
716             }
717 0           });
718              
719 0           $index;
720             }
721              
722             sub cpanfile_path {
723 0     0 0   my $self = shift;
724 0   0       $self->{cpanfile_path} ||= Path::Tiny->new($self->locate_cpanfile)->absolute;
725             }
726              
727             sub locate_cpanfile {
728 0     0 0   my $self = shift;
729              
730 0           my $path = $ENV{PERL_CARMEL_CPANFILE};
731 0 0         if ($path) {
732 0           return $path;
733             }
734              
735 0           my $current = Path::Tiny->cwd;
736 0           my $previous = '';
737              
738 0   0       until ($current eq '/' or $current eq $previous) {
739 0           my $try = $current->child('cpanfile');
740 0 0         return $try if $try->is_file;
741 0           ($previous, $current) = ($current, $current->parent);
742             }
743              
744 0           return 'cpanfile'; # fallback, most certainly fails later
745             }
746              
747             sub cpanfile {
748 0     0 0   my $self = shift;
749 0           Carmel::CPANfile->new(path => $self->cpanfile_path);
750             }
751              
752             sub requirements {
753 0     0 0   my $self = shift;
754              
755 0           return $self->cpanfile->load->prereqs
756             ->merged_requirements(['runtime', 'test', 'develop'], ['requires']);
757             }
758              
759             sub snapshot {
760 0     0 0   my $self = shift;
761 0           $self->cpanfile->load_snapshot;
762             }
763              
764             1;