File Coverage

blib/lib/Module/Starter/CSJEWELL.pm

Criterion	Covered	Total	%
statement	28	211	13.2
branch	1	60	1.6
condition	2	6	33.3
subroutine	9	19	47.3
pod	6	7	85.7
total	46	303	15.1

package Module::Starter::CSJEWELL;

use 5.008001;
use warnings;
use strict;
use Carp;
use English qw( -no_match_vars );
use parent 'Module::Starter::Simple';

our $VERSION = '0.200';
$VERSION =~ s/_//sm;

sub module_guts {
	my $self    = shift;
	my %context = (
		'MODULE NAME' => shift,
		'RT NAME'     => shift,
		'DATE'        => scalar localtime,
		'YEAR'        => $self->_thisyear(),
	);

	return $self->_load_and_expand_template( 'Module.pm', \%context );
}

sub create_Makefile_PL {
	my $self = shift;

	# We don't create a Makefile.PL.

	return;
}

sub Build_PL_guts {
	my $self    = shift;
	my %context = (
		'MAIN MODULE'  => shift,
		'MAIN PM FILE' => shift,
		'DATE'         => scalar localtime,
		'YEAR'         => $self->_thisyear(),
	);

	return $self->_load_and_expand_template( 'Build.PL', \%context );
}

sub Changes_guts {
	my $self = shift;

	my %context = (
		'DATE' => scalar localtime,
		'YEAR' => $self->_thisyear(),
	);

	return $self->_load_and_expand_template( 'Changes', \%context );
}

sub create_README {
	my $self = shift;

	# We don't create a readme as such.

	return;
}

sub t_guts { ## no critic (RequireArgUnpacking)
	my $self    = shift;
	my @modules = @_;
	my %context = (
		'DATE' => scalar localtime,
		'YEAR' => $self->_thisyear(),
	);

	my %t_files;
	my @template_files;
	push @template_files, glob "$self->{template_dir}/t/*.t";
	push @template_files, glob "$self->{template_dir}/xt/author/*.t";
	push @template_files, glob "$self->{template_dir}/xt/settings/*.txt";
	for my $test_file (
		map {
			my $x = $_;
			$x = File::Spec->abs2rel( $_, $self->{template_dir} );
			$x;
		} @template_files
	  )
	{
		$t_files{$test_file} =
		  $self->_load_and_expand_template( $test_file, \%context );
	}

	my $nmodules = @modules;
	$nmodules++;
	my $main_module = $modules[0];
	my $use_lines = join "\n", map {"    use_ok( '$_' );"} @modules;

	$t_files{'t/compile.t'} = <<"END_LOAD";
use Test::More tests => $nmodules;

BEGIN {
	use strict;
	\$^W = 1;
	\$| = 1;

    ok((\$] > 5.008000), 'Perl version acceptable') or BAIL_OUT ('Perl version unacceptably old.');
$use_lines
    diag( "Testing $main_module \$${main_module}::VERSION" );
}

END_LOAD

	return %t_files;
} ## end sub t_guts

sub _create_t {
	my $self     = shift;
	my $filename = shift;
	my $content  = shift;

	my @dirparts = ( $self->{basedir}, 't' );
	foreach my $tdir (
		File::Spec->catdir( $self->{basedir}, 't' ),
		File::Spec->catdir( $self->{basedir}, 'xt' ),
		File::Spec->catdir( $self->{basedir}, 'xt', 'settings' ),
		File::Spec->catdir( $self->{basedir}, 'xt', 'author' ),
	  )
	{

		if ( not -d $tdir ) {
			local @ARGV = $tdir;
			mkpath();
			$self->progress("Created $tdir");
		}
	} ## end foreach my $tdir ( File::Spec...)

	my $fname = File::Spec->catfile( $self->{basedir}, $filename );
	$self->create_file( $fname, $content );
	$self->progress("Created $fname");

	return "$filename";
} ## end sub _create_t

sub MANIFEST_guts { ## no critic (RequireArgUnpacking)
	my $self  = shift;
	my @files = sort @_;

	my $mskip = $self->_load_and_expand_template( 'MANIFEST.SKIP', {} );
	my $fname = File::Spec->catfile( $self->{basedir}, 'MANIFEST.SKIP' );
	$self->create_file( $fname, $mskip );
	$self->progress("Created $fname");

	return join "\n", @files, q{};
}


sub _load_and_expand_template {
	my ( $self, $rel_file_path, $context_ref ) = @_;

	@{$context_ref}{ map {uc} keys %{$self} } = values %{$self};

	die
"Can't find directory that holds Module::Starter::CSJEWELL templates\n",
	  "(no 'template_dir: ' in config file)\n"
	  if not defined $self->{template_dir};

	die "Can't access Module::Starter::CSJEWELL template directory\n",
"(perhaps 'template_dir: $self->{template_dir}' is wrong in config file?)\n"
	  if not -d $self->{template_dir};

	my $abs_file_path = "$self->{template_dir}/$rel_file_path";

	die "The Module::Starter::CSJEWELL template: $rel_file_path\n",
	  "isn't in the template directory ($self->{template_dir})\n\n"
	  if not -e $abs_file_path;

	die "The Module::Starter::CSJEWELL template: $rel_file_path\n",
	  "isn't readable in the template directory ($self->{template_dir})\n\n"
	  if not -r $abs_file_path;

	open my $fh, '<', $abs_file_path or croak $ERRNO;
	local $INPUT_RECORD_SEPARATOR = undef;
	my $text = <$fh>;
	close $fh or croak $ERRNO;

	$text =~ s{<([[:upper:] ]+)>}
              { $context_ref->{$1}
                || die "Unknown placeholder <$1> in $rel_file_path\n"
              }xmseg;

	return $text;
} ## end sub _load_and_expand_template

sub import { ## no critic (RequireArgUnpacking ProhibitExcessComplexity)
	my $class = shift;
	my ( $setup, @other_args ) = @_;

	# If this is not a setup request,
	# refer the import request up the hierarchy...
	if ( @other_args || !$setup || $setup ne 'setup' ) {
		return $class->SUPER::import(@_);
	}

	## no critic (RequireLocalizedPunctuationVars ProhibitLocalVars)

	# Otherwise, gather the necessary tools...
	use ExtUtils::Command qw( mkpath );
	use File::Spec;
	local $OUTPUT_AUTOFLUSH = 1;

	local $ENV{HOME} = $ENV{HOME};

	if ( $OSNAME eq 'MSWin32' ) {
		if ( defined $ENV{HOME} ) {
			$ENV{HOME} = Win32::GetShortPathName( $ENV{HOME} );
		} else {
			$ENV{HOME} = Win32::GetShortPathName(
				File::Spec->catpath( $ENV{HOMEDRIVE}, $ENV{HOMEPATH}, q{} )
			);
		}
	}

	# Locate the home directory...
	if ( !defined $ENV{HOME} ) {
		print 'Please enter the full path of your home directory: ';
		$ENV{HOME} = <>;
		chomp $ENV{HOME};
		croak 'Not a valid directory. Aborting.'
		  if !-d $ENV{HOME};
	}

	# Create the directories...
	my $template_dir =
	  File::Spec->catdir( $ENV{HOME}, '.module-starter', 'CSJEWELL' );
	if ( not -d $template_dir ) {
		print {*STDERR} "Creating $template_dir...";
		local @ARGV = $template_dir;
		mkpath;
		print {*STDERR} "done.\n";
	}

	my $template_test_dir =
	  File::Spec->catdir( $ENV{HOME}, '.module-starter', 'CSJEWELL', 't' );
	if ( not -d $template_test_dir ) {
		print {*STDERR} "Creating $template_test_dir...";
		local @ARGV = $template_test_dir;
		mkpath;
		print {*STDERR} "done.\n";
	}

	my $template_xtest_dir =
	  File::Spec->catdir( $ENV{HOME}, '.module-starter', 'CSJEWELL', 'xt' );
	if ( not -d $template_xtest_dir ) {
		print {*STDERR} "Creating $template_xtest_dir...";
		local @ARGV = $template_xtest_dir;
		mkpath;
		print {*STDERR} "done.\n";
	}

	my $template_authortest_dir =
	  File::Spec->catdir( $ENV{HOME}, '.module-starter', 'CSJEWELL', 'xt',
		'author' );
	if ( not -d $template_authortest_dir ) {
		print {*STDERR} "Creating $template_authortest_dir...";
		local @ARGV = $template_authortest_dir;
		mkpath;
		print {*STDERR} "done.\n";
	}

	my $template_authortest_settings =
	  File::Spec->catdir( $ENV{HOME}, '.module-starter', 'CSJEWELL', 'xt',
		'settings' );
	if ( not -d $template_authortest_settings ) {
		print {*STDERR} "Creating $template_authortest_settings...";
		local @ARGV = $template_authortest_settings;
		mkpath;
		print {*STDERR} "done.\n";
	}

	# Create or update the config file (making a backup, of course)...
	my $config_file =
	  File::Spec->catfile( $ENV{HOME}, '.module-starter', 'config' );

	my @config_info;

	if ( -e $config_file ) {
		print {*STDERR} "Backing up $config_file...";
		my $backup =
		  File::Spec->catfile( $ENV{HOME}, '.module-starter',
			'config.bak' );
		rename $config_file, $backup or croak $ERRNO;
		print {*STDERR} "done.\n";

		print {*STDERR} "Updating $config_file...";
		open my $fh, '<', $backup or die "$config_file: $OS_ERROR\n";
		@config_info =
		  grep { not /\A (?: template_dir | plugins ) : /xms } <$fh>;
		close $fh or die "$config_file: $OS_ERROR\n";
	} else {
		print {*STDERR} "Creating $config_file...\n";

		my $author = _prompt_for('your full name');
		my $email  = _prompt_for('an email address');

		@config_info = (
			"author:  $author\n",
			"email:   $email\n",
			"builder: Module::Build\n",
		);

		print {*STDERR} "Writing $config_file...\n";
	} ## end else [ if ( -e $config_file )]

	push @config_info,
	  ( "plugins: Module::Starter::CSJEWELL\n",
		"template_dir: $template_dir\n",
	  );

	open my $fh, '>', $config_file or die "$config_file: $OS_ERROR\n";
	print {$fh} @config_info or die "$config_file: $OS_ERROR\n";
	close $fh or die "$config_file: $OS_ERROR\n";
	print {*STDERR} "done.\n";

	print {*STDERR} "Installing templates...\n";

	# Then install the various files...
	my @files = (
		['Build.PL'],
		['Changes'],
		['Module.pm'],
		['MANIFEST.SKIP'],
		[ 't', '000_report_versions.t' ],
		[ 'xt', 'settings', 'perltidy.txt' ],
		[ 'xt', 'settings', 'perlcritic.txt' ],
		[ 'xt', 'author',   'prereq.t' ],
		[ 'xt', 'author',   'portability.t' ],
		[ 'xt', 'author',   'meta.t' ],
		[ 'xt', 'author',   'manifest.t' ],
		[ 'xt', 'author',   'minimumversion.t' ],
		[ 'xt', 'author',   'pod_coverage.t' ],
		[ 'xt', 'author',   'pod.t' ],
		[ 'xt', 'author',   'perlcritic.t' ],
		[ 'xt', 'author',   'fixme.t' ],
		[ 'xt', 'author',   'common_mistakes.t' ],
		[ 'xt', 'author',   'changes.t' ],
		[ 'xt', 'author',   'version.t' ],
	);

	my %contents_of = do {
		local $INPUT_RECORD_SEPARATOR = undef;
		( q{}, split m{_____\[ [ ] (\S+) [ ] \]_+\n}smx,  );
	};

	for ( values %contents_of ) {
		s/^!=([[:lower:]])/=$1/gxms;
	}

	for my $ref_path (@files) {
		my $abs_path =
		  File::Spec->catfile( $ENV{HOME}, '.module-starter', 'CSJEWELL',
			@{$ref_path} );
		print {*STDERR} "\t$abs_path...";
		open my $fh, '>', $abs_path or die "$abs_path: $OS_ERROR\n";
		print {$fh} $contents_of{ $ref_path->[-1] }
		  or die "$abs_path: $OS_ERROR\n";
		close $fh or die "$abs_path: $OS_ERROR\n";
		print {*STDERR} "done\n";
	}
	print {*STDERR} "Installation complete.\n";

	exit;
} ## end sub import

sub _prompt_for {
	my ($requested_info) = @_;
	my $response;
  RESPONSE: while (1) {
		print "Please enter $requested_info: ";
		$response = <>;
		if ( not defined $response ) {
			warn "\n[Installation cancelled]\n";
			exit;
		}
		$response =~ s/\A \s+ | \s+ \Z//gxms;
		last RESPONSE if $response =~ m{\S}sm;
	}
	return $response;
} ## end sub _prompt_for


1;                                     # Magic true value required at end of module

__DATA__