File Coverage

blib/lib/Dist/Zilla/Dist/Builder.pm
Criterion Covered Total %
statement 279 371 75.2
branch 57 140 40.7
condition 19 56 33.9
subroutine 39 45 86.6
pod 16 16 100.0
total 410 628 65.2


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