package Minilla::Project;
use strict;
use warnings;
use utf8;
use TOML 0.92 qw(from_toml);
use File::Basename qw(basename dirname);
use File::Spec::Functions qw(catdir catfile);
use DirHandle;
use File::pushd;
use CPAN::Meta;
use Module::CPANfile;
use Minilla;
use Minilla::Logger;
use Minilla::Metadata;
use Minilla::WorkDir;
use Minilla::ReleaseTest;
use Minilla::ModuleMaker::ModuleBuild;
use Minilla::Util qw(slurp_utf8 find_dir cmd spew_raw slurp_raw);
use Moo;
has dir => (
is => 'rw',
builder => 1,
trigger => 1,
required => 1,
);
has module_maker => (
is => 'ro',
default => sub { Minilla::ModuleMaker::ModuleBuild->new() },
);
has dist_name => (
is => 'lazy',
);
has build_class => (
is => 'lazy',
);
has main_module_path => (
is => 'lazy',
);
has metadata => (
is => 'lazy',
required => 1,
handles => [qw(name perl_version license)],
clearer => 1,
);
has contributors => (
is => 'lazy',
);
has work_dir => (
is => 'lazy',
);
has files => (
is => 'lazy',
);
has no_index => (
is => 'ro',
default => sub {
my $self = shift;
exists $self->config->{no_index} ?
$self->config->{no_index} :
{
directory => [qw(
t xt inc share eg examples author
) ]
};
},
);
has script_files => (
is => 'ro',
default => sub {
my $self = shift;
my $script_files = exists $self->config->{script_files} ?
$self->config->{script_files} :
['script/*', 'bin/*'];
join ', ', map { "glob('$_')" } @$script_files;
},
);
no Moo;
sub allow_pureperl {
my $self = shift;
$self->config->{allow_pureperl} ? 1 : 0;
}
sub version {
my $self = shift;
my $version = $self->config->{version} || $self->metadata->version;
unless (defined $version) {
errorf("Minilla can't aggregate version number from '" . $self->main_module_path . '"');
}
return $version;
}
sub authors {
my $self = shift;
if (my $authors_from = $self->config->{authors_from}) {
my $meta = Minilla::Metadata->new(
source => $authors_from
);
return $meta->authors;
}
$self->config->{authors} || $self->metadata->authors;
}
sub abstract {
my $self = shift;
if (my $abstract_from = $self->config->{abstract_from}) {
my $meta = Minilla::Metadata->new(
source => $abstract_from
);
return $meta->abstract;
}
$self->config->{abstract} || $self->metadata->abstract;
}
sub _build_dir {
my $self = shift;
my $gitdir = find_dir('.git')
or errorf("Current directory is not in git(%s)\n", Cwd::getcwd());
$gitdir = File::Spec->rel2abs($gitdir);
my $base_dir = dirname($gitdir);
return $base_dir;
}
sub _trigger_dir {
my ($self, $dir) = @_;
unless (File::Spec->file_name_is_absolute($dir)) {
$self->dir(File::Spec->rel2abs($dir));
}
}
sub config {
my $self = shift;
my $toml_path = File::Spec->catfile($self->dir, 'minil.toml');
if (-f $toml_path) {
my ($conf, $err) = from_toml(slurp_utf8($toml_path));
if ($err) {
errorf("TOML error in %s: %s\n", $toml_path, $err);
}
$conf;
} else {
+{};
}
}
sub c_source {
my $self = shift;
$self->config->{c_source} ? join(' ', @{$self->config->{c_source}}) : '';
}
sub _build_dist_name {
my $self = shift;
my $dist_name;
if ($self->config && defined($self->config->{name})) {
my $conf = $self->config;
if ($conf->{name} =~ /::/) {
(my $better_name = $conf->{name}) =~ s/::/-/g;
Carp::croak(qq!You shouldn't set 'name="$conf->{name}"' in minil.toml. You need to set the value as 'name="$better_name"'.!);
}
$dist_name = $conf->{name};
}
unless (defined $dist_name) {
infof("Detecting project name from directory name.\n");
$dist_name = do {
local $_ = basename($self->dir);
$_ =~ s!--!-!g;
$_ =~ s!\Ap5-!!;
$_;
};
}
if ($dist_name eq '.') { Carp::confess("Heh? " . $self->dir); }
unless ($dist_name) {
errorf("Cannot detect distribution name from minil.toml or directory name(cwd: %s, dir:%s)\n", Cwd::getcwd(), $self->dir);
}
return $dist_name;
}
sub _build_build_class {
my $self = shift;
my $build_class;
if (my $conf = $self->config) {
$build_class = $conf->{build}{build_class};
}
return $build_class || 'Module::Build';
}
sub _build_main_module_path {
my $self = shift;
my $dist_name = $self->dist_name;
my $source_path = $self->_detect_source_path($dist_name);
unless (defined($source_path) && -e $source_path) {
errorf("%s not found.\n", $source_path || "main module($dist_name)");
}
infof("Retrieving meta data from %s.\n", $source_path);
return $source_path;
}
sub _build_metadata {
my $self = shift;
my $config = +{%{$self->config}};
if (my $license = delete $config->{license}) {
$config->{_license_name} = $license;
}
# fill from main_module
my $metadata = Minilla::Metadata->new(
source => $self->main_module_path,
%$config,
);
infof("Name: %s\n", $metadata->name);
infof("Abstract: %s\n", $metadata->abstract);
infof("Version: %s\n", $metadata->version);
return $metadata;
}
sub _case_insensitive_match {
my $path = shift;
my @path = File::Spec->splitdir($path);
my $realpath = '.';
LOOP: for my $part (@path) {
my $d = DirHandle->new($realpath)
or do {
# warn "Cannot open dirhandle";
return;
};
while (defined($_ = $d->read)) {
if (uc($_) eq uc($part)) {
$realpath = catfile($realpath, $_);
next LOOP;
}
}
# does not match
# warn "Does not match: $part in $realpath";
return undef;
}
return $realpath;
}
sub _detect_source_path {
my ($self, $dir) = @_;
# like cpan-outdated => lib/App/cpanminus.pm
my $pat2 = "App-" . do {
local $_ = $dir;
s!-!!;
$_;
};
for my $path ("App-$dir", $pat2, $dir) {
$path =~ s!::!/!g;
$path =~ s!-!/!g;
$path = "lib/${path}.pm";
return $path if -f $path;
$path = _case_insensitive_match($path);
return $path if defined($path);
}
return undef;
}
sub load_cpanfile {
my $self = shift;
Module::CPANfile->load(catfile($self->dir, 'cpanfile'));
}
sub cpan_meta {
my ($self, $release_status) = @_;
$release_status ||= ($self->version =~ /_/ ? 'unstable' : 'stable');
my $cpanfile = $self->load_cpanfile;
my $merged_prereqs = $cpanfile->prereqs->with_merged_prereqs(
CPAN::Meta::Prereqs->new($self->module_maker->prereqs)
);
$merged_prereqs = $merged_prereqs->with_merged_prereqs(
CPAN::Meta::Prereqs->new(Minilla::ReleaseTest->prereqs)
);
if ($self->metadata->perl_version) {
$merged_prereqs = $merged_prereqs->with_merged_prereqs(
CPAN::Meta::Prereqs->new(+{
runtime => {
requires => {
perl => $self->metadata->perl_version,
}
}
})
);
}
$merged_prereqs = $merged_prereqs->as_string_hash;
my $dat = {
"meta-spec" => {
"version" => "2",
"url" => "http://search.cpan.org/perldoc?CPAN::Meta::Spec"
},
license => $self->license->meta2_name,
abstract => $self->abstract,
dynamic_config => 0,
version => $self->version,
name => $self->dist_name,
prereqs => $merged_prereqs,
generated_by => "Minilla/$Minilla::VERSION",
release_status => $release_status || 'stable',
no_index => $self->no_index,
};
unless ($dat->{abstract}) {
errorf("Cannot retrieve 'abstract' from %s. You need to write POD in your main module.\n", $self->dir);
}
if ($self->authors) {
$dat->{author} = $self->authors;
} else {
errorf("Cannot determine 'author' from %s\n", $self->dir);
}
if ($self->contributors && @{$self->contributors} > 0) {
$dat->{x_contributors} = $self->contributors;
}
# fill 'provides' section
if ($release_status ne 'unstable') {
my $provides = Module::Metadata->provides(
dir => File::Spec->catdir($self->dir, 'lib'),
version => 2
);
unless (%$provides) {
errorf("%s does not provides any package. Abort.\n", $self->dir);
}
$dat->{provides} = $provides;
}
# fill repository information
{
my $guard = pushd($self->dir);
if ( `git remote show -n origin` =~ /URL: (.*)$/m && $1 ne 'origin' ) {
# XXX Make it public clone URL, but this only works with github
my $git_url = $1;
$git_url =~ s![\w\-]+\@([^:]+):!git://$1/!;
if ($git_url =~ /github\.com/) {
my $http_url = $git_url;
$http_url =~ s![\w\-]+\@([^:]+):!https://$1/!;
$http_url =~ s!\Agit://!https://!;
$http_url =~ s!\.git$!!;
unless ($self->config->{no_github_issues}) {
$dat->{resources}->{bugtracker} = +{
web => "$http_url/issues",
};
}
$dat->{resources}->{repository} = +{
url => $git_url,
web => $http_url,
};
$dat->{resources}->{homepage} = $self->config->{homepage} || $http_url;
} else {
# normal repository
if ($git_url !~ m{^file://}) {
$dat->{resources}->{repository} = +{
url => $git_url,
};
}
}
}
}
my $meta = CPAN::Meta->new($dat);
return $meta;
}
sub readme_from {
my $self = shift;
$self->config->{readme_from} || $self->main_module_path;
}
sub regenerate_files {
my $self = shift;
$self->regenerate_meta_json();
$self->regenerate_readme_md();
$self->module_maker->generate($self);
}
sub regenerate_meta_json {
my $self = shift;
my $meta = $self->cpan_meta('unstable');
$meta->save(File::Spec->catfile($self->dir, 'META.json'), {
version => '2.0'
});
}
sub regenerate_readme_md {
my $self = shift;
require Pod::Markdown;
Pod::Markdown->VERSION('1.322');
my $parser = Pod::Markdown->new;
$parser->parse_from_file($self->readme_from);
my $fname = File::Spec->catfile($self->dir, 'README.md');
spew_raw($fname, $parser->as_markdown);
}
sub verify_prereqs {
my ($self, $phases, $type) = @_;
if ($Minilla::AUTO_INSTALL) {
system('cpanm', '--quiet', '--installdeps', '--with-develop', '.');
}
}
sub _build_contributors {
my $self = shift;
my $normalize = sub {
local $_ = shift;
if (/<([^>]+)>/) {
$1;
} else {
$_;
}
};
my @lines = do {
my %uniq;
reverse grep { !$uniq{$normalize->($_)}++ } split /\n/, `git log --format="%aN <%aE>"`
};
my %is_author = map { $normalize->($_) => 1 } @{$self->authors};
@lines = grep { !$is_author{$normalize->($_)} } @lines;
@lines = grep { $_ ne 'Your Name <you@example.com>' } @lines;
@lines = grep { ! /^\(no author\) <\(no author\)\@[\d\w\-]+>$/ } @lines;
\@lines;
}
sub _build_work_dir {
my $self = shift;
Minilla::WorkDir->new(
project => $self,
);
}
sub _build_files {
my $self = shift;
my $conf = $self->config->{'FileGatherer'};
my @files = Minilla::FileGatherer->new(
exclude_match => $conf->{exclude_match},
exists $conf->{include_dotfiles} ? (include_dotfiles => $conf->{include_dotfiles}) : (),
)->gather_files(
$self->dir
);
\@files;
}
sub perl_files {
my $self = shift;
my @files = @{$self->files};
grep {
$_ =~ /\.(?:pm|pl|t)$/i || slurp_raw($_) =~ m{ ^ \#\! .* perl }ix
} @files;
}
sub PL_files { shift->config->{PL_files} || +{} }
1;