File Coverage

blib/lib/Dist/Mgr.pm

Criterion	Covered	Total	%
statement	512	559	91.5
branch	177	240	73.7
condition	52	68	76.4
subroutine	77	92	83.7
pod	34	34	100.0
total	852	993	85.8

package Dist::Mgr;

use strict;
use warnings;
use version;

use Capture::Tiny qw(:all);
use Carp qw(croak cluck);
use CPAN::Uploader;
use Cwd qw(getcwd);
use Data::Dumper;
use Digest::SHA;
use Dist::Mgr::FileData qw(:all);
use Dist::Mgr::Git qw(:all);
use File::Copy;
use File::Copy::Recursive qw(rmove_glob);
use File::Path qw(make_path rmtree);
use File::Find::Rule;
use JSON;
use Module::Starter;
use PPI;
use Term::ReadKey;
use Tie::File;

use Exporter qw(import);
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(
    add_bugtracker
    add_repository
    changes
    changes_bump
    changes_date
    ci_badges
    ci_github
    config
    config_file
    copyright_info
    copyright_bump
    cpan_upload
    git_add
    git_commit
    git_clone
    git_pull
    git_push
    git_ignore
    git_release
    git_repo
    git_status_differs
    git_tag
    init
    make_dist
    make_distclean
    make_manifest
    make_test
    manifest_skip
    manifest_t
    move_distribution_files
    remove_unwanted_files
    version_bump
    version_incr
    version_info
);
our @EXPORT_PRIVATE = qw(
    _dist_dir_re
    _validate_git
);
our %EXPORT_TAGS = (
    all     => [@EXPORT_OK],
    private => _export_private(),
);

our $VERSION = '1.14';

use constant {
    CONFIG_FILE         => 'dist-mgr.json',
    GITHUB_CI_FILE      => 'github_ci_default.yml',
    GITHUB_CI_PATH      => '.github/workflows/',
    CHANGES_FILE        => 'Changes',
    CHANGES_ORIG_SHA    => '97624d56464d7254ef5577e4a0c8a098d6c6d9e6', # Module::Starter version
    FSTYPE_IS_DIR       => 1,
    FSTYPE_IS_FILE      => 2,
    DEFAULT_DIR         => 'lib/',
    DEFAULT_POD_DIR     => '.',
    MAKE                => $^O =~ /win32/i ? 'gmake' : 'make',
};

# Public

sub add_bugtracker {
    my ($author, $repo, $makefile) = @_;

    if (! defined $author || ! defined $repo) {
        croak("Usage: add_bugtracker(\$author, \$repository_name)\n");
    }

    $makefile //= 'Makefile.PL';

    _makefile_insert_bugtracker($author, $repo, $makefile);
}
sub add_repository {
    my ($author, $repo, $makefile) = @_;

    if (! defined $author || ! defined $repo) {
        croak("Usage: add_repository(\$author, \$repository_name)\n");
    }

    $makefile //= 'Makefile.PL';

    _makefile_insert_repository($author, $repo, $makefile);
}
sub changes {
    my ($module, $file) = @_;

    croak("changes() needs a module parameter") if ! defined $module;

    $file //= 'Changes';

    # Overwrite the Changes file if there aren't any dates in it

    my @contents;

    my $changes_date_count = 0;

    if (-e $file) {
        my ($contents, $tie) = _changes_tie($file);
        $changes_date_count = grep /\d{4}-\d{2}-\d{2}/, $contents;
        untie $tie;
    }
    if (! -e $file || ! $changes_date_count) {
        my @contents = _changes_file($module);
        _changes_write_file($file, \@contents);
    }

    return @contents;
}
sub changes_bump {
    my ($version, $file) = @_;

    croak("changes_bump() requires a version sent in") if ! defined $version;
    _validate_version($version);

    $file //= 'Changes';

    my ($contents, $tie) = _changes_tie($file);

    for (0..$#$contents) {
        if ($contents->[$_] =~ /^\d+\.\d+\s+/) {
            $contents->[$_-1] = "\n$version UNREL\n    -\n\n";
            last;
        }
    }

    untie $tie;
}
sub changes_date {
    my ($file) = @_;

    $file //= 'Changes';

    my ($contents, $tie) = _changes_tie($file);

    my ($d, $m, $y) = (localtime)[3, 4, 5];
    $y += 1900;
    $m += 1;

    $m = "0$m" if length $m == 1;
    $d = "0$d" if length $d == 1;

    for (0..$#$contents) {
        if ($contents->[$_] =~ /^(.*)\s+UNREL/) {
            $contents->[$_] = "$1    $y-$m-$d";
            last;
        }
    }

    untie $tie;
}
sub ci_badges {
    if (scalar @_ < 2) {
        croak("ci_badges() needs \$author and \$repo sent in");
    }

    my ($author, $repo, $fs_entry) = @_;

    $fs_entry //= DEFAULT_DIR;

    my $exit = 0;

    for (_module_find_files($fs_entry)) {
        $exit = -1 if _module_insert_ci_badges($author, $repo, $_) == -1;
    }

    return $exit;
}
sub ci_github {
    my ($os) = @_;

    if (defined $os && ref $os ne 'ARRAY') {
        croak("\$os parameter to ci_github() must be an array ref");
    }

    # Add the CI file to MANIFEST.SKIP

    if (-e 'MANIFEST.SKIP') {
        open my $fh, '<', 'MANIFEST.SKIP'
            or croak("Can't open MANIFEST.SKIP for reading");

        my @makefile_skip_contents = <$fh>;

        if (grep !m|\.github$|, @makefile_skip_contents) {
            close $fh;
            open my $wfh, '>>', 'MANIFEST.SKIP'
                or croak("Can't open MANIFEST.SKIP for writing");

            print $wfh '^\.github/';
        }
    }
    else {
        open my $wfh, '>>', 'MANIFEST.SKIP'
            or croak("Can't open MANIFEST.SKIP for writing");

        print $wfh '^\.github/';
    }

    my @contents = _ci_github_file($os);
    _ci_github_write_file(\@contents);

    return @contents;
}
sub config {
    my ($args, $file) = @_;

    if (! defined $args) {
        croak("config() requires \$args hash reference parameter");
    }
    elsif (ref $args ne 'HASH') {
        croak("\$args parameter must be a hash reference.");
    }

    $file = config_file() if ! defined $file;
    my $conf;

    if (-e $file && -f $file) {
        {
            local $/;
            open my $fh, '<', $file or croak "Can't open config file $file: $!";
            my $json = <$fh>;
            $conf = decode_json $json;

            for (keys %{ $conf }) {
                delete $conf->{$_} if $conf->{$_} eq '';
            }
        }
    }
    else {
        # No config file present
        _config_file_write($file, _config_file());

        print "\nGenerated new configuration file: $file\n";
    }

    %{ $args } = (%{ $args }, %{ $conf }) if $conf;

    return $args;
}
sub config_file {
    my $file = $^O =~ /win32/i
        ? "$ENV{USERPROFILE}/${\CONFIG_FILE}"
        : "$ENV{HOME}/${\CONFIG_FILE}";

    return $file;
}
sub copyright_bump {
    my ($fs_entry) = @_;

    $fs_entry //= DEFAULT_POD_DIR;
    _validate_fs_entry($fs_entry);

    my ($year) = (localtime)[5];
    $year += 1900;

    my @pod_files = _pod_find_files($fs_entry);
    my %info;

    for my $pod_file (@pod_files) {
        my ($contents, $tie) = _pod_tie($pod_file);

        for (0 .. $#$contents) {
            # Match a single year (Copyright 2016), a dash range
            # (Copyright 2016-2019) or a comma range (Copyright 2016,2019)
            if ($contents->[$_] =~ /^(Copyright\s+)(\d{4})(?:\s*[-,]\s*(\d{4}))?(\s+.*)/) {
                my ($prefix, $first, $second, $rest) = ($1, $2, $3, $4);

                if (defined $second) {
                    # A range: keep the first year, bump the latter to the
                    # current year, and normalize the separator to a dash
                    $contents->[$_] = "$prefix$first-$year$rest";
                }
                else {
                    # A single year: replace it with the current year
                    $contents->[$_] = "$prefix$year$rest";
                }

                $info{$pod_file} = $year;
                last;
            }
        }
        untie $tie;
    }

    return \%info;
}
sub copyright_info {
    my ($fs_entry) = @_;

    $fs_entry //= DEFAULT_POD_DIR;

    _validate_fs_entry($fs_entry);

    my @pod_files = _pod_find_files($fs_entry);

    my %copyright_info;

    for my $file (@pod_files) {
        my $copyright = _pod_extract_file_copyright($file);
        next if ! defined $copyright || $copyright !~ /^\d{4}$/;
        $copyright_info{$file} = $copyright if defined $copyright;
    }

    return \%copyright_info;
}
sub cpan_upload {
    my ($dist_file_name, %args) = @_;

    config(\%args);

    if (! defined $dist_file_name) {
        croak("cpan_upload() requires the name of a distribution file sent in");
    }

    if (! -f $dist_file_name) {
        croak("File name sent to cpan_upload() isn't a valid file");
    }

    $args{user}     //= $args{cpan_id};
    $args{password} //= $args{cpan_pw};

    $args{user} = $ENV{CPAN_USERNAME} if ! $args{user};
    $args{password} = $ENV{CPAN_PASSWORD} if ! $args{password};

    if (! $args{user} || ! $args{password}) {
        croak("\ncpan_upload() requires --cpan_id and --cpan_pw");
    }

    if ($args{dry_run}) {
        print "\nCPAN upload is in dry run mode... nothing will be uploaded\n";
    }

    CPAN::Uploader->upload_file(
        $dist_file_name,
        \%args
    );

    print "\nSuccessfully uploaded $dist_file_name to the CPAN\n";

    return %args;
}
sub git_add {
    _git_add();
}
sub git_ignore {
    my ($dir) = @_;

    $dir //= '.';

    my @content = _git_ignore_file();

    _git_ignore_write_file($dir, \@content);

    return @content;
}
sub git_commit {
    _git_commit(@_);
}
sub git_clone {
    _git_clone(@_);
}
sub git_push {
    _git_push(@_);
}
sub git_pull {
    _git_pull(@_);
}
sub git_release {
    _git_release(@_);
}
sub git_repo {
    _git_repo();
}
sub git_status_differs {
    _git_status_differs(@_);
}
sub git_tag {
    _git_tag(@_);
}
sub init {
    my (%args) = @_;

    config(\%args);

    my $cwd = getcwd();

    if ($cwd =~ _dist_dir_re()) {
        croak "Can't run init() while in the '$cwd' directory";
    }

    $args{license} = 'artistic2' if ! exists $args{license};
    $args{builder} = 'ExtUtils::MakeMaker';

    for (qw(modules author email)) {
        if (! exists $args{$_}) {
            croak("init() requires '$_' in the parameter hash");
        }
    }

    if (ref $args{modules} ne 'ARRAY') {
        croak("init()'s 'modules' parameter must be an array reference");
    }

    # Module::Starter 1.79+ added multi-author support and now requires
    # 'author' to be an arrayref of 'Name ' strings; older versions
    # expect a plain scalar. Normalize for the installed version while
    # leaving $args{author} untouched for _module_write_template() below
    my %distro_args = %args;

    if ($Module::Starter::VERSION >= 1.79) {
        $distro_args{author} = ["$args{author} <$args{email}>"];
    }

    if ($args{verbose}) {
        delete $distro_args{verbose};
        Module::Starter->create_distro(%distro_args);
    }
    else {
        capture_merged {
            Module::Starter->create_distro(%distro_args);
        };
    }

    my ($module) = (@{ $args{modules} })[0];
    my $module_file = $module;
    $module_file =~ s/::/\//g;
    $module_file = "lib/$module_file.pm";

    my $module_dir = $module;
    $module_dir =~ s/::/-/g;

    chdir $module_dir or croak("Can't change into directory '$module_dir'");

    unlink $module_file
        or croak("Can't delete the Module::Starter module '$module_file': $!");

    _module_write_template($module_file, $module, $args{author}, $args{email});

    chdir '..' or croak "Can't change into original directory";
}
sub manifest_skip {
    my ($dir) = @_;

    $dir //= '.';

    my @content = _manifest_skip_file();

    _manifest_skip_write_file($dir, \@content);

    return @content;
}
sub manifest_t {
    my ($dir) = @_;

    $dir //= './t';

    my @content = _manifest_t_file();

    _manifest_t_write_file($dir, \@content);

    return @content;
}
sub move_distribution_files {
    my ($module) = @_;

    if (! defined $module) {
        croak("_move_distribution_files() requires a module name sent in");
    }

    my $module_dir = $module;
    $module_dir =~ s/::/-/g;

    my @move_count = rmove_glob("$module_dir/*", '.')
        or croak("Can't move files from the '$module_dir' directory: $!");

    my $dist_count = _default_distribution_file_count();

    for my $outer_idx (0..$#move_count) {
        my $outer = $move_count[$outer_idx];
        for my $inner_idx (0..$#$outer) {
            my $inner = $move_count[$outer_idx][$inner_idx];
            for (0..$#$inner) {
                if ($inner->[$_] != $dist_count->[$outer_idx][$inner_idx][$_]) {
                    croak("Results from the move are mismatched... bailing out");
                }
            }
        }
    }

    rmtree $module_dir or croak("Couldn't remove the '$module_dir' directory");

    return 0;
}
sub remove_unwanted_files {
    for (_unwanted_filesystem_entries()) {
        rmtree $_;
    }
    make_manifest();
    return 0;
}
sub make_dist {
    my ($verbose) = @_;

    my $cmd = "${\MAKE} dist";
    $verbose ? `$cmd` : capture_merged {`$cmd`};

    if ($? != 0) {
        croak("Exit code $? returned... '${\MAKE} dist' failed");
    }

    return $?;
}
sub make_distclean {
    my ($verbose) = @_;

    my $cmd = "${\MAKE} distclean";
    $verbose ? print `$cmd` : capture_merged {`$cmd`};

    if ($? != 0) {
        croak("Exit code $? returned... '${\MAKE} distclean' failed\n");
    }

    return $?;
}
sub make_manifest {
    my ($verbose) = @_;

    if ($verbose) {
        if (-f 'MANIFEST') {
            unlink 'MANIFEST' or die "make_manifest() Couldn't remove MANIFEST\n";
        }
        print `$^X Makefile.PL`;
        print `${\MAKE} manifest`;
        make_distclean($verbose);
    }
    else {
        capture_merged {
            if (-f 'MANIFEST') {
                unlink 'MANIFEST' or die "make_manifest() Couldn't remove MANIFEST\n";
            }
            `$^X Makefile.PL`;
            `${\MAKE} manifest`;
            make_distclean($verbose);
        };
    }

    if ($? != 0) {
        croak("Exit code $? returned... '${\MAKE} manifest' failed\n");
    }

    return $?;
}
sub make_test {
    my ($verbose) = @_;

    if ($verbose) {
        print `$^X Makefile.PL`;
        print `${\MAKE} test`;
    }
    capture_merged {
        `$^X Makefile.PL`;
        `${\MAKE} test`;
    };

    if ($? != 0) {
        croak("Exit code $? returned... '${\MAKE} test' failed\n");
    }

    return $?;
}
sub version_bump {
    my ($version, $fs_entry) = @_;

    my $dry_run = 0;

    if (defined $version && $version =~ /^-/) {
        print "\nDry run\n\n";
        $version =~ s/-//;
        $dry_run = 1;
    }

    $fs_entry //= DEFAULT_DIR;

    _validate_version($version);
    _validate_fs_entry($fs_entry);

    my @module_files = _module_find_files($fs_entry);

    my %files;

    for (@module_files) {
        my $current_version = _module_extract_file_version($_);
        my $version_line    = _module_extract_file_version_line($_);
        my @file_contents   = _module_fetch_file_contents($_);

        if (! defined $version_line) {
            next;
        }

        if (! defined $current_version) {
            next;
        }

        if (version->parse($current_version) >= version->parse($version)) {
            croak(
                "Your new version $version must be greater than the current " .
                    "one, $current_version"
            );
        }

        my $mem_file;

        open my $wfh, '>', \$mem_file or croak("Can't open mem file!: $!");

        for my $line (@file_contents) {
            chomp $line;

            if ($line eq $version_line) {
                $line =~ s/$current_version/$version/;
            }

            $line .= "\n";

            # Write out the line to the in-memory temp file
            print $wfh $line;

            $files{$_}{from}    = $current_version;
            $files{$_}{to}      = $version;
        }

        close $wfh;

        $files{$_}{dry_run} = $dry_run;
        $files{$_}{content} = $mem_file;

        if (! $dry_run) {
            # Write out the actual file
            _module_write_file($_, $mem_file);
        }
    }
    return \%files;
}
sub version_incr {
    my ($version) = @_;

    croak("version_incr() needs a version number sent in") if ! defined $version;

    _validate_version($version);

    # Increment the least-significant digit while preserving the version's
    # precision (eg. 3.1802 -> 3.1803, not 3.19)

    my $decimals  = $version =~ /\.(\d+)$/ ? length $1 : 0;
    my $increment = 1 / 10 ** $decimals;

    return sprintf("%.${decimals}f", $version + $increment);
}
sub version_info {
    my ($fs_entry) = @_;

    $fs_entry //= DEFAULT_DIR;

    _validate_fs_entry($fs_entry);

    my @module_files = _module_find_files($fs_entry);

    my %version_info;

    for (@module_files) {
        my $version = _module_extract_file_version($_);
        $version_info{$_} = $version;
    }

    return \%version_info;
}

# Changes file related

sub _changes_tie {
    # Ties the Changes file to an array

    my ($changes) = @_;
    croak("_changes_tie() needs a Changes file name sent in") if ! defined $changes;

    my $tie = tie my @changes, 'Tie::File', $changes;
    return (\@changes, $tie);
}
sub _changes_write_file {
    # Writes out the custom Changes file

    my ($file, $content) = @_;

    open my $fh, '>', $file or cluck("Can't open file $file: $!");

    for (@$content) {
        print $fh "$_\n"
    }

    close $fh;

    return 0;
}

# CI related

sub _ci_github_write_file {
    # Writes out the Github Actions config file

    my ($contents) = @_;

    if (ref $contents ne 'ARRAY') {
        croak("_ci_github_write_file() requires an array ref of contents");
    }

    my $ci_file //= GITHUB_CI_PATH . GITHUB_CI_FILE;

    make_path(GITHUB_CI_PATH) if ! -d GITHUB_CI_PATH;

    open my $fh, '>', $ci_file or croak $!;

    print $fh "$_\n" for @$contents;
}

# Configuration related

sub _config_file_write {
    my ($file, $contents) = @_;

    if (ref $contents ne 'HASH') {
        croak("_config_file_write() requires a hash ref of contents");
    }

    my $jobj = JSON->new;

    my $json = $jobj->pretty->encode($contents);

    open my $fh, '>', $file or croak "Can't open config $file for writing: $!";

    print $fh $json;

}

# Distribution related

sub _default_distribution_file_count {
    # Returns the file count in a distribution
    # This is used to ensure everything moved OK

    return [
        [ [1, 0, 0] ],
        [ [1, 0, 0] ],
        [ [3, 2, 0] ],
        [ [1, 0, 0] ],
        [ [1, 0, 0] ],
        [ [1, 0, 0] ],
        [ [5, 1, 0] ],
        [ [2, 1, 0] ],
    ];
}

# Git related

sub _git_ignore_write_file {
    # Writes out the .gitignore file

    my ($dir, $content) = @_;

    open my $fh, '>', "$dir/.gitignore" or croak $!;

    for (@$content) {
        print $fh "$_\n"
    }

    return 0;
}

# Makefile related

sub _makefile_tie {
    # Ties the Makefile.PL file to an array

    my ($mf) = @_;
    croak("_makefile_tie() needs a Makefile name sent in") if ! defined $mf;

    my $tie = tie my @mf, 'Tie::File', $mf;
    return (\@mf, $tie);
}
sub _makefile_insert_meta_merge {
    # Inserts the META_MERGE section into Makefile.PL

    my ($mf) = @_;

    croak("_makefile_insert_meta_merge() needs a Makefile tie sent in") if ! defined $mf;

    # Check to ensure we're not duplicating
    return if grep /META_MERGE/, @$mf;

    for (0..$#$mf) {
        if ($mf->[$_] =~ /MIN_PERL_VERSION/) {
            splice @$mf, $_+1, 0, _makefile_section_meta_merge();
            last;
        }
    }
}
sub _makefile_insert_bugtracker {
    # Inserts bugtracker information into Makefile.PL

    my ($author, $repo, $makefile) = @_;

    if (! defined $makefile) {
        croak("_makefile_insert_bugtracker() needs author, repo and makefile");
    }

    my ($mf, $tie) = _makefile_tie($makefile);

    return -1 if grep /bugtracker/, @$mf;

    if (grep ! /META_MERGE/, @$mf) {
        _makefile_insert_meta_merge($mf);
    }

    for (0..$#$mf) {
        if ($mf->[$_] =~ /resources   => \{/) {
            splice @$mf, $_+1, 0, _makefile_section_bugtracker($author, $repo);
            last;
        }
    }
    untie $tie;

    return 0;
}
sub _makefile_insert_repository {
    # Inserts repository information to Makefile.PL

    my ($author, $repo, $makefile) = @_;

    if (! defined $makefile) {
        croak("_makefile_insert_repository() needs author, repo and makefile");
    }

    my ($mf, $tie) = _makefile_tie($makefile);

    return -1 if grep /repository/, @$mf;

    if (grep ! /META_MERGE/, @$mf) {
        _makefile_insert_meta_merge($mf);
    }

    for (0..$#$mf) {
        if ($mf->[$_] =~ /resources   => \{/) {
            splice @$mf, $_+1, 0, _makefile_section_repo($author, $repo);
            last;
        }
    }
    untie $tie;

    return 0;
}

# MANIFEST related

sub _manifest_skip_write_file {
    # Writes out the MANIFEST.SKIP file

    my ($dir, $content) = @_;

    open my $fh, '>', "$dir/MANIFEST.SKIP" or croak $!;

    for (@$content) {
        print $fh "$_\n"
    }

    return 0;
}
sub _manifest_t_write_file {
    # Writes out the t/manifest.t test file

    my ($dir, $content) = @_;

    open my $fh, '>', "$dir/manifest.t"
        or croak("Can't open t/manifest.t for writing: $!\n");

    for (@$content) {
        print $fh "$_\n"
    }

    return 0;
}

# Module related

sub _module_extract_file_version {
    # Extracts the version number from a module's $VERSION definition line

    my ($module_file) = @_;

    my $version_line = _module_extract_file_version_line($module_file);

    if (defined $version_line) {

        if ($version_line =~ /=(.*)$/) {
            my $ver = $1;

            $ver =~ s/\s+//g;
            $ver =~ s/;//g;
            $ver =~ s/[a-zA-Z]+//g;
            $ver =~ s/"//g;
            $ver =~ s/'//g;

            if (! defined eval { version->parse($ver); 1 }) {
                warn("$_: Can't find a valid version\n");
                return undef;
            }

            return $ver;
        }
    }
    else {
        warn("$_: Can't find a \$VERSION definition\n");
    }
    return undef;
}
sub _module_extract_file_version_line {
    # Extracts the $VERSION definition line from a module file

    my ($module_file) = @_;

    my $doc = PPI::Document->new($module_file);

    my $token = $doc->find(
        sub {
            $_[1]->isa("PPI::Statement::Variable")
                and $_[1]->content =~ /\$VERSION/;
        }
    );

    return undef if ref $token ne 'ARRAY';

    my $version_line = $token->[0]->content;

    return $version_line;
}
sub _module_fetch_file_contents {
    # Fetches the file contents of a module file

    my ($file) = @_;

    open my $fh, '<', $file
      or croak("Can't open file '$file' for reading!: $!");

    my @contents = <$fh>;
    close $fh;
    return @contents;
}
sub _module_find_files {
    # Finds module files

    my ($fs_entry, $module) = @_;

    $fs_entry //= DEFAULT_DIR;

    if (defined $module) {
        $module =~ s/::/\//g;
        $module .= '.pm';
    }
    else {
        $module = '*.pm';
    }


    return File::Find::Rule->file()
        ->name($module)
        ->in($fs_entry);
}
sub _module_insert_ci_badges {
    # Inserts the CI and Coveralls badges into POD

    my ($author, $repo, $module_file) = @_;

    my ($mf, $tie) = _module_tie($module_file);

    return -1 if grep /badge\.svg/, @$mf;

    for (0..$#$mf) {
        if ($mf->[$_] =~ /^=head1 NAME/) {
            splice @$mf, $_+3, 0, _module_section_ci_badges($author, $repo);
            last;
        }
    }
    untie $tie;

    return 0;
}
sub _module_tie {
    # Ties a module file to an array

    my ($mod_file) = @_;
    croak("Acme-STEVEB() needs a module file name sent in") if ! defined $mod_file;

    my $tie = tie my @mf, 'Tie::File', $mod_file;
    return (\@mf, $tie);
}
sub _module_write_file {
    # Writes out a Perl module file

    my ($module_file, $content) = @_;

    open my $wfh, '>', $module_file or croak("Can't open '$module_file' for writing!: $!");

    print $wfh $content;

    close $wfh or croak("Can't close the temporary memory module file!: $!");
}
sub _module_write_template {
    # Writes out our custom module template after init()

    my ($module_file, $module, $author, $email) = @_;

    if (! defined $module_file) {
        croak("_module_write_template() needs the module's file name sent in");
    }

    if (! defined $module || ! defined $author || ! defined $email) {
        croak("_module_template_file() requires 'module', 'author' and 'email' parameters");
    }

    my @content = _module_template_file($module, $author, $email);

    open my $wfh, '>', $module_file or croak("Can't open '$module_file' for writing!: $!");

    print $wfh "$_\n" for @content;
}

# POD related

sub _pod_extract_file_copyright {
    # Extracts the copyright year from POD

    my ($module_file) = @_;

    my $copyright_line = _pod_extract_file_copyright_line($module_file);

    if (defined $copyright_line) {
        if ($copyright_line =~ /^Copyright\s+(\d{4})(?:\s*[-,]\s*(\d{4}))?\s+\w+/) {
            # For a range, report the latter (most recent) year
            return defined $2 ? $2 : $1;
        }
    }
    else {
        warn("$_: Can't find a Copyright definition\n");
    }
    return undef;
}
sub _pod_extract_file_copyright_line {
    # Extracts the Copyright line from a module file

    my ($pod_file) = @_;

    open my $fh, '<', $pod_file or croak("Can't open POD file $pod_file: $!");

    while (<$fh>) {
        if (/^Copyright\s+\d{4}(?:\s*[-,]\s*\d{4})?\s+\w+/) {
            return $_;
        }
    }
}
sub _pod_find_files {
    # Finds POD files

    my ($fs_entry) = @_;

    $fs_entry //= DEFAULT_POD_DIR;

    return File::Find::Rule->file()
        ->name('*.pod', '*.pm', '*.pl')
        ->in($fs_entry);
}
sub _pod_tie {
    # Ties a POD file to an array

    my ($pod_file) = @_;
    croak("_pod_tie() needs a POD file name sent in") if ! defined $pod_file;

    my $tie = tie my @pf, 'Tie::File', $pod_file;
    return (\@pf, $tie);
}

# Validation related

sub _dist_dir_re {
    # Capture permutations of the distribution directory for various
    # CPAN testers
    # Use YAPE::Regex::Explain for details

    return qr/dist-mgr(?:-\d+\.\d+)?(?:-\w+|_\d+)?$/i;
}
sub _validate_git {
    my $sep = $^O =~ /win32/i ? ';' : ':';
    return grep {-x "$_/git" } split /$sep/, $ENV{PATH};
}
sub _validate_fs_entry {
    # Validates a file system entry as valid

    my ($fs_entry) = @_;

    cluck("Need name of dir or file!") if ! defined $fs_entry;

    return FSTYPE_IS_DIR    if -d $fs_entry;
    return FSTYPE_IS_FILE   if -f $fs_entry;

    croak("File system entry '$fs_entry' is invalid");
}
sub _validate_version {
    # Parses a version number to ensure it is valid

    my ($version) = @_;

    croak("version parameter must be supplied!") if ! defined $version;

    if (! defined eval { version->parse($version); 1 }) {
        croak("The version number '$version' specified is invalid");
    }
}

# Miscellaneous

sub _export_private {
    push @EXPORT_OK, @EXPORT_PRIVATE;
    return \@EXPORT_OK;
}
sub __placeholder {}

1;
__END__