File Coverage

blib/lib/App/Module/Template.pm

Criterion	Covered	Total	%
statement	145	146	99.3
branch	25	26	96.1
condition	9	9	100.0
subroutine	28	28	100.0
pod	1	1	100.0
total	208	210	99.0

package App::Module::Template;

use 5.016;

use strict;
use warnings;

our $VERSION = '0.11';

use base qw(Exporter);

use App::Module::Template::Initialize;

use Carp;
use Config::General;
use File::Copy;
use File::HomeDir;
use File::Path qw/make_path/;
use File::Spec;
use Getopt::Std;
use POSIX qw(strftime);
use Template;
use Try::Tiny;

our (@EXPORT_OK, %EXPORT_TAGS);
@EXPORT_OK = qw(
    run
    _get_config
    _get_config_path
    _get_module_dirs
    _get_module_fqfn
    _get_template_path
    _module_path_exists
    _process_dirs
    _process_file
    _process_template
    _validate_module_name
);
%EXPORT_TAGS = (
    ALL => [ @EXPORT_OK ],
);

#-------------------------------------------------------------------------------
sub run {
    my $class = shift;

    my %opt;
    # -c config file
    # -m module name
    # -t template dir, location of template files
    getopts('c:m:t:', \%opt);

    unless ( ( exists $opt{m} ) and ( defined $opt{m} ) ) {
        croak "-m  is required. exiting...\n";
    }

    my $module   = $opt{m};
    my $dist     = $module; $dist =~ s/::/-/gmsx;
    my $file     = $module; $file =~ s/.*:://msx; $file .= '.pm';
    my $dist_dir = File::Spec->catdir( File::Spec->curdir, $dist );
    my $tmpl_vars;

    try {
        _validate_module_name($module);
    } catch {
        croak "$_ module-template. exiting...";
    };

    if ( _module_path_exists($dist_dir) ) {
        croak "Destination directory $dist_dir exists. exiting...";
    }

    my $template_dir = _get_template_path($opt{t});

    my $config_file = _get_config_path($opt{c}, $template_dir);

    my $cfg = _get_config($config_file);

    # Setting this lets TT2 handle creating the destination files/directories
    $cfg->{template_toolkit}{OUTPUT_PATH} = $dist_dir;

    my $tt2 = Template->new( $cfg->{template_toolkit} );

    # don't need this in the $tmpl_vars
    delete $cfg->{template_toolkit};

    my $dirs = _get_module_dirs( $module );

    # Template Vars
    $tmpl_vars = $cfg;
    $tmpl_vars->{module} = $module;
    $tmpl_vars->{today} = strftime('%Y-%m-%d', localtime());
    $tmpl_vars->{year} = strftime('%Y', localtime());
    $tmpl_vars->{module_path} = File::Spec->catfile( @{$dirs}, $file );

    _process_dirs($tt2, $tmpl_vars, $template_dir, $template_dir);

    # add the distribution dir to the front so our module ends up in the
    # right place
    unshift @{$dirs}, $dist_dir;

    my $fqfn = _get_module_fqfn( $dirs, $file );

    # create the module directory to receive the named module.pm
    make_path( File::Spec->catdir( @{$dirs} ) );

    # rename the template file with the module file name
    move( File::Spec->catfile( $dist_dir, 'lib', 'Module.pm' ), $fqfn );

    return 1;
}

#-------------------------------------------------------------------------------
sub _get_config {
    my ($config_file) = @_;

    my %cfg = Config::General->new(
            -ConfigFile            => $config_file,
            -MergeDuplicateBlocks  => 1,
            -MergeDuplicateOptions => 1,
            -AutoLaunder           => 1,
            -SplitPolicy           => 'equalsign',
            -InterPolateVars       => 1,
            -UTF8                  => 1,
    )->getall() or croak "Could not read configuration file $config_file";

    return \%cfg;
}

#-------------------------------------------------------------------------------
sub _get_config_path {
    my ($opt, $template_dir) = @_;

    my $config_file;

    if ( defined $opt ) {
        $config_file = $opt;
    }
    else {
        $config_file = File::Spec->catfile( $template_dir, '../config' );
    }

    unless ( -f $config_file ) {
        croak "Could not locate configuration file $config_file\n";
    }

    return $config_file;
}

#-------------------------------------------------------------------------------
# Split the module name into directories
#-------------------------------------------------------------------------------
sub _get_module_dirs {
    my ($module) = @_;

    my @dirs = split( /::/msx, $module );

    # remove the last part of the module name because that will be the filename
    pop @dirs;

    unshift @dirs, 'lib';

    return \@dirs;
}

#-------------------------------------------------------------------------------
# Return the path to the fully qualified file name
#-------------------------------------------------------------------------------
sub _get_module_fqfn {
    my ($dirs, $file_name) = @_;

    return File::Spec->catfile( @{$dirs}, $file_name );
}

#-------------------------------------------------------------------------------
sub _get_template_path {
    my ($opt) = @_;

    my $template_dir;

    if ( defined $opt ) {

        unless ( -d $opt ) {
            croak "Template directory $opt does not exist";
        }

        $template_dir = $opt;
    }
    else {
        $template_dir  = File::Spec->catdir( File::HomeDir->my_home(), '.module-template', 'templates' );

        unless ( -d $template_dir ) {
            # initialize .module-template in user's home directory
            App::Module::Template::Initialize::module_template();
        }
    }

    return $template_dir;
}

#-------------------------------------------------------------------------------
sub _module_path_exists {
    my ($module_path) = @_;

    if ( ( defined $module_path ) and ( -d $module_path ) ) {
        return 1;
    }

    return;
}

#-------------------------------------------------------------------------------
# Walk the template directory
#-------------------------------------------------------------------------------
sub _process_dirs {
    my ($tt2, $tmpl_vars, $template_dir, $source) = @_;

    if ( -d $source ) {
        my $dir;

        unless ( opendir $dir, $source ) {
            croak "Couldn't open directory $source: $!; skipping.\n";
        }

        while ( my $file = readdir $dir ) {
            next if $file eq '.' or $file eq '..';

            my $target = File::Spec->catfile($source, $file);

            _process_dirs($tt2, $tmpl_vars, $template_dir, $target);
        }

        closedir $dir;
    }
    else {
        my $output = _process_file($template_dir, $source);

        _process_template($tt2, $tmpl_vars, $source, $output);
    }

    return $source;
}

#-------------------------------------------------------------------------------
# Return the output path for TT2
#-------------------------------------------------------------------------------
sub _process_file {
    my ($template_dir, $source_file) = @_;

    # regex matches paths on *nix or *dos
    my ($stub) = $source_file =~ m{\A$template_dir[/\\](.*)\z}mosx;

    return $stub;
}

#-------------------------------------------------------------------------------
sub _process_template {
    my ($tt2, $tmpl_vars, $template, $output) = @_;

    $tt2->process($template, $tmpl_vars, $output) or croak $tt2->error();

    return $template;
}

#-------------------------------------------------------------------------------
# Validate the module naming convention
#
# 1. No top-level namespaces
# 2. No all lower case names
# 3. Match XXX::XXX
#-------------------------------------------------------------------------------
sub _validate_module_name {
    my ($module_name) = @_;

    given ( $module_name ) {
        when ( $module_name =~ m/\A[A-Za-z]+\z/msx )
        {
            croak "'$module_name' is a top-level namespace";
        }
        when ( $module_name =~ m/\A[a-z]+\:\:[a-z]+/msx )
        {
            croak "'$module_name' is an all lower-case namespace";
        }
        # module name conforms
        when ( $module_name =~ m/\A[A-Z][A-Za-z]+(?:\:\:[A-Z][A-Za-z]+)+\z/msx )
        {
            return 1;
        }
        default {
            croak "'$module_name' does not meet naming requirements";
        }
    }
}

1;

__END__