File Coverage

blib/lib/App/Module/Setup.pm

Criterion	Covered	Total	%
statement	18	105	17.1
branch	0	52	0.0
condition	0	19	0.0
subroutine	6	10	60.0
pod	1	2	50.0
total	25	188	13.3

#! perl

package App::Module::Setup;

### Please use this module via the command line module-setup tool.

our $VERSION = '0.09';

use warnings;
use strict;
use File::Find;
use File::Basename qw( dirname );
use File::Path qw( mkpath );
use POSIX qw( strftime );

sub main {
    my $options = shift;
    # Just in case we're called as a method.
    eval { $options->{module} || 1 } or $options = shift;

    my $tpldir = "templates/". $options->{template};
    my $mod = $options->{module};

    # Replacement variables
    my $vars =
      { "module.name"     => $mod,	# Foo::Bar
	"module.version"  => "0.01",
	"module.summary"  => $options->{summary} || $mod,
	"module.license"  => $options->{license} || "perl_5",
	"current.year"    => $options->{year} || 1900 + (localtime)[5],
	"author.name"     => $options->{author} || (getpwuid($<))[6],
	"author.email"    => $options->{email},
	"author.cpanid"   => $options->{cpanid},
	"author.githubid" => $options->{githubid},
	"perl.minversion" => $options->{minperl} || '5.008000',
      };

    my $dir;
    if ( $options->{'install-templates'} ) {
	$dir = $tpldir;
    }
    else {
	( $dir = $mod ) =~ s/::/-/g;
	$vars->{"module.distname"} = $dir;	# Foo-Bar
	$vars->{"module.distnamelc"} = lc($dir);
	( my $t = $mod ) =~ s/::/\//g;
	$vars->{"module.filename"} = $t . ".pm";	# Foo/Bar.pm
	$vars->{"author.cpanid"} ||= $1
	  if $options->{email}
	     && $options->{email} =~ /^(.*)\@cpan.org$/i;
	$vars->{"author.cpanid"} = uc( $vars->{"author.cpanid"} )
	  if $vars->{"author.cpanid"};
    }

    if ( -d $dir ) {
	die( "Directory $dir exists. Aborted!\n" );
    }

    for ( $vars->{"author.cpanid"} ) {
	next unless $_;
	$vars->{"author.metacpan"} = "https://cpan.metacpan.org/authors/id/" .
	  uc( join( "/", substr($_,0,1), substr($_,0,2), $_ ) );
    }

    $vars->{"ts.rpmdate"} = strftime("%a %b %d %Y", localtime);
    $vars->{"ts.yyyymmdd"} = strftime("%F", localtime);

    # Get template names and data.
    my ( $files, $dirs, $data );
    for my $cfg ( "./", @{ $options->{_configs} } ) {
	if ( -d "$cfg$tpldir" ) {
	    ( $files, $dirs, $data ) =
	      load_templates_from_directory( "$cfg$tpldir" );
	    last if $files;
	}
    }

    # Nope. Use built-in defaults.
    unless ( $files ) {
	unless ( $options->{template} eq "default" ) {
	    warn( "No templates found for ", $options->{template},
		  ", using default templates\n" );
	}
	require App::Module::Setup::Templates::Default;
	( $files, $dirs, $data ) =
	  App::Module::Setup::Templates::Default->load;
    }

    if ( $options->{'install-templates'} ) {
	warn( "Writing built-in templates to $dir\n" );
    }
    else {
	# Change the magic _Module.pm name to
	# the module file name.
	for my $file ( @$files ) {
	    if ( $file =~ /^(.*)_Module.pm$/ ) {
		my $t = $1 . $vars->{"module.filename"};
		push( @$dirs, dirname($t) );
		$data->{$t} = delete $data->{$file};
		$file = $t;
	    }
	    elsif ( $file =~ /^(.*)_Module.spec$/ ) {
		my $t = $1 . "perl-" . $vars->{"module.distname"} . ".spec";
		push( @$dirs, dirname($t) );
		$data->{$t} = delete $data->{$file};
		$file = $t;
	    }
	}
    }

    my $massage;
    if ( $options->{'install-templates'} ) {
	$massage = sub { $_[0] };
    }
    else {
	require App::Module::Setup::Templates;
	$massage = App::Module::Setup::Templates->can("templater");
    }

    # Create the neccessary directories.
    mkpath($dir, $options->{trace}, 0777 );
    chdir($dir) or die( "Error creating directory $dir\n" );
    mkpath( $dirs, $options->{trace}, 0777 );

    for my $target ( @$files ) {
	$vars->{" file"} = $target;
	open( my $fd, '>', $target )
	  or die( "Error opening ", "$dir/$target: $!\n" );
	print { $fd } $massage->( $data->{$target}, $vars );
	close($fd)
	  or die( "Error writing $target: $!\n" );
	warn( "Wrote: $dir/$target\n" )
	  if $options->{verbose};
    }

    # Postprocessing, e.g., set up git repo.
    foreach my $cmd ( @{ $options->{postcmd} } ) {
	system( $cmd );
    }

    # If we have a git repo, add all boilerplate files.
    if ( -d ".git" ) {
	system( "git", "add", @$files );
    }

    chdir("..");		# see t/90-ivp.t

    return 1;			# assume everything went ok
}

sub load_templates_from_directory {
    my ( $dir ) = shift;
    my $dl = length($dir);
    $dl++ unless $dir =~ m;/$;;
    my ( $files, $dirs, $data );

    find( { wanted => sub {
		return if length($_) < $dl; # skip top
		my $f = substr( $_, $dl );  # file relative to top
		if ( -d $_ ) {
		    push( @$dirs, $f );
		    return;
		}
		return unless -f $_;
		return if /~$/;

		push( @$files, $f );
		open( my $fd, '<', $_ )
		  or die( "Error reading template $_: $!\n" );
		local $/;
		$data->{$f} = <$fd>;
		close($fd);
	    },
	    no_chdir => 1,
	  }, $dir );

    return ( $files, $dirs, $data );
}


=head1 NAME

App::Module::Setup - a simple setup for a new module


=head1 SYNOPSIS

Nothing in here is meant for public consumption. Use F
from the command line.

    module-setup --author="A.U. Thor" --email=[e-mail] Foo::Bar


=head1 DESCRIPTION

This is the core module for App::Module::Setup. If you're not looking
to extend or alter the behavior of this module, you probably want to
look at L instead.

App::Module::Setup is used to create a skeletal CPAN distribution,
including basic builder scripts, tests, documentation, and module
code. This is done through just one method, C.


=head1 METHODS

=head2 App::Module::Setup->main( $options )

C is the only method you should need to use from outside this
module; all the other methods are called internally by this one.

This method creates the distribution and populates it with the all the
requires files.

It takes a reference to a hash of params, as follows:

    module       # module to create in distro
    version      # initial version
    author       # author's full name (taken from C if not provided)
    email        # author's email address
    verbose      # bool: print progress messages; defaults to 0
    template     # template set to use
    postcmd	 # array ref of commands to execute after creating
    install-templates # bool: just install the selected templates
    minperl	 # minimal perl version, e.g. 5.010000
    license	 # e.g. perl_5

=cut


=head1 AUTHOR

Johan Vromans, C<<  >>

=head1 BUGS

Please report any bugs or feature requests to C, or through
the web interface at L.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.

=head1 SUPPORT

Development of this module takes place on GitHub:
https://github.com/sciurius/perl-module-starter.

You can find documentation for this module with the perldoc command.

    perldoc App::Module::Setup

Please report any bugs or feature requests using the issue tracker on
GitHub.

=head1 ACKNOWLEDGEMENTS

David Golden, for giving me the final incentive to write this module.

I borrowed many ideas from L which was originally
written by Andy Lester (PETDANCE). Its current design came from
Ricardo Signes (RJBS). Sawyer X added features and maintains the
module after them.

=head1 COPYRIGHT & LICENSE

Copyright 2013,2018 Johan Vromans, all rights reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.


=cut

1; # End of App::Module::Setup