File Coverage

blib/lib/Dist/Zilla/Dist/Builder.pm
Criterion Covered Total %
statement 278 368 75.5
branch 56 134 41.7
condition 19 56 33.9
subroutine 39 45 86.6
pod 16 16 100.0
total 408 619 65.9


line stmt bran cond sub pod time code
1             # ABSTRACT: dist zilla subclass for building dists
2              
3             use Moose 0.92; # role composition fixes
4 50     50   38172 extends 'Dist::Zilla';
  50         367703  
  50         344  
5              
6             use Dist::Zilla::Pragmas;
7 50     50   329198  
  50         124  
  50         431  
8             use MooseX::Types::Moose qw(HashRef);
9 50     50   972 use Dist::Zilla::Types qw(Path);
  50         48163  
  50         848  
10 50     50   250134  
  50         132  
  50         497  
11             use File::pushd ();
12 50     50   109668 use Dist::Zilla::Path; # because more Path::* is better, eh?
  50         131  
  50         1029  
13 50     50   266 use Try::Tiny;
  50         145  
  50         376  
14 50     50   14647 use List::Util 1.45 'uniq';
  50         130  
  50         3932  
15 50     50   359 use Module::Runtime 'require_module';
  50         1116  
  50         3425  
16 50     50   349  
  50         191  
  50         458  
17             use namespace::autoclean;
18 50     50   2909  
  50         115  
  50         428  
19             #pod =method from_config
20             #pod
21             #pod my $zilla = Dist::Zilla->from_config(\%arg);
22             #pod
23             #pod This routine returns a new Zilla from the configuration in the current working
24             #pod directory.
25             #pod
26             #pod This method should not be relied upon, yet. Its semantics are B<certain> to
27             #pod change.
28             #pod
29             #pod Valid arguments are:
30             #pod
31             #pod config_class - the class to use to read the config
32             #pod default: Dist::Zilla::MVP::Reader::Finder
33             #pod
34             #pod =cut
35              
36             my ($class, $arg) = @_;
37             $arg ||= {};
38 184     184 1 767  
39 184   50     713 my $root = path($arg->{dist_root} || '.');
40              
41 184   100     1320 my $sequence = $class->_load_config({
42             root => $root,
43             chrome => $arg->{chrome},
44             config_class => $arg->{config_class},
45             _global_stashes => $arg->{_global_stashes},
46             });
47              
48 184         11546 my $self = $sequence->section_named('_')->zilla;
49              
50 174         1207 $self->_setup_default_plugins;
51              
52 174         1557 return $self;
53             }
54 174         1579  
55             my ($self) = @_;
56             unless ($self->plugin_named(':InstallModules')) {
57             require Dist::Zilla::Plugin::FinderCode;
58 174     174   544 my $plugin = Dist::Zilla::Plugin::FinderCode->new({
59 174 50       1261 plugin_name => ':InstallModules',
60 174         24717 zilla => $self,
61             style => 'grep',
62             code => sub {
63             my ($file, $self) = @_;
64             local $_ = $file->name;
65             return 1 if m{\Alib/} and m{\.(pm|pod)$};
66 404     404   785 return;
67 404         1027 },
68 404 100 66     1947 });
69 288         863  
70             push @{ $self->plugins }, $plugin;
71 174         8846 }
72              
73 174         588 unless ($self->plugin_named(':IncModules')) {
  174         5046  
74             require Dist::Zilla::Plugin::FinderCode;
75             my $plugin = Dist::Zilla::Plugin::FinderCode->new({
76 174 50       929 plugin_name => ':IncModules',
77 174         1026 zilla => $self,
78             style => 'grep',
79             code => sub {
80             my ($file, $self) = @_;
81             local $_ = $file->name;
82             return 1 if m{\Ainc/} and m{\.pm$};
83 38     38   76 return;
84 38         91 },
85 38 100 66     160 });
86 33         91  
87             push @{ $self->plugins }, $plugin;
88 174         7037 }
89              
90 174         695 unless ($self->plugin_named(':TestFiles')) {
  174         4787  
91             require Dist::Zilla::Plugin::FinderCode;
92             my $plugin = Dist::Zilla::Plugin::FinderCode->new({
93 174 50       834 plugin_name => ':TestFiles',
94 174         1017 zilla => $self,
95             style => 'grep',
96             code => sub { local $_ = $_->name; m{\At/} },
97             });
98              
99 164     164   480 push @{ $self->plugins }, $plugin;
  164         662  
100 174         7001 }
101              
102 174         687 unless ($self->plugin_named(':ExtraTestFiles')) {
  174         4709  
103             require Dist::Zilla::Plugin::FinderCode;
104             my $plugin = Dist::Zilla::Plugin::FinderCode->new({
105 174 50       957 plugin_name => ':ExtraTestFiles',
106 174         964 zilla => $self,
107             style => 'grep',
108             code => sub { local $_ = $_->name; m{\Axt/} },
109             });
110              
111 164     164   413 push @{ $self->plugins }, $plugin;
  164         594  
112 174         6427 }
113              
114 174         563 unless ($self->plugin_named(':ExecFiles')) {
  174         4653  
115             require Dist::Zilla::Plugin::FinderCode;
116             my $plugin = Dist::Zilla::Plugin::FinderCode->new({
117 174 50       857 plugin_name => ':ExecFiles',
118 174         898 zilla => $self,
119             style => 'list',
120             code => sub {
121             my $plugins = $_[0]->zilla->plugins_with(-ExecFiles);
122             my @files = uniq map {; @{ $_->find_files } } @$plugins;
123              
124 96     96   2790 return \@files;
125 96         485 },
  56         104  
  56         344  
126             });
127 96         634  
128             push @{ $self->plugins }, $plugin;
129 174         7064 }
130              
131 174         618 unless ($self->plugin_named(':PerlExecFiles')) {
  174         4903  
132             require Dist::Zilla::Plugin::FinderCode;
133             my $plugin = Dist::Zilla::Plugin::FinderCode->new({
134 174 50       902 plugin_name => ':PerlExecFiles',
135 174         973 zilla => $self,
136             style => 'list',
137             code => sub {
138             my $parent_plugin = $self->plugin_named(':ExecFiles');
139             my @files = grep {
140             $_->name =~ m{\.pl$}
141 1     1   7 or $_->content =~ m{^\s*\#\!.*perl\b};
142             } @{ $parent_plugin->find_files };
143 3 100       13 return \@files;
144             },
145 1         4 });
  1         7  
146 1         8  
147             push @{ $self->plugins }, $plugin;
148 174         6856 }
149              
150 174         614 unless ($self->plugin_named(':ShareFiles')) {
  174         4712  
151             require Dist::Zilla::Plugin::FinderCode;
152             my $plugin = Dist::Zilla::Plugin::FinderCode->new({
153 174 50       829 plugin_name => ':ShareFiles',
154 174         957 zilla => $self,
155             style => 'list',
156             code => sub {
157             my $self = shift;
158             my $map = $self->zilla->_share_dir_map;
159             my @files;
160 1     1   4 if ( $map->{dist} ) {
161 1         28 push @files, grep {; $_->name =~ m{\A\Q$map->{dist}\E/} }
162 1         3 @{ $self->zilla->files };
163 1 50       14 }
164 14         41 if ( my $mod_map = $map->{module} ) {
165 1         6 for my $mod ( keys %$mod_map ) {
  1         34  
166             push @files, grep { $_->name =~ m{\A\Q$mod_map->{$mod}\E/} }
167 1 50       8 @{ $self->zilla->files };
168 0         0 }
169 0         0 }
170 0         0 return \@files;
  0         0  
171             },
172             });
173 1         7  
174             push @{ $self->plugins }, $plugin;
175 174         7621 }
176              
177 174         641 unless ($self->plugin_named(':MainModule')) {
  174         4754  
178             require Dist::Zilla::Plugin::FinderCode;
179             my $plugin = Dist::Zilla::Plugin::FinderCode->new({
180 174 50       827 plugin_name => ':MainModule',
181 174         947 zilla => $self,
182             style => 'grep',
183             code => sub {
184             my ($file, $self) = @_;
185             local $_ = $file->name;
186             return 1 if $_ eq $self->zilla->main_module->name;
187 0     0   0 return;
188 0         0 },
189 0 0       0 });
190 0         0  
191             push @{ $self->plugins }, $plugin;
192 174         6855 }
193              
194 174         575 unless ($self->plugin_named(':AllFiles')) {
  174         4728  
195             require Dist::Zilla::Plugin::FinderCode;
196             my $plugin = Dist::Zilla::Plugin::FinderCode->new({
197 174 50       845 plugin_name => ':AllFiles',
198 174         960 zilla => $self,
199             style => 'grep',
200             code => sub { return 1 },
201             });
202              
203 18     18   41 push @{ $self->plugins }, $plugin;
204 174         6701 }
205              
206 174         602 unless ($self->plugin_named(':NoFiles')) {
  174         4758  
207             require Dist::Zilla::Plugin::FinderCode;
208             my $plugin = Dist::Zilla::Plugin::FinderCode->new({
209 174 50       914 plugin_name => ':NoFiles',
210 174         976 zilla => $self,
211             style => 'list',
212             code => sub { [] },
213             });
214              
215 1     1   5 push @{ $self->plugins }, $plugin;
216 174         6792 }
217             }
218 174         620  
  174         4948  
219             has _share_dir_map => (
220             is => 'ro',
221             isa => HashRef,
222             init_arg => undef,
223             lazy => 1,
224             builder => '_build_share_dir_map',
225             );
226              
227             my ($self) = @_;
228              
229             my $share_dir_map = {};
230              
231 36     36   127 for my $plugin (@{ $self->plugins_with(-ShareDir) }) {
232             next unless my $sub_map = $plugin->share_dir_map;
233 36         117  
234             if ( $sub_map->{dist} ) {
235 36         91 $self->log_fatal("can't install more than one distribution ShareDir")
  36         160  
236 21 100       146 if $share_dir_map->{dist};
237             $share_dir_map->{dist} = $sub_map->{dist};
238 10 100       45 }
239              
240 5 50       23 if ( my $mod_map = $sub_map->{module} ) {
241 5         19 for my $mod ( keys %$mod_map ) {
242             $self->log_fatal("can't install more than one ShareDir for $mod")
243             if $share_dir_map->{module}{$mod};
244 10 100       53 $share_dir_map->{module}{$mod} = $mod_map->{$mod};
245 5         25 }
246             }
247 8 50       30 }
248 8         39  
249             return $share_dir_map;
250             }
251              
252              
253 36         1140 my ($class, $arg) = @_;
254             $arg ||= {};
255              
256             my $config_class =
257             $arg->{config_class} ||= 'Dist::Zilla::MVP::Reader::Finder';
258 184     184   794  
259 184   50     744 require_module($config_class);
260              
261             $arg->{chrome}->logger->log_debug(
262 184   50     1422 { prefix => '[DZ] ' },
263             "reading configuration using $config_class"
264 184         1409 );
265              
266             my $root = $arg->{root};
267 184         12326  
268             require Dist::Zilla::MVP::Assembler::Zilla;
269             require Dist::Zilla::MVP::Section;
270             my $assembler = Dist::Zilla::MVP::Assembler::Zilla->new({
271 184         3453 chrome => $arg->{chrome},
272             zilla_class => $class,
273 184         26430 section_class => 'Dist::Zilla::MVP::Section', # make this DZMA default
274 184         26058 });
275              
276             for ($assembler->sequence->section_named('_')) {
277 184         9267 $_->add_value(chrome => $arg->{chrome});
278             $_->add_value(root => $arg->{root});
279             $_->add_value(_global_stashes => $arg->{_global_stashes})
280             if $arg->{_global_stashes};
281 184         5092 }
282 184         12690  
283 184         13735 my $seq;
284             try {
285 184 100       11429 $seq = $config_class->read_config(
286             $root->child('dist'),
287             {
288 184         1731 assembler => $assembler
289             },
290 184     184   10657 );
291             } catch {
292             die $_ unless try {
293             $_->isa('Config::MVP::Error')
294             and $_->ident eq 'package not installed'
295             };
296              
297             my $package = $_->package;
298 10 100       608 my $bundle = $_->section_name =~ m{^@(?!.*/)} ? ' bundle' : '';
299              
300 10 100   10   276 die <<"END_DIE";
301             Required plugin$bundle $package isn't installed.
302 4         104  
303 4 100       34 Run 'dzil authordeps' to see a list of all required plugins.
304             You can pipe the list to your CPAN client to install or update them:
305 4         177  
306             dzil authordeps --missing | cpanm
307              
308             END_DIE
309              
310             };
311              
312             return $seq;
313             }
314              
315 184         2812 #pod =method build_in
316             #pod
317 174         11002 #pod $zilla->build_in($root);
318             #pod
319             #pod This method builds the distribution in the given directory. If no directory
320             #pod name is given, it defaults to DistName-Version. If the distribution has
321             #pod already been built, an exception will be thrown.
322             #pod
323             #pod =method build
324             #pod
325             #pod This method just calls C<build_in> with no arguments. It gets you the default
326             #pod behavior without the weird-looking formulation of C<build_in> with no object
327             #pod for the preposition!
328             #pod
329             #pod =cut
330              
331              
332             my ($self, $root) = @_;
333              
334             $self->log_fatal("tried to build with a minter")
335             if $self->isa('Dist::Zilla::Dist::Minter');
336 128     128 1 10687  
337             $self->log_fatal("attempted to build " . $self->name . " a second time")
338             if $self->built_in;
339 149     149 1 543  
340             $_->before_build for @{ $self->plugins_with(-BeforeBuild) };
341 149 50       1990  
342             $self->log("beginning to build " . $self->name);
343              
344 149 50       6326 $_->gather_files for @{ $self->plugins_with(-FileGatherer) };
345             $_->set_file_encodings for @{ $self->plugins_with(-EncodingProvider) };
346             $_->prune_files for @{ $self->plugins_with(-FilePruner) };
347 149         409  
  149         1069  
348             $self->version; # instantiate this lazy attribute now that files are gathered
349 149         5027  
350             $_->munge_files for @{ $self->plugins_with(-FileMunger) };
351 149         55609  
  149         754  
352 148         597 $_->register_prereqs for @{ $self->plugins_with(-PrereqSource) };
  148         813  
353 148         679  
  148         638  
354             $self->prereqs->finalize;
355 148         4852  
356             # Barf if someone has already set up a prereqs entry? -- rjbs, 2010-04-13
357 148         522 $self->distmeta->{prereqs} = $self->prereqs->as_string_hash;
  148         658  
358              
359 146         2338 $_->setup_installer for @{ $self->plugins_with(-InstallTool) };
  146         666  
360              
361 146         4605 $self->_check_dupe_files;
362              
363             my $build_root = $self->_prep_build_root($root);
364 146         11162  
365             $self->log("writing " . $self->name . " in $build_root");
366 145         388  
  145         739  
367             for my $file (@{ $self->files }) {
368 144         1143 $self->_write_out_file($file, $build_root);
369             }
370 144         943  
371             $_->after_build({ build_root => $build_root })
372 144         4902 for @{ $self->plugins_with(-AfterBuild) };
373              
374 144         51103 $self->built_in($build_root);
  144         4475  
375 632         17108 }
376              
377             #pod =attr built_in
378             #pod
379 144         4527 #pod This is the L<Path::Tiny>, if any, in which the dist has been built.
  144         862  
380             #pod
381 144         5955 #pod =cut
382              
383             has built_in => (
384             is => 'rw',
385             isa => Path,
386             init_arg => undef,
387             coerce => 1,
388             );
389              
390             #pod =method ensure_built_in
391             #pod
392             #pod $zilla->ensure_built_in($root);
393             #pod
394             #pod This method behaves like C<L</build_in>>, but if the dist is already built in
395             #pod C<$root> (or the default root, if no root is given), no exception is raised.
396             #pod
397             #pod =method ensure_built
398             #pod
399             #pod This method just calls C<ensure_built_in> with no arguments. It gets you the
400             #pod default behavior without the weird-looking formulation of C<ensure_built_in>
401             #pod with no object for the preposition!
402             #pod
403             #pod =cut
404              
405             $_[0]->ensure_built_in;
406             }
407              
408             my ($self, $root) = @_;
409              
410             # $root ||= $self->name . q{-} . $self->version;
411             return $self->built_in if $self->built_in and
412             (!$root or ($self->built_in eq $root));
413 23     23 1 197  
414             Carp::croak("dist is already built, but not in $root") if $self->built_in;
415             $self->build_in($root);
416             }
417 24     24 1 84  
418             #pod =method dist_basename
419             #pod
420 24 50 33     940 #pod my $basename = $zilla->dist_basename;
      66        
421             #pod
422             #pod This method will return the dist's basename (e.g. C<Dist-Name-1.01>.
423 21 50       610 #pod The basename is used as the top-level directory in the tarball. It
424 21         183 #pod does not include C<-TRIAL>, even if building a trial dist.
425             #pod
426             #pod =cut
427              
428             my ($self) = @_;
429             return join(q{},
430             $self->name,
431             '-',
432             $self->version,
433             );
434             }
435              
436             #pod =method archive_basename
437             #pod
438 57     57 1 2216 #pod my $basename = $zilla->archive_basename;
439 57         2057 #pod
440             #pod This method will return the filename, without the format extension
441             #pod (e.g. C<Dist-Name-1.01> or C<Dist-Name-1.01-TRIAL>).
442             #pod
443             #pod =cut
444              
445             my ($self) = @_;
446             return join q{},
447             $self->dist_basename,
448             ( $self->is_trial && $self->version !~ /_/ ? '-TRIAL' : '' ),
449             ;
450             }
451              
452             #pod =method archive_filename
453             #pod
454             #pod my $tarball = $zilla->archive_filename;
455             #pod
456 31     31 1 166 #pod This method will return the filename (e.g. C<Dist-Name-1.01.tar.gz>)
457 31 100 100     269 #pod of the tarball of this distribution. It will include C<-TRIAL> if building a
458             #pod trial distribution, unless the version contains an underscore. The tarball
459             #pod might not exist.
460             #pod
461             #pod =cut
462              
463             my ($self) = @_;
464             return join q{}, $self->archive_basename, '.tar.gz';
465             }
466              
467             #pod =method build_archive
468             #pod
469             #pod $zilla->build_archive;
470             #pod
471             #pod This method will ensure that the dist has been built, and will then build a
472             #pod tarball of the build directory in the current directory.
473             #pod
474             #pod =cut
475 30     30 1 168  
476 30         351 my ($self) = @_;
477              
478             my $built_in = $self->ensure_built;
479              
480             my $basedir = path($self->dist_basename);
481              
482             $_->before_archive for $self->plugins_with(-BeforeArchive)->@*;
483              
484             for my $builder ($self->plugins_with(-ArchiveBuilder)->@*) {
485             my $file = $builder->build_archive($self->archive_basename, $built_in, $basedir);
486             return $file if defined $file;
487             }
488              
489 23     23 1 183 my $method = eval { +require Archive::Tar::Wrapper;
490             Archive::Tar::Wrapper->VERSION('0.15'); 1 }
491 23         144 ? '_build_archive_with_wrapper'
492             : '_build_archive';
493 23         764  
494             my $archive = $self->$method($built_in, $basedir);
495 23         1075  
496             my $file = path($self->archive_filename);
497 23         131  
498 1         10 $self->log("writing archive to $file");
499 1 50       648 $archive->write("$file", 9);
500              
501             return $file;
502 22 50       92 }
  22         3952  
503 22         560070  
  22         228  
504             my ($self, $built_in, $basedir) = @_;
505              
506             $self->log("building archive with Archive::Tar; install Archive::Tar::Wrapper 0.15 or newer for improved speed");
507 22         220  
508             require Archive::Tar;
509 22         490 my $archive = Archive::Tar->new;
510             my %seen_dir;
511 22         1180 for my $distfile (
512 22         14303 sort { length($a->name) <=> length($b->name) } @{ $self->files }
513             ) {
514 22         345710 my $in = path($distfile->name)->parent;
515              
516             unless ($seen_dir{ $in }++) {
517             $archive->add_data(
518 0     0   0 $basedir->child($in),
519             '',
520 0         0 { type => Archive::Tar::Constant::DIR(), mode => 0755 },
521             )
522 0         0 }
523 0         0  
524 0         0 my $filename = $built_in->child( $distfile->name );
525 0         0 $archive->add_data(
526 0         0 $basedir->child( $distfile->name ),
  0         0  
527             path($filename)->slurp_raw,
528 0         0 { mode => (stat $filename)[2] & ~022 },
529             );
530 0 0       0 }
531 0         0  
532             return $archive;
533             }
534              
535             my ($self, $built_in, $basedir) = @_;
536              
537             $self->log("building archive with Archive::Tar::Wrapper");
538 0         0  
539 0         0 my $archive = Archive::Tar::Wrapper->new;
540              
541             for my $distfile (
542             sort { length($a->name) <=> length($b->name) } @{ $self->files }
543             ) {
544             my $in = path($distfile->name)->parent;
545              
546 0         0 my $filename = $built_in->child( $distfile->name );
547             $archive->add(
548             $basedir->child( $distfile->name )->stringify,
549             $filename->stringify,
550 22     22   164 { perm => (stat $filename)[2] & ~022 },
551             );
552 22         182 }
553              
554 22         7059 return $archive;
555             }
556 22         245272  
557 107         899 my ($self, $build_root) = @_;
  22         2059  
558              
559 82         47934 $build_root = path($build_root || $self->dist_basename);
560              
561 82         11559 $build_root->mkpath unless -d $build_root;
562 82         3539  
563             my $dist_root = $self->root;
564              
565             return $build_root if !-d $build_root;
566              
567             my $ok = eval { $build_root->remove_tree({ safe => 0 }); 1 };
568             die "unable to delete '$build_root' in preparation of build: $@" unless $ok;
569 22         21784  
570             # the following is done only on windows, and only if the deletion failed,
571             # yet rmtree reported success, because currently rmdir is non-blocking as per:
572             # https://rt.perl.org/Ticket/Display.html?id=123958
573 144     144   679 if ( $^O eq 'MSWin32' and -d $build_root ) {
574             $self->log("spinning for at least one second to allow other processes to release locks on $build_root");
575 144   66     1463 my $timeout = time + 2;
576             while(time != $timeout and -d $build_root) { }
577 144 100       9090 die "unable to delete '$build_root' in preparation of build because some process has a lock on it"
578             if -d $build_root;
579 144         9863 }
580              
581 144 50       634 return $build_root;
582             }
583 144         3133  
  144         1614  
  144         61425  
584 144 50       695 #pod =method release
585             #pod
586             #pod $zilla->release;
587             #pod
588             #pod This method releases the distribution, probably by uploading it to the CPAN.
589 144 50 33     1044 #pod The actual effects of this method (as with most of the methods) is determined
590 0         0 #pod by the loaded plugins.
591 0         0 #pod
592 0   0     0 #pod =cut
593 0 0       0  
594             my $self = shift;
595              
596             Carp::croak("you can't release without any Releaser plugins")
597 144         455 unless my @releasers = @{ $self->plugins_with(-Releaser) };
598              
599             $ENV{DZIL_RELEASING} = 1;
600              
601             my $tgz = $self->build_archive;
602              
603             # call all plugins implementing BeforeRelease role
604             $_->before_release($tgz) for @{ $self->plugins_with(-BeforeRelease) };
605              
606             # do the actual release
607             $_->release($tgz) for @releasers;
608              
609             # call all plugins implementing AfterRelease role
610             $_->after_release($tgz) for @{ $self->plugins_with(-AfterRelease) };
611 21     21 1 67 }
612              
613             #pod =method clean
614 21 50       61 #pod
  21         138  
615             #pod This method removes temporary files and directories suspected to have been
616 21         271 #pod produced by the Dist::Zilla build process. Specifically, it deletes the
617             #pod F<.build> directory and any entity that starts with the dist name and a hyphen,
618 21         150 #pod like matching the glob C<Your-Dist-*>.
619             #pod
620             #pod =cut
621 21         37412  
  21         513  
622             my ($self, $dry_run) = @_;
623              
624 13         5396 require File::Path;
625             for my $x (grep { -e } '.build', glob($self->name . '-*')) {
626             if ($dry_run) {
627 11         4578 $self->log("clean: would remove $x");
  11         136  
628             } else {
629             $self->log("clean: removing $x");
630             File::Path::rmtree($x);
631             }
632             };
633             }
634              
635             #pod =method ensure_built_in_tmpdir
636             #pod
637             #pod $zilla->ensure_built_in_tmpdir;
638             #pod
639             #pod This method will consistently build the distribution in a temporary
640 0     0 1 0 #pod subdirectory. It will return the path for the temporary build location.
641             #pod
642 0         0 #pod =cut
643 0         0  
  0         0  
644 0 0       0 my $self = shift;
645 0         0  
646             require File::Temp;
647 0         0  
648 0         0 my $build_root = path('.build');
649             $build_root->mkpath unless -d $build_root;
650              
651             my $target = path( File::Temp::tempdir(DIR => $build_root) );
652             $self->log("building distribution under $target for installation");
653              
654             my $os_has_symlinks = eval { symlink("",""); 1 };
655             my $previous;
656             my $latest;
657              
658             if( $os_has_symlinks ) {
659             $previous = path( $build_root, 'previous' );
660             $latest = path( $build_root, 'latest' );
661             if( -l $previous ) {
662             $previous->remove
663 1     1 1 13 or $self->log("cannot remove old .build/previous link");
664             }
665 1         12 if( -l $latest ) {
666             rename $latest, $previous
667 1         14 or $self->log("cannot move .build/latest link to .build/previous");
668 1 50       81 }
669             symlink $target->basename, $latest
670 1         324 or $self->log('cannot create link .build/latest');
671 1         44 }
672              
673 1         353 $self->ensure_built_in($target);
  1         13  
  1         8  
674 1         11  
675             return ($target, $latest, $previous);
676             }
677 1 50       6  
678 1         21 #pod =method install
679 1         61 #pod
680 1 50       52 #pod $zilla->install( \%arg );
681 0 0       0 #pod
682             #pod This method installs the distribution locally. The distribution will be built
683             #pod in a temporary subdirectory, then the process will change directory to that
684 1 50       29 #pod subdir and an installer will be run.
685 0 0       0 #pod
686             #pod Valid arguments are:
687             #pod
688 1 50       27 #pod keep_build_dir - if true, don't rmtree the build dir, even if everything
689             #pod seemed to work
690             #pod install_command - the command to run in the subdir to install the dist
691             #pod default (roughly): $^X -MCPAN -einstall .
692 1         87 #pod
693             #pod this argument should be an arrayref
694 1         36 #pod
695             #pod =cut
696              
697             my ($self, $arg) = @_;
698             $arg ||= {};
699              
700             my ($target, $latest) = $self->ensure_built_in_tmpdir;
701              
702             my $ok = eval {
703             ## no critic Punctuation
704             my $wd = File::pushd::pushd($target);
705             my @cmd = $arg->{install_command}
706             ? @{ $arg->{install_command} }
707             : (cpanm => ".");
708              
709             $self->log_debug([ 'installing via %s', \@cmd ]);
710             system(@cmd) && $self->log_fatal([ "error running %s", \@cmd ]);
711             1;
712             };
713              
714             unless ($ok) {
715             my $error = $@ || '(exception clobered)';
716             $self->log("install failed, left failed dist in place at $target");
717 0     0 1 0 die $error;
718 0   0     0 }
719              
720 0         0 if ($arg->{keep_build_dir}) {
721             $self->log("all's well; left dist in place at $target");
722 0         0 } else {
723             $self->log("all's well; removing $target");
724 0         0 $target->remove_tree({ safe => 0 });
725             $latest->remove if $latest;
726 0 0       0 }
  0         0  
727              
728             return;
729 0         0 }
730 0 0       0  
731 0         0 #pod =method test
732             #pod
733             #pod $zilla->test(\%arg);
734 0 0       0 #pod
735 0   0     0 #pod This method builds a new copy of the distribution and tests it using
736 0         0 #pod C<L</run_tests_in>>.
737 0         0 #pod
738             #pod C<\%arg> may be omitted. Otherwise, valid arguments are:
739             #pod
740 0 0       0 #pod keep_build_dir - if true, don't rmtree the build dir, even if everything
741 0         0 #pod seemed to work
742             #pod
743 0         0 #pod =cut
744 0         0  
745 0 0       0 my ($self, $arg) = @_;
746              
747             Carp::croak("you can't test without any TestRunner plugins")
748 0         0 unless my @testers = @{ $self->plugins_with(-TestRunner) };
749              
750             my ($target, $latest) = $self->ensure_built_in_tmpdir;
751             my $error = $self->run_tests_in($target, $arg);
752              
753             if ($arg and $arg->{keep_build_dir}) {
754             $self->log("all's well; left dist in place at $target");
755             return;
756             }
757              
758             $self->log("all's well; removing $target");
759             $target->remove_tree({ safe => 0 });
760             $latest->remove if $latest;
761             }
762              
763             #pod =method run_tests_in
764             #pod
765             #pod my $error = $zilla->run_tests_in($directory, $arg);
766 1     1 1 15 #pod
767             #pod This method runs the tests in $directory (a Path::Tiny), which must contain an
768             #pod already-built copy of the distribution. It will throw an exception if there
769 1 50       4 #pod are test failures.
  1         18  
770             #pod
771 1         38 #pod It does I<not> set any of the C<*_TESTING> environment variables, nor
772 1         25 #pod does it clean up C<$directory> afterwards.
773             #pod
774 1 0 33     116 #pod =cut
775 0         0  
776 0         0 my ($self, $target, $arg) = @_;
777              
778             Carp::croak("you can't test without any TestRunner plugins")
779 1         29 unless my @testers = @{ $self->plugins_with(-TestRunner) };
780 1         762  
781 1 50       3700 for my $tester (@testers) {
782             my $wd = File::pushd::pushd($target);
783             $tester->test( $target, $arg );
784             }
785             }
786              
787             #pod =method run_in_build
788             #pod
789             #pod $zilla->run_in_build( \@cmd );
790             #pod
791             #pod This method makes a temporary directory, builds the distribution there,
792             #pod executes all the dist's L<BuildRunner|Dist::Zilla::Role::BuildRunner>s
793             #pod (unless directed not to, via C<< $arg->{build} = 0 >>), and
794             #pod then runs the given command in the build directory. If the command exits
795             #pod non-zero, the directory will be left in place.
796             #pod
797             #pod =cut
798 2     2 1 25  
799             my ($self, $cmd, $arg) = @_;
800              
801 2 50       16 $self->log_fatal("you can't build without any BuildRunner plugins")
  2         41  
802             unless ($arg and exists $arg->{build} and ! $arg->{build})
803 2         18 or @{ $self->plugins_with(-BuildRunner) };
804 2         31  
805 2         436 require "Config.pm"; # skip autoprereq
806              
807             my ($target, $latest) = $self->ensure_built_in_tmpdir;
808             my $abstarget = $target->absolute;
809              
810             # building the dist for real
811             my $ok = eval {
812             my $wd = File::pushd::pushd($target);
813              
814             if ($arg and exists $arg->{build} and ! $arg->{build}) {
815             system(@$cmd) and die "error while running: @$cmd";
816             return 1;
817             }
818              
819             $self->_ensure_blib;
820              
821             local $ENV{PERL5LIB} = join $Config::Config{path_sep},
822 0     0 1   (map { $abstarget->child('blib', $_) } qw(arch lib)),
823             (defined $ENV{PERL5LIB} ? $ENV{PERL5LIB} : ());
824              
825             local $ENV{PATH} = join $Config::Config{path_sep},
826 0 0 0       (map { $abstarget->child('blib', $_) } qw(bin script)),
  0   0        
      0        
827             (defined $ENV{PATH} ? $ENV{PATH} : ());
828 0            
829             system(@$cmd) and die "error while running: @$cmd";
830 0           1;
831 0           };
832              
833             if ($ok) {
834 0           $self->log("all's well; removing $target");
835 0           $target->remove_tree({ safe => 0 });
836             $latest->remove if $latest;
837 0 0 0       } else {
      0        
838 0 0         my $error = $@ || '(unknown error)';
839 0           $self->log($error);
840             $self->log_fatal("left failed dist in place at $target");
841             }
842 0           }
843              
844             # Ensures that a F<blib> directory exists in the build, by invoking all
845 0           # C<-BuildRunner> plugins to generate it. Useful for commands that operate on
846 0 0         # F<blib>, such as C<test> or C<run>.
847              
848             my ($self) = @_;
849 0            
850 0 0         unless ( -d 'blib' ) {
851             my @builders = @{ $self->plugins_with( -BuildRunner ) };
852 0 0         $self->log_fatal("no BuildRunner plugins specified") unless @builders;
853 0           $_->build for @builders;
854             $self->log_fatal("no blib; failed to build properly?") unless -d 'blib';
855             }
856 0 0         }
857 0            
858 0           __PACKAGE__->meta->make_immutable;
859 0 0         1;
860              
861 0   0        
862 0           =pod
863 0            
864             =encoding UTF-8
865              
866             =head1 NAME
867              
868             Dist::Zilla::Dist::Builder - dist zilla subclass for building dists
869              
870             =head1 VERSION
871              
872 0     0     version 6.028
873              
874 0 0         =head1 PERL VERSION
875 0            
  0            
876 0 0         This module should work on any version of perl still receiving updates from
877 0           the Perl 5 Porters. This means it should work on any version of perl released
878 0 0         in the last two to three years. (That is, if the most recently released
879             version is v5.40, then this module should work on both v5.40 and v5.38.)
880              
881             Although it may work on older versions of perl, no guarantee is made that the
882             minimum required version will not be increased. The version may be increased
883             for any reason, and there is no promise that patches will be accepted to lower
884             the minimum required perl.
885              
886             =head1 ATTRIBUTES
887              
888             =head2 built_in
889              
890             This is the L<Path::Tiny>, if any, in which the dist has been built.
891              
892             =head1 METHODS
893              
894             =head2 from_config
895              
896             my $zilla = Dist::Zilla->from_config(\%arg);
897              
898             This routine returns a new Zilla from the configuration in the current working
899             directory.
900              
901             This method should not be relied upon, yet. Its semantics are B<certain> to
902             change.
903              
904             Valid arguments are:
905              
906             config_class - the class to use to read the config
907             default: Dist::Zilla::MVP::Reader::Finder
908              
909             =head2 build_in
910              
911             $zilla->build_in($root);
912              
913             This method builds the distribution in the given directory. If no directory
914             name is given, it defaults to DistName-Version. If the distribution has
915             already been built, an exception will be thrown.
916              
917             =head2 build
918              
919             This method just calls C<build_in> with no arguments. It gets you the default
920             behavior without the weird-looking formulation of C<build_in> with no object
921             for the preposition!
922              
923             =head2 ensure_built_in
924              
925             $zilla->ensure_built_in($root);
926              
927             This method behaves like C<L</build_in>>, but if the dist is already built in
928             C<$root> (or the default root, if no root is given), no exception is raised.
929              
930             =head2 ensure_built
931              
932             This method just calls C<ensure_built_in> with no arguments. It gets you the
933             default behavior without the weird-looking formulation of C<ensure_built_in>
934             with no object for the preposition!
935              
936             =head2 dist_basename
937              
938             my $basename = $zilla->dist_basename;
939              
940             This method will return the dist's basename (e.g. C<Dist-Name-1.01>.
941             The basename is used as the top-level directory in the tarball. It
942             does not include C<-TRIAL>, even if building a trial dist.
943              
944             =head2 archive_basename
945              
946             my $basename = $zilla->archive_basename;
947              
948             This method will return the filename, without the format extension
949             (e.g. C<Dist-Name-1.01> or C<Dist-Name-1.01-TRIAL>).
950              
951             =head2 archive_filename
952              
953             my $tarball = $zilla->archive_filename;
954              
955             This method will return the filename (e.g. C<Dist-Name-1.01.tar.gz>)
956             of the tarball of this distribution. It will include C<-TRIAL> if building a
957             trial distribution, unless the version contains an underscore. The tarball
958             might not exist.
959              
960             =head2 build_archive
961              
962             $zilla->build_archive;
963              
964             This method will ensure that the dist has been built, and will then build a
965             tarball of the build directory in the current directory.
966              
967             =head2 release
968              
969             $zilla->release;
970              
971             This method releases the distribution, probably by uploading it to the CPAN.
972             The actual effects of this method (as with most of the methods) is determined
973             by the loaded plugins.
974              
975             =head2 clean
976              
977             This method removes temporary files and directories suspected to have been
978             produced by the Dist::Zilla build process. Specifically, it deletes the
979             F<.build> directory and any entity that starts with the dist name and a hyphen,
980             like matching the glob C<Your-Dist-*>.
981              
982             =head2 ensure_built_in_tmpdir
983              
984             $zilla->ensure_built_in_tmpdir;
985              
986             This method will consistently build the distribution in a temporary
987             subdirectory. It will return the path for the temporary build location.
988              
989             =head2 install
990              
991             $zilla->install( \%arg );
992              
993             This method installs the distribution locally. The distribution will be built
994             in a temporary subdirectory, then the process will change directory to that
995             subdir and an installer will be run.
996              
997             Valid arguments are:
998              
999             keep_build_dir - if true, don't rmtree the build dir, even if everything
1000             seemed to work
1001             install_command - the command to run in the subdir to install the dist
1002             default (roughly): $^X -MCPAN -einstall .
1003              
1004             this argument should be an arrayref
1005              
1006             =head2 test
1007              
1008             $zilla->test(\%arg);
1009              
1010             This method builds a new copy of the distribution and tests it using
1011             C<L</run_tests_in>>.
1012              
1013             C<\%arg> may be omitted. Otherwise, valid arguments are:
1014              
1015             keep_build_dir - if true, don't rmtree the build dir, even if everything
1016             seemed to work
1017              
1018             =head2 run_tests_in
1019              
1020             my $error = $zilla->run_tests_in($directory, $arg);
1021              
1022             This method runs the tests in $directory (a Path::Tiny), which must contain an
1023             already-built copy of the distribution. It will throw an exception if there
1024             are test failures.
1025              
1026             It does I<not> set any of the C<*_TESTING> environment variables, nor
1027             does it clean up C<$directory> afterwards.
1028              
1029             =head2 run_in_build
1030              
1031             $zilla->run_in_build( \@cmd );
1032              
1033             This method makes a temporary directory, builds the distribution there,
1034             executes all the dist's L<BuildRunner|Dist::Zilla::Role::BuildRunner>s
1035             (unless directed not to, via C<< $arg->{build} = 0 >>), and
1036             then runs the given command in the build directory. If the command exits
1037             non-zero, the directory will be left in place.
1038              
1039             =head1 AUTHOR
1040              
1041             Ricardo SIGNES 😏 <cpan@semiotic.systems>
1042              
1043             =head1 COPYRIGHT AND LICENSE
1044              
1045             This software is copyright (c) 2022 by Ricardo SIGNES.
1046              
1047             This is free software; you can redistribute it and/or modify it under
1048             the same terms as the Perl 5 programming language system itself.
1049              
1050             =cut