sub
from_config {
my
(
$class
,
$arg
) =
@_
;
$arg
||= {};
my
$root
= path(
$arg
->{dist_root} ||
'.'
);
my
$sequence
=
$class
->_load_config({
root
=>
$root
,
chrome
=>
$arg
->{chrome},
config_class
=>
$arg
->{config_class},
_global_stashes
=>
$arg
->{_global_stashes},
});
my
$self
=
$sequence
->section_named(
'_'
)->zilla;
$self
->_setup_default_plugins;
return
$self
;
}
sub
_setup_default_plugins {
my
(
$self
) =
@_
;
unless
(
$self
->plugin_named(
':InstallModules'
)) {
my
$plugin
= Dist::Zilla::Plugin::FinderCode->new({
plugin_name
=>
':InstallModules'
,
zilla
=>
$self
,
style
=>
'grep'
,
code
=>
sub
{
my
(
$file
,
$self
) =
@_
;
local
$_
=
$file
->name;
return
1
if
m{\Alib/} and m{\.(pm|pod)$};
return
;
},
});
push
@{
$self
->plugins },
$plugin
;
}
unless
(
$self
->plugin_named(
':IncModules'
)) {
my
$plugin
= Dist::Zilla::Plugin::FinderCode->new({
plugin_name
=>
':IncModules'
,
zilla
=>
$self
,
style
=>
'grep'
,
code
=>
sub
{
my
(
$file
,
$self
) =
@_
;
local
$_
=
$file
->name;
return
1
if
m{\Ainc/} and m{\.pm$};
return
;
},
});
push
@{
$self
->plugins },
$plugin
;
}
unless
(
$self
->plugin_named(
':TestFiles'
)) {
my
$plugin
= Dist::Zilla::Plugin::FinderCode->new({
plugin_name
=>
':TestFiles'
,
zilla
=>
$self
,
style
=>
'grep'
,
code
=>
sub
{
local
$_
=
$_
->name; m{\At/} },
});
push
@{
$self
->plugins },
$plugin
;
}
unless
(
$self
->plugin_named(
':ExtraTestFiles'
)) {
my
$plugin
= Dist::Zilla::Plugin::FinderCode->new({
plugin_name
=>
':ExtraTestFiles'
,
zilla
=>
$self
,
style
=>
'grep'
,
code
=>
sub
{
local
$_
=
$_
->name; m{\Axt/} },
});
push
@{
$self
->plugins },
$plugin
;
}
unless
(
$self
->plugin_named(
':ExecFiles'
)) {
my
$plugin
= Dist::Zilla::Plugin::FinderCode->new({
plugin_name
=>
':ExecFiles'
,
zilla
=>
$self
,
style
=>
'list'
,
code
=>
sub
{
my
$plugins
=
$_
[0]->zilla->plugins_with(-ExecFiles);
my
@files
= uniq
map
{; @{
$_
->find_files } }
@$plugins
;
return
\
@files
;
},
});
push
@{
$self
->plugins },
$plugin
;
}
unless
(
$self
->plugin_named(
':PerlExecFiles'
)) {
my
$plugin
= Dist::Zilla::Plugin::FinderCode->new({
plugin_name
=>
':PerlExecFiles'
,
zilla
=>
$self
,
style
=>
'list'
,
code
=>
sub
{
my
$parent_plugin
=
$self
->plugin_named(
':ExecFiles'
);
my
@files
=
grep
{
$_
->name =~ m{\.pl$}
or
$_
->content =~ m{^\s*\
} @{
$parent_plugin
->find_files };
return
\
@files
;
},
});
push
@{
$self
->plugins },
$plugin
;
}
unless
(
$self
->plugin_named(
':ShareFiles'
)) {
my
$plugin
= Dist::Zilla::Plugin::FinderCode->new({
plugin_name
=>
':ShareFiles'
,
zilla
=>
$self
,
style
=>
'list'
,
code
=>
sub
{
my
$self
=
shift
;
my
$map
=
$self
->zilla->_share_dir_map;
my
@files
;
if
(
$map
->{dist} ) {
push
@files
,
grep
{;
$_
->name =~ m{\A\Q
$map
->{dist}\E/} }
@{
$self
->zilla->files };
}
if
(
my
$mod_map
=
$map
->{module} ) {
for
my
$mod
(
keys
%$mod_map
) {
push
@files
,
grep
{
$_
->name =~ m{\A\Q
$mod_map
->{
$mod
}\E/} }
@{
$self
->zilla->files };
}
}
return
\
@files
;
},
});
push
@{
$self
->plugins },
$plugin
;
}
unless
(
$self
->plugin_named(
':MainModule'
)) {
my
$plugin
= Dist::Zilla::Plugin::FinderCode->new({
plugin_name
=>
':MainModule'
,
zilla
=>
$self
,
style
=>
'grep'
,
code
=>
sub
{
my
(
$file
,
$self
) =
@_
;
local
$_
=
$file
->name;
return
1
if
$_
eq
$self
->zilla->main_module->name;
return
;
},
});
push
@{
$self
->plugins },
$plugin
;
}
unless
(
$self
->plugin_named(
':AllFiles'
)) {
my
$plugin
= Dist::Zilla::Plugin::FinderCode->new({
plugin_name
=>
':AllFiles'
,
zilla
=>
$self
,
style
=>
'grep'
,
code
=>
sub
{
return
1 },
});
push
@{
$self
->plugins },
$plugin
;
}
unless
(
$self
->plugin_named(
':NoFiles'
)) {
my
$plugin
= Dist::Zilla::Plugin::FinderCode->new({
plugin_name
=>
':NoFiles'
,
zilla
=>
$self
,
style
=>
'list'
,
code
=>
sub
{ [] },
});
push
@{
$self
->plugins },
$plugin
;
}
}
has
_share_dir_map
=> (
is
=>
'ro'
,
isa
=> HashRef,
init_arg
=>
undef
,
lazy
=> 1,
builder
=>
'_build_share_dir_map'
,
);
sub
_build_share_dir_map {
my
(
$self
) =
@_
;
my
$share_dir_map
= {};
for
my
$plugin
(@{
$self
->plugins_with(-ShareDir) }) {
next
unless
my
$sub_map
=
$plugin
->share_dir_map;
if
(
$sub_map
->{dist} ) {
$self
->log_fatal(
"can't install more than one distribution ShareDir"
)
if
$share_dir_map
->{dist};
$share_dir_map
->{dist} =
$sub_map
->{dist};
}
if
(
my
$mod_map
=
$sub_map
->{module} ) {
for
my
$mod
(
keys
%$mod_map
) {
$self
->log_fatal(
"can't install more than one ShareDir for $mod"
)
if
$share_dir_map
->{module}{
$mod
};
$share_dir_map
->{module}{
$mod
} =
$mod_map
->{
$mod
};
}
}
}
return
$share_dir_map
;
}
sub
_load_config {
my
(
$class
,
$arg
) =
@_
;
$arg
||= {};
my
$config_class
=
$arg
->{config_class} ||=
'Dist::Zilla::MVP::Reader::Finder'
;
require_module(
$config_class
);
$arg
->{chrome}->logger->log_debug(
{
prefix
=>
'[DZ] '
},
"reading configuration using $config_class"
);
my
$root
=
$arg
->{root};
my
$assembler
= Dist::Zilla::MVP::Assembler::Zilla->new({
chrome
=>
$arg
->{chrome},
zilla_class
=>
$class
,
section_class
=>
'Dist::Zilla::MVP::Section'
,
});
for
(
$assembler
->sequence->section_named(
'_'
)) {
$_
->add_value(
chrome
=>
$arg
->{chrome});
$_
->add_value(
root
=>
$arg
->{root});
$_
->add_value(
_global_stashes
=>
$arg
->{_global_stashes})
if
$arg
->{_global_stashes};
}
my
$seq
;
try
{
$seq
=
$config_class
->read_config(
$root
->child(
'dist'
),
{
assembler
=>
$assembler
},
);
}
catch
{
die
$_
unless
try
{
$_
->isa(
'Config::MVP::Error'
)
and
$_
->ident eq
'package not installed'
};
my
$package
=
$_
->
package
;
my
$bundle
=
$_
->section_name =~ m{^@(?!.*/)} ?
' bundle'
:
''
;
die
<<"END_DIE";
Required plugin$bundle $package isn't installed.
Run 'dzil authordeps' to see a list of all required plugins.
You can pipe the list to your CPAN client to install or update them:
dzil authordeps --missing | cpanm
END_DIE
};
return
$seq
;
}
sub
build {
$_
[0]->build_in }
sub
build_in {
my
(
$self
,
$root
) =
@_
;
$self
->log_fatal(
"tried to build with a minter"
)
if
$self
->isa(
'Dist::Zilla::Dist::Minter'
);
$self
->log_fatal(
"attempted to build "
.
$self
->name .
" a second time"
)
if
$self
->built_in;
$_
->before_build
for
@{
$self
->plugins_with(-BeforeBuild) };
$self
->
log
(
"beginning to build "
.
$self
->name);
$_
->gather_files
for
@{
$self
->plugins_with(-FileGatherer) };
$_
->set_file_encodings
for
@{
$self
->plugins_with(-EncodingProvider) };
$_
->prune_files
for
@{
$self
->plugins_with(-FilePruner) };
$self
->version;
$_
->munge_files
for
@{
$self
->plugins_with(-FileMunger) };
$_
->register_prereqs
for
@{
$self
->plugins_with(-PrereqSource) };
$self
->prereqs->finalize;
$self
->distmeta->{prereqs} =
$self
->prereqs->as_string_hash;
$_
->setup_installer
for
@{
$self
->plugins_with(-InstallTool) };
$self
->_check_dupe_files;
my
$build_root
=
$self
->_prep_build_root(
$root
);
$self
->
log
(
"writing "
.
$self
->name .
" in $build_root"
);
for
my
$file
(@{
$self
->files }) {
$self
->_write_out_file(
$file
,
$build_root
);
}
$_
->after_build({
build_root
=>
$build_root
})
for
@{
$self
->plugins_with(-AfterBuild) };
$self
->built_in(
$build_root
);
}
has
built_in
=> (
is
=>
'rw'
,
isa
=> Path,
init_arg
=>
undef
,
coerce
=> 1,
);
sub
ensure_built {
$_
[0]->ensure_built_in;
}
sub
ensure_built_in {
my
(
$self
,
$root
) =
@_
;
return
$self
->built_in
if
$self
->built_in and
(!
$root
or (
$self
->built_in eq
$root
));
Carp::croak(
"dist is already built, but not in $root"
)
if
$self
->built_in;
$self
->build_in(
$root
);
}
sub
dist_basename {
my
(
$self
) =
@_
;
return
join
(
q{}
,
$self
->name,
'-'
,
$self
->version,
);
}
sub
archive_basename {
my
(
$self
) =
@_
;
return
join
q{}
,
$self
->dist_basename,
(
$self
->is_trial &&
$self
->version !~ /_/ ?
'-TRIAL'
:
''
),
;
}
sub
archive_filename {
my
(
$self
) =
@_
;
return
join
q{}
,
$self
->archive_basename,
'.tar.gz'
;
}
sub
build_archive {
my
(
$self
) =
@_
;
my
$built_in
=
$self
->ensure_built;
my
$basedir
= path(
$self
->dist_basename);
$_
->before_archive
for
$self
->plugins_with(-BeforeArchive)->@*;
for
my
$builder
(
$self
->plugins_with(-ArchiveBuilder)->@*) {
my
$file
=
$builder
->build_archive(
$self
->archive_basename,
$built_in
,
$basedir
);
return
$file
if
defined
$file
;
}
Archive::Tar::Wrapper->VERSION(
'0.15'
); 1 }
?
'_build_archive_with_wrapper'
:
'_build_archive'
;
my
$archive
=
$self
->
$method
(
$built_in
,
$basedir
);
my
$file
= path(
$self
->archive_filename);
$self
->
log
(
"writing archive to $file"
);
$archive
->
write
(
"$file"
, 9);
return
$file
;
}
sub
_build_archive {
my
(
$self
,
$built_in
,
$basedir
) =
@_
;
$self
->
log
(
"building archive with Archive::Tar; install Archive::Tar::Wrapper 0.15 or newer for improved speed"
);
my
$archive
= Archive::Tar->new;
my
%seen_dir
;
for
my
$distfile
(
sort
{
length
(
$a
->name) <=>
length
(
$b
->name) } @{
$self
->files }
) {
my
$in
= path(
$distfile
->name)->parent;
unless
(
$seen_dir
{
$in
}++) {
$archive
->add_data(
$basedir
->child(
$in
),
''
,
{
type
=> Archive::Tar::Constant::DIR(),
mode
=> 0755 },
)
}
my
$filename
=
$built_in
->child(
$distfile
->name );
$archive
->add_data(
$basedir
->child(
$distfile
->name ),
path(
$filename
)->slurp_raw,
{
mode
=> (
stat
$filename
)[2] & ~022 },
);
}
return
$archive
;
}
sub
_build_archive_with_wrapper {
my
(
$self
,
$built_in
,
$basedir
) =
@_
;
$self
->
log
(
"building archive with Archive::Tar::Wrapper"
);
my
$archive
= Archive::Tar::Wrapper->new;
for
my
$distfile
(
sort
{
length
(
$a
->name) <=>
length
(
$b
->name) } @{
$self
->files }
) {
my
$in
= path(
$distfile
->name)->parent;
my
$filename
=
$built_in
->child(
$distfile
->name );
$archive
->add(
$basedir
->child(
$distfile
->name )->stringify,
$filename
->stringify,
{
perm
=> (
stat
$filename
)[2] & ~022 },
);
}
return
$archive
;
}
sub
_prep_build_root {
my
(
$self
,
$build_root
) =
@_
;
$build_root
= path(
$build_root
||
$self
->dist_basename);
$build_root
->mkpath
unless
-d
$build_root
;
my
$dist_root
=
$self
->root;
return
$build_root
if
!-d
$build_root
;
my
$ok
=
eval
{
$build_root
->remove_tree({
safe
=> 0 }); 1 };
die
"unable to delete '$build_root' in preparation of build: $@"
unless
$ok
;
if
( $^O eq
'MSWin32'
and -d
$build_root
) {
$self
->
log
(
"spinning for at least one second to allow other processes to release locks on $build_root"
);
my
$timeout
=
time
+ 2;
while
(
time
!=
$timeout
and -d
$build_root
) { }
die
"unable to delete '$build_root' in preparation of build because some process has a lock on it"
if
-d
$build_root
;
}
return
$build_root
;
}
sub
release {
my
$self
=
shift
;
Carp::croak(
"you can't release without any Releaser plugins"
)
unless
my
@releasers
= @{
$self
->plugins_with(-Releaser) };
$ENV
{DZIL_RELEASING} = 1;
my
$tgz
=
$self
->build_archive;
$_
->before_release(
$tgz
)
for
@{
$self
->plugins_with(-BeforeRelease) };
$_
->release(
$tgz
)
for
@releasers
;
$_
->after_release(
$tgz
)
for
@{
$self
->plugins_with(-AfterRelease) };
}
sub
clean {
my
(
$self
,
$dry_run
) =
@_
;
for
my
$x
(
grep
{ -e }
'.build'
,
glob
(
$self
->name .
'-*'
)) {
if
(
$dry_run
) {
$self
->
log
(
"clean: would remove $x"
);
}
else
{
$self
->
log
(
"clean: removing $x"
);
File::Path::rmtree(
$x
);
}
};
}
sub
ensure_built_in_tmpdir {
my
$self
=
shift
;
my
$build_root
= path(
'.build'
);
$build_root
->mkpath
unless
-d
$build_root
;
my
$target
= path( File::Temp::tempdir(
DIR
=>
$build_root
) );
$self
->
log
(
"building distribution under $target for installation"
);
my
$os_has_symlinks
=
eval
{
symlink
(
""
,
""
); 1 };
my
$previous
;
my
$latest
;
if
(
$os_has_symlinks
) {
$previous
= path(
$build_root
,
'previous'
);
$latest
= path(
$build_root
,
'latest'
);
if
( -l
$previous
) {
$previous
->remove
or
$self
->
log
(
"cannot remove old .build/previous link"
);
}
if
( -l
$latest
) {
rename
$latest
,
$previous
or
$self
->
log
(
"cannot move .build/latest link to .build/previous"
);
}
symlink
$target
->basename,
$latest
or
$self
->
log
(
'cannot create link .build/latest'
);
}
$self
->ensure_built_in(
$target
);
return
(
$target
,
$latest
,
$previous
);
}
sub
install {
my
(
$self
,
$arg
) =
@_
;
$arg
||= {};
my
(
$target
,
$latest
) =
$self
->ensure_built_in_tmpdir;
my
$ok
=
eval
{
my
$wd
= File::pushd::pushd(
$target
);
my
@cmd
=
$arg
->{install_command}
? @{
$arg
->{install_command} }
: (
cpanm
=>
"."
);
$self
->log_debug([
'installing via %s'
, \
@cmd
]);
system
(
@cmd
) &&
$self
->log_fatal([
"error running %s"
, \
@cmd
]);
1;
};
unless
(
$ok
) {
my
$error
= $@ ||
'(exception clobered)'
;
$self
->
log
(
"install failed, left failed dist in place at $target"
);
die
$error
;
}
if
(
$arg
->{keep_build_dir}) {
$self
->
log
(
"all's well; left dist in place at $target"
);
}
else
{
$self
->
log
(
"all's well; removing $target"
);
$target
->remove_tree({
safe
=> 0 });
$latest
->remove_tree({
safe
=> 0 })
if
-d
$latest
;
$latest
->remove
if
$latest
;
}
return
;
}
sub
test {
my
(
$self
,
$arg
) =
@_
;
Carp::croak(
"you can't test without any TestRunner plugins"
)
unless
my
@testers
= @{
$self
->plugins_with(-TestRunner) };
my
(
$target
,
$latest
) =
$self
->ensure_built_in_tmpdir;
my
$error
=
$self
->run_tests_in(
$target
,
$arg
);
if
(
$arg
and
$arg
->{keep_build_dir}) {
$self
->
log
(
"all's well; left dist in place at $target"
);
return
;
}
$self
->
log
(
"all's well; removing $target"
);
$target
->remove_tree({
safe
=> 0 });
$latest
->remove_tree({
safe
=> 0 })
if
$latest
&& -d
$latest
;
$latest
->remove
if
$latest
;
}
sub
run_tests_in {
my
(
$self
,
$target
,
$arg
) =
@_
;
Carp::croak(
"you can't test without any TestRunner plugins"
)
unless
my
@testers
= @{
$self
->plugins_with(-TestRunner) };
for
my
$tester
(
@testers
) {
my
$wd
= File::pushd::pushd(
$target
);
$tester
->test(
$target
,
$arg
);
}
}
sub
run_in_build {
my
(
$self
,
$cmd
,
$arg
) =
@_
;
$self
->log_fatal(
"you can't build without any BuildRunner plugins"
)
unless
(
$arg
and
exists
$arg
->{build} and !
$arg
->{build})
or @{
$self
->plugins_with(-BuildRunner) };
require
"Config.pm"
;
my
(
$target
,
$latest
) =
$self
->ensure_built_in_tmpdir;
my
$abstarget
=
$target
->absolute;
my
$ok
=
eval
{
my
$wd
= File::pushd::pushd(
$target
);
if
(
$arg
and
exists
$arg
->{build} and !
$arg
->{build}) {
system
(
@$cmd
) and
die
"error while running: @$cmd"
;
return
1;
}
$self
->_ensure_blib;
local
$ENV
{PERL5LIB} =
join
$Config::Config
{path_sep},
(
map
{
$abstarget
->child(
'blib'
,
$_
) }
qw(arch lib)
),
(
defined
$ENV
{PERL5LIB} ?
$ENV
{PERL5LIB} : ());
local
$ENV
{PATH} =
join
$Config::Config
{path_sep},
(
map
{
$abstarget
->child(
'blib'
,
$_
) }
qw(bin script)
),
(
defined
$ENV
{PATH} ?
$ENV
{PATH} : ());
system
(
@$cmd
) and
die
"error while running: @$cmd"
;
1;
};
if
(
$ok
) {
$self
->
log
(
"all's well; removing $target"
);
$target
->remove_tree({
safe
=> 0 });
$latest
->remove_tree({
safe
=> 0 })
if
-d
$latest
;
$latest
->remove
if
$latest
;
}
else
{
my
$error
= $@ ||
'(unknown error)'
;
$self
->
log
(
$error
);
$self
->log_fatal(
"left failed dist in place at $target"
);
}
}
sub
_ensure_blib {
my
(
$self
) =
@_
;
unless
( -d
'blib'
) {
my
@builders
= @{
$self
->plugins_with( -BuildRunner ) };
$self
->log_fatal(
"no BuildRunner plugins specified"
)
unless
@builders
;
$_
->build
for
@builders
;
$self
->log_fatal(
"no blib; failed to build properly?"
)
unless
-d
'blib'
;
}
}
__PACKAGE__->meta->make_immutable;
1;