package Module::Provision::Base;
use namespace::autoclean;
use Moo;
use Class::Usul::Constants;
use Class::Usul::Functions qw( app_prefix class2appdir classdir io throw );
use Class::Usul::Options;
use Class::Usul::Time qw( time2str );
use English qw( -no_match_vars );
use File::DataClass::Types qw( ArrayRef Directory HashRef NonEmptySimpleStr
Object OctalNum Path PositiveInt SimpleStr );
use Module::Metadata;
use Perl::Version;
use Type::Utils qw( enum );
use Unexpected::Functions qw( Unspecified );
extends q(Class::Usul::Programs);
my %BUILDERS = ( 'DZ' => 'dist.ini', 'MB' => 'Build.PL', 'MI' => 'Makefile.PL');
my $BUILDER = enum 'Builder' => [ qw( DZ MB MI ) ];
my $VCS = enum 'VCS' => [ qw( git none svn ) ];
# Override defaults in base class
has '+config_class' => default => sub { 'Module::Provision::Config' };
# Object attributes (public)
# Visible to the command line
option 'base' => is => 'lazy', isa => Path, format => 's',
documentation => 'Directory containing new projects',
coerce => Path->coercion, default => sub { $_[ 0 ]->config->base };
option 'branch' => is => 'lazy', isa => SimpleStr, format => 's',
documentation => 'The name of the initial branch to create', short => 'b';
option 'builder' => is => 'lazy', isa => $BUILDER, format => 's',
documentation => 'Which build system to use: DZ, MB, or MI';
option 'license' => is => 'ro', isa => NonEmptySimpleStr, format => 's',
documentation => 'License used for the project',
default => sub { $_[ 0 ]->config->license };
option 'perms' => is => 'ro', isa => OctalNum, format => 'i',
documentation => 'Default permission for file / directory creation',
coerce => OctalNum->coercion, default => '640';
option 'project' => is => 'lazy', isa => NonEmptySimpleStr, format => 's',
documentation => 'Package name of the new projects main module';
option 'repository' => is => 'ro', isa => NonEmptySimpleStr, format => 's',
documentation => 'Directory containing the SVN repository',
default => sub { $_[ 0 ]->config->repository };
option 'vcs' => is => 'lazy', isa => $VCS, format => 's',
documentation => 'Which VCS to use: git, none, or svn';
# Ingnored by the command line
has 'appbase' => is => 'lazy', isa => Path, coerce => Path->coercion;
has 'appldir' => is => 'lazy', isa => Path, coerce => Path->coercion;
has 'branch_file' => is => 'lazy', isa => Path, coerce => Path->coercion,
default => sub { [ $_[ 0 ]->appbase, '.branch' ] };
has 'binsdir' => is => 'lazy', isa => Path, coerce => Path->coercion,
default => sub { [ $_[ 0 ]->appldir, 'bin' ] };
has 'default_branch' => is => 'lazy', isa => SimpleStr;
has 'dist_module' => is => 'lazy', isa => Path, coerce => Path->coercion,
default => sub { [ $_[ 0 ]->homedir.'.pm' ] };
has 'dist_version' => is => 'lazy', isa => Object;
has 'distname' => is => 'lazy', isa => NonEmptySimpleStr,
default => sub { __distname( $_[ 0 ]->project ) };
has 'exec_perms' => is => 'lazy', isa => PositiveInt;
has 'homedir' => is => 'lazy', isa => Path, coerce => Path->coercion;
has 'incdir' => is => 'lazy', isa => Path, coerce => Path->coercion,
default => sub { [ $_[ 0 ]->appldir, 'inc' ] };
has 'initial_wd' => is => 'ro', isa => Directory,
default => sub { io()->cwd };
has 'libdir' => is => 'lazy', isa => Path, coerce => Path->coercion,
default => sub { [ $_[ 0 ]->appldir, 'lib' ] };
has 'manifest_paths' => is => 'lazy', isa => ArrayRef, init_arg => undef;
has 'module_abstract' => is => 'lazy', isa => NonEmptySimpleStr;
has 'project_file' => is => 'lazy', isa => NonEmptySimpleStr;
has 'stash' => is => 'lazy', isa => HashRef;
has 'testdir' => is => 'lazy', isa => Path, coerce => Path->coercion,
default => sub { [ $_[ 0 ]->appldir, 't' ] };
# Object attributes (private)
has '_license_keys' => is => 'lazy', isa => HashRef;
# Public methods
sub chdir {
my ($self, $dir) = @_;
$dir or throw class => Unspecified, args => [ 'directory' ];
chdir $dir or throw error => 'Directory [_1] cannot chdir: [_2]',
args => [ $dir, $OS_ERROR ];
return $dir;
}
# Private methods
sub _build_appbase {
my $self = shift; my $base = $self->base->absolute( $self->initial_wd );
return $base->catdir( $self->distname );
}
sub _build_appldir {
my $self = shift; my $appbase = $self->appbase; my $branch = $self->branch;
my $home = $self->config->my_home; my $vcs = $self->vcs;
(my $rel_appbase = $appbase) =~ s{ \Q$home\E [\\/] }{}mx;
$self->debug and $self->info
( "Appbase: ${rel_appbase}, Branch: ${branch}, VCS: ${vcs}" );
return $vcs eq 'none' ? $appbase
: $appbase->catdir( '.git' )->exists ? $appbase
: $appbase->catdir( '.svn' )->exists ? $appbase
: $appbase->catdir( $branch )->exists ? $appbase->catdir( $branch )
: undef;
}
sub _build_branch {
my $self = shift; my $branch = $ENV{BRANCH}; $branch and return $branch;
$self->branch_file->exists and return $self->branch_file->chomp->getline;
return $self->default_branch;
}
sub _build_builder {
my $self = shift; my $appldir = $self->appldir;
for (grep { $_->[ 1 ]->exists }
map { [ $_, $appldir->catfile( $BUILDERS{ $_ } ) ] } __builders()) {
return $_->[ 0 ];
}
return undef;
}
sub _build_default_branch {
return $_[ 0 ]->config->default_branches->{ $_[ 0 ]->vcs } || NUL;
}
sub _build_dist_version {
my $self = shift;
my $module = $self->dist_module->abs2rel( $self->appldir );
my $info = Module::Metadata->new_from_file( $module );
return Perl::Version->new( $info ? $info->version : '0.1.1' );
}
sub _build_exec_perms {
return (($_[ 0 ]->perms & oct '0444') >> 2) | $_[ 0 ]->perms;
}
sub _build_homedir {
return [ $_[ 0 ]->libdir, classdir $_[ 0 ]->project ];
}
sub _build__license_keys {
return {
perl => 'Perl_5',
perl_5 => 'Perl_5',
apache => [ map { "Apache_$_" } qw( 1_1 2_0 ) ],
artistic => 'Artistic_1_0',
artistic_2 => 'Artistic_2_0',
lgpl => [ map { "LGPL_$_" } qw( 2_1 3_0 ) ],
bsd => 'BSD',
gpl => [ map { "GPL_$_" } qw( 1 2 3 ) ],
mit => 'MIT',
mozilla => [ map { "Mozilla_$_" } qw( 1_0 1_1 ) ], };
}
sub _build_manifest_paths {
my $self = shift;
return [ grep { $_->exists }
map { io( __parse_manifest_line( $_ )->[ 0 ] ) }
grep { not m{ \A \s* [\#] }mx }
$self->appldir->catfile( 'MANIFEST' )->chomp->getlines ];
}
sub _build_module_abstract {
return $_[ 0 ]->loc( $_[ 0 ]->config->module_abstract );
}
sub _build_project {
my $self = shift; my $dir = $self->initial_wd; my ($prev, $module);
while (not $prev or $prev ne $dir) { # Search for dist.ini first
for my $file (grep { $_->exists }
map { $dir->catfile( $BUILDERS{ $_ } ) } __builders()) {
$module = __get_module_from( $file->all ) and return $module;
throw error => 'File [_1] contains no module name', args => [ $file ];
}
$prev = $dir; $dir = $dir->parent;
}
throw error => 'Path [_1] contains no project files',
args => [ $self->initial_wd ];
return; # Never reached
}
sub _build_project_file {
return $BUILDERS{ $_[ 0 ]->builder };
}
sub _build_stash {
my $self = shift; my $config = $self->config; my $author = $config->author;
my $project = $self->project; my $perl_ver = $self->config->min_perl_ver;
my $perl_code = $self->method eq 'dist' ? "use ${perl_ver};" : NUL;
return { abstract => $self->module_abstract,
appdir => class2appdir $self->distname,
author => $author,
author_email => $config->author_email,
author_id => $config->author_id,
author_ID => uc $config->author_id,
copyright => $ENV{ORGANIZATION} || $author,
copyright_year => time2str( '%Y' ),
creation_date => time2str,
dist_module => $self->dist_module->abs2rel( $self->appldir ),
dist_version => NUL.$self->dist_version,
distname => $self->distname,
first_name => lc ((split SPC, $author)[ 0 ]),
home_page => $config->home_page,
initial_wd => NUL.$self->initial_wd,
last_name => lc ((split SPC, $author)[ -1 ]),
lc_distname => lc $self->distname,
license => $self->license,
license_class => $self->_license_keys->{ $self->license },
module => $project,
perl => $perl_ver,
prefix => (split m{ :: }mx, lc $project)[ -1 ],
project => $project,
use_perl => $perl_code,
version => $self->VERSION, };
}
sub _build_vcs {
my $self = shift; my $appbase = $self->appbase;
return $appbase->catdir( '.git' )->exists ? 'git'
: $appbase->catdir( qw( master .git ) )->exists ? 'git'
: $appbase->catdir( '.svn' )->exists ? 'svn'
: $appbase->catdir( qw( trunk .svn ) )->exists ? 'svn'
: $appbase->catdir( $self->repository )->exists ? 'svn'
: 'none';
}
# Private functions
sub __builders {
return (sort keys %BUILDERS);
}
sub __distname {
(my $y = $_[ 0 ] || NUL) =~ s{ :: }{-}gmx; return $y;
}
sub __get_module_from { # Return main module name from contents of project file
return
(map { s{ [-] }{::}gmx; $_ }
map { m{ \A [q\'\"] }mx ? eval $_ : $_ }
map { m{ \A \s* (?:module_name|module|name) \s+ [=]?[>]? \s* ([^,;]+) [,;]? }imx }
grep { m{ \A \s* (module|name) }imx }
split m{ [\n] }mx, $_[ 0 ])[ 0 ];
}
sub __parse_manifest_line { # Robbed from ExtUtils::Manifest
my $line = shift; my ($file, $comment);
# May contain spaces if enclosed in '' (in which case, \\ and \' are escapes)
if (($file, $comment) = $line =~ m{ \A \' (\\[\\\']|.+)+ \' \s* (.*) }mx) {
$file =~ s{ \\ ([\\\']) }{$1}gmx;
}
else {
($file, $comment) = $line =~ m{ \A (\S+) \s* (.*) }mx;
}
return [ $file, $comment ];
}
1;
__END__
=pod
=encoding utf8
=head1 Name
Module::Provision::Base - Immutable data object
=head1 Synopsis
use Moose;
extends 'Module::Provision::Base';
=head1 Description
Creates an immutable data object required by the methods in the applied roles
=head1 Configuration and Environment
Defines the following list of attributes which can be set from the
command line;
=over 3
=item C<base>
The directory which will contain the new project. Defaults to the users
home directory
=item C<branch>
The name of the initial branch to create. Defaults to F<master> for
Git and F<trunk> for SVN
=item C<builder>
Which of the three build systems to use. Defaults to C<MB>, which is
L<Module::Build>. Can be C<DZ> for L<Dist::Zilla> or C<MI> for
L<Module::Install>
=item C<config_class>
The name of the configuration class
=item C<initial_wd>
The working directory when the command was invoked
=item C<license>
The name of the license used on the project. Defaults to C<perl>
=item C<perms>
Permissions used to create files. Defaults to C<644>. Directories and
programs have the execute bit turned on if the corresponding read bit
is on
=item C<project>
The class name of the new project. Should be the first extra argument on the
command line
=item C<repository>
Name of the directory containing the SVN repository. Defaults to F<repository>
=item C<vcs>
The version control system to use. Defaults to C<none>, can be C<git>
or C<svn>
=back
=head1 Subroutines/Methods
=head2 chdir
$directory = $self->chdir( $directory );
Changes the current working directory to the one supplied and returns it.
Throws if the operation was not successful
=head1 Diagnostics
None
=head1 Dependencies
=over 3
=item L<Class::Usul>
=item L<File::DataClass>
=item L<Module::Metadata>
=item L<Module::Provision::Config>
=item L<Perl::Version>
=back
=head1 Incompatibilities
There are no known incompatibilities in this module
=head1 Bugs and Limitations
There are no known bugs in this module.
Please report problems to the address below.
Patches are welcome
=head1 Acknowledgements
Larry Wall - For the Perl programming language
=head1 Author
Peter Flanigan, C<< <pjfl@cpan.org> >>
=head1 License and Copyright
Copyright (c) 2013 Peter Flanigan. All rights reserved
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself. See L<perlartistic>
This program is distributed in the hope that it will be useful,
but WITHOUT WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE
=cut
# Local Variables:
# mode: perl
# tab-width: 3
# End: