package Module::Cooker;

our $VERSION = 'v0.1_1';

#use 5.008_008;

use strict;
use warnings FATAL => 'all';

use Data::Dumper;

use Carp;
use Cwd ();
use Try::Tiny;

use version 0.77;

use ExtUtils::Manifest qw( mkmanifest );
use Storable (qw( dclone ));

use File::Path qw( make_path );
use File::Spec::Functions qw( catdir catfile );
use File::Which;

use POSIX qw( strftime );

use Template;

my $profile_name_rx = qr/[A-Z_a-z][A-Z_a-z0-9.-]*/;

# the following regex is ripped from Module::Runtime
# suggested by Perl Monk tobyink (http://www.perlmonks.org/?node_id=757127)
my $module_name_rx = qr/[A-Z_a-z][0-9A-Z_a-z]*(?:::[0-9A-Z_a-z]+)*/;

my $defaults = {
    minperl   => '',
    author    => 'A. Uthor',
    email     => 'author@example.com',
    profile   => 'default',
    package   => 'My::MC::Module',
    version   => 'v0.1_1',
    extravars => {},
    localdirs => [],
    nosubs    => 0,

#    nolinks => 1, # future use?
};

my @boolean_params = (
    'nosubs',

#    'nolinks', # future use?
);

sub new {
    my $class    = shift;
    my %incoming = @_;

    my $self = bless _validate_incoming( \%incoming ), $class;

    # be lazy and automatically generate accessors.
    # Perl Monk GrandFather should appreciate this. :)
    foreach my $attribute ( keys( %{$self} ) ) {
        next if $attribute =~ /^_/;
        next if $self->can($attribute);

        no strict 'refs';

        # auto-generated accessors should go in this package, not a
        # sub-class. the sub-class can always override like
        # normal if need be.
        *{ __PACKAGE__ . "::$attribute" } = sub {
            my $self = shift;

            croak "Can't set read-only attribute: $attribute" if @_;

            return $self->{$attribute};
        };
    }

    # this needs to be set at the time of instance creation because
    # if a subsequent chdir occurs the method won't be able to
    # resolve a relative path in %INC. this is specifically needed
    # for the test suite to work properly in a tmp dir.
    $self->{_basename_dir} = $self->_basename_dir;

    $self->{_made_dist_dir} = 0;
    $self->{_templates}     = {};
    $self->{_template_dirs} = [];

    return $self;
}

# NOTE: email addresses are not validated since it might be desirable to
# use an anti-SPAM pattern. i.e. "author at example dot com". suggestions
# as to how to add some form of minimal checking are welcome.
sub _validate_incoming {
    my $incoming = shift;

    my $args = {};
    for ( keys( %{$defaults} ) ) {
        $args->{$_} = delete( $incoming->{$_} ) || $defaults->{$_};
    }
    croak 'Unknown parameter(s): ' . join( ', ', keys( %{$incoming} ) )
      if keys( %{$incoming} );

    croak "Parameter 'package' must be supplied"
      unless $args->{package};
    croak "Invalid package name: $args->{package}"
      unless $args->{package} =~ /\A$module_name_rx\z/o;

    croak "Illegal profile name: $args->{profile}"
      unless $args->{profile} =~ /\A$profile_name_rx\z/o;

    # ensure that boolean params have boolean values
    for (@boolean_params) {
        my $orig = $args->{$_};
        $args->{$_} = !!$args->{$_} || 0;
        croak "Boolean param $_ must be '0' or '1': $orig ne $args->{$_}"
          unless $args->{$_} eq $orig;
    }

    try {
        version->parse( $args->{version} );
    }
    catch {
        croak $_;
    };

    croak "Param 'extravars' must be a hashref"
      unless ( ref( $args->{extravars} ) || '' ) eq 'HASH';

    croak "Param 'localdirs' must be an arrayref"
      unless ( ref( $args->{localdirs} ) || '' ) eq 'ARRAY';

    return $args;
}

# used to build path to where the main package module will be placed
# in the distribution dir.
sub _lib_path {
    my $self = shift;

    my @parts = split( /::/, $self->{package} );
    pop(@parts);    # remove basename

    unshift( @parts, 'lib' );

    return join( '/', @parts );
}

# used to find the location of THIS module. assumes that all support
# dirs will be under a directory named after this module (without
# the '.pm')
# NOTE! this is a class method that doesn't check the 'cached' value.
# YOU WILL BE SURPRISED if there has been an intervening chdir operation!
# see the public 'basename_dir' method for normal use.
sub _basename_dir {
    my $package = __PACKAGE__;

    $package =~ s/::/\//g;
    my $packpath = $INC{ join( '.', $package, 'pm' ) };
    $packpath =~ s/\.pm$//;

    my $realpath = Cwd::realpath($packpath);

    return $realpath;
}

# create the dist dir in the cwd
sub _make_dist_dir {
    my $self = shift;

    # croak if a fatal error occurs, better to die here than later
    try {
        make_path( $self->dist_name ) or die $!;
        $self->{_made_dist_dir} = 1;
    }
    catch {
        die "Can not make distribution dir: $_";
    };

    return;
}

# builds a hash that will be passed to Template
sub _package_info {
    my $self = shift;

    my $module_path = catfile( $self->_lib_path, $self->module_name );

    my $package = {
        name       => $self->{package},
        dist_name  => $self->dist_name,
        libpath    => $self->_lib_path,
        module     => $self->module_name,
        modulepath => $module_path,
        version    => $self->{version},
        minperl    => $self->{minperl},
        timestamp  => strftime( '%Y-%m-%d %T', localtime() ),
        year       => strftime( '%Y', localtime() ),
    };

    return $package;
}

# builds a hash that will be passed to Template
sub _author_info {
    my $self = shift;

    my $author = {
        name  => $self->{author},
        email => $self->{email},
    };

    return $author;
}

# builds path to where standard templates for a given profile are located
sub _profile_dir {
    my $self = shift;

    my $dir = catdir( $self->basename_dir, $self->{profile} );

    -d $dir ? return $dir : return;
}

sub _include_path {
    my $self = shift;

    return $self->{_include_path} if $self->{_include_path};
}

sub _process_template {
    my $self = shift;
    my %args = @_;

    # Template will automatically create missing dirs, but doing this
    # allows for bailing out if the main dist dir already exists.
    # having the test here ensures catching such a condition at a
    # common point that is less likely to be skipped over.
    if ( !$self->{_made_dist_dir} ) {
        my $direxists = !!( -d $self->dist_name );
        die "Distribution directory already exists: " . $self->dist_name
          if -d $self->dist_name;

        # dist dir does not exist. this also sets _made_dist_dir
        $self->_make_dist_dir;
    }

    die "Template name missing!" unless $args{template};

    my $outfile;
    if ( $args{template} =~ /^Module\.pm$/ ) {    # gets speical treatment
        $outfile = catfile( $self->_lib_path, $self->module_name );
    } else {
        $outfile = $args{template};
    }

# need to add logic to add paths for INCLUDE directives to INCLIDE_PATH

    # this is a seperate stucture to all for a future method to let
    # users specify additional config options similar to how
    # extravars work.
    my $tt_config = {
        TRIM         => 0,
        PRE_CHOMP    => 0,
        POST_CHOMP   => 0,
        INCLUDE_PATH => \@{ $self->profile_dirs },
        OUTPUT_PATH  => $self->dist_name,
    };
    my $t = Template->new($tt_config);

    my $vars = $self->template_data;

    $t->process( $args{template}, $vars, $outfile ) || die $t->error . "\n";

    return;
}

sub _gather_profile {
    my $self = shift;
    my %args = @_;

    my $dir    = $args{abs_path};
    my $subdir = $args{subdir_path};

    die "Can't find dir: $dir\n" unless -d $dir;

    opendir( my $dh, $dir ) or die "can't opendir $dir: $!";
    my @files = readdir($dh);
    closedir $dh;

    my $std_dir = $self->_profile_dir;
    my $src_type = ( $dir =~ /^(?:$std_dir)/ ) ? 'standard' : 'local';

    for my $fname (@files) {
        next if $fname =~ m{^\.{1,2}\z};

        my $fpath = File::Spec->catfile( $dir, $fname );

        # $fpath = readlink($fpath) if -l $fpath;

        # don't follow symlinks for now.
        # use nolinks param to control this later if desired.
        next if -l $fpath;

        if ( -d $fpath ) {
            if ( $self->{nosubs} ) {
                warn "Skipping profile sub-directory: $fpath\n";
                next;
            }

            my $subpath = $subdir ? catdir( $subdir, $fname ) : $fname;

            try {
                push( @{ $self->{_template_dirs} }, $subpath );

                # trust perl's deep recursion detection
                $self->_gather_profile(
                    abs_path    => $fpath,
                    subdir_path => $subpath
                );
            }
            catch {
                die $_;
            };

            next;
        }

        next unless -f $fpath;

        my $template = $subdir ? catfile( $subdir, $fname ) : $fname;
#        $self->{_templates}{$template} = catfile( $dir, $subdir )
        $self->{_templates}{$template} = $src_type
          unless $self->{_templates}{$template};
    }

    return;
}

# future use? considering an option to pass Template through perltidy
sub _perltidy_cmd {
    my $tidy = which('perltidy');

    return $tidy;
}

# override the default accessor generation to ensure a copy is made
sub extravars {
    my $self = shift;

    croak "Can't set read-only attribute: extravars" if @_;

    my $tmp       = $self->{extravars};
    my $extravars = dclone($tmp);

    return wantarray ? %{$extravars} : $extravars;
}

# override the default accessor generation to ensure a copy is made
sub localdirs {
    my $self = shift;

    croak "Can't set read-only attribute: localdirs" if @_;

    my @localdirs = @{ $self->{localdirs} };

    return wantarray ? @localdirs : \@localdirs;
}

# return a list of dirs that actually contain the requested profile
sub profile_dirs {
    my $self = shift;

    croak "Can't set read-only method: profile_dirs" if @_;

    my @searchdirs = $self->localdirs;
    push( @searchdirs, $self->basename_dir );

    my @profile_dirs;
    for (@searchdirs) {
        my $profile_dir = catdir( $_, $self->profile );
        push( @profile_dirs, $profile_dir ) if -d $profile_dir;
    }

    return wantarray ? @profile_dirs : \@profile_dirs;
}

sub basename_dir {
    my $self = shift;

    croak "Can't set read-only method: basename_dir" if @_;

    return $self->{_basename_dir};
}

# builds list of final attribute values
sub summary {
    my $self = shift;

    croak "Can't set read-only method: summary" if @_;

    my $tmp = {};
    for ( keys( %{$self} ) ) {
        next if /^_/;    # we only want the attributes, not internals
        $tmp->{$_} = $self->{$_};
    }

    my $summary = dclone($tmp);

    # sorry, Will, but i think this is handy. :)
    return wantarray ? %{$summary} : $summary;
}

# simple transform: i.e. Foo::Bar -> Foo-Bar
sub dist_name {
    my $self = shift;

    croak "Can't set read-only method: dist_name" if @_;

    my $dname = $self->{package};
    $dname =~ s/::/-/g;

    return $dname;
}

# generates main module name. i.e. Foo::Bar -> Bar.pm
sub module_name {
    my $self = shift;

    croak "Can't set read-only method: module_name" if @_;

    my @parts = split( /::/, $self->{package} );

    return join( '.', pop(@parts), 'pm' );
}

sub template_data {
    my $self = shift;

    croak "Can't set read-only method: template_data" if @_;

    my $tmp = {
        author    => $self->_author_info,
        package   => $self->_package_info,
        modcooker => {
            version => $VERSION,
            perlver => $],
        },
        extra => $self->{extravars},
    };

    my $tdata = dclone($tmp);

    return wantarray ? %{$tdata} : $tdata;
}

# the ultimate goal of this module
sub cook {
    my $self = shift;

    # clear our template list
    $self->{_templates}     = {};
    $self->{_template_dirs} = [];

    for ( @{ $self->profile_dirs } ) {
        my $dir = Cwd::realpath($_);
        $self->_gather_profile( abs_path => $dir, subdir_path => undef );
    }

#warn Dumper($self->{_templates});
    foreach ( keys( %{ $self->{_templates} } ) ) {
        $self->_process_template( template => $_ );
    }

    if ( !-f catfile( $self->dist_name, 'MANIFEST' ) ) {
        chdir $self->dist_name;
        mkmanifest();
        chdir '..';
    }

}

1;    # End of Module::Cooker
__END__

=head1 NAME

Module::Cooker - Module starter kit based on Template

=head1 VERSION

Version 0.01

=head1 SYNOPSIS

  
 use Module::Cooker;
  
 my $mc = Module::Cooker->new( %params );
 $mc->cook();
  

=head1 DESCRIPTION

You are probably more interested in the command line interface to this module:
L<modcooker|modcooker>

=head1 CONSTRUCTOR

=head2 new

Here are the default vaues for the attributes:

  
 my $defaults = {
     minperl   => '',
     author    => 'A. Uthor',
     email     => 'author@example.com',
     profile   => 'default',
     package   => 'My::MC::Module',
     version   => 'v0.1_1',
     extravars => {},
     localdirs => [],
     nosubs    => 0,
 };
  

=over 4

=item minperl

=item author

=item email

=item profile

=item package

=item version

=item extravars

=item localdirs

=item nosubs

=back

=head1 ACCESSORS

There is a read-only accessor provided for each of the parameters accepted
by C<new>.

You can also obtain a hash (or hashref) with the values for each parameter
by using the L</summary> method described below.

=head1 METHODS

=head2 cook

=head2 dist_name

  
 print $mc->dist_name . "\n";   # prints My-MC-Module
  

Read-only method that returns the name of the distrubution as derived from
the package name. This is the name that is used to create the top-level
directory for the distrubution. '::' sequences are transformed to '-' in
accordance with normal CPAN practice.

=head2 module_name

  
 print $mc->module_name . "\n";   # prints Module.pm
  

Read-only method that returns the name of main module in the distrubution.
This is derived by taking the final element of the package name and
appending '.pm' to it.

=head2 profile_dirs

Read-only method that returns a list of directories that contain a
sub-directory with the same name as the requested profile.

The method will return either an array or array reference depending upon
the calling context.

=head2 template_data

  
 my $template_data = $mc->template_data;
 my %template_data = $mc->template_data;
  
 print Dumper($template_data);
  
 $VAR1 = {
   'author' => {
     'name'  => 'A. Uthor'
     'email' => 'author@example.com',
   },
   'modcooker' => {
     'version' => '0.01'
     'perlver' => '5.010001',
   },
   'package' => {
     'name'       => 'My::MC::Module',
     'dist_name'  => 'My-MC-Module',
     'version'    => 'v0.1_1',
     'minperl'    => '',
     'libpath'    => 'lib/My/MC',
     'module'     => 'Module.pm'
     'modulepath' => 'lib/My/MC/Module.pm',
     'timestamp'  => '2013-11-28 16:40:23',
     'year'       => '2013'
   }
 };
  

Read-only method that returns a copy of the data that will be passed to
Template to be used for variable substitution. It should be noted that this
is a copy and changes made to the returned structure will not affect
what is actually passed on.

The method will return either a hash or hash reference depending upon the
calling context.

=head2 basename_dir

Read-only method that returns the absolute path to where the module is
located in the C<@INC> search path with the name of this module
(C<Cooker>) appended. This is used to located the module's standard
template directories.

=head2 summary

  
 my $summary = $mc->summary;
 my %summary = $mc->summary;
  
 print Dumper($summary);
  
 $VAR1 = {
   'nosubs'    => 0,
   'profile'   => 'default',
   'localdirs' => [],
   'version'   => 'v0.1_1',
   'author'    => 'A. Uthor',
   'extravars' => {},
   'package'   => 'My::MC::Module',
   'minperl'   => '',
   'email'     => 'author@example.com'
 };
  

Read-only method that returns a copy of the data stored in the internal
attributes after object construction. It should be noted that this
is a copy and changes made to the structure will not affect the object
itself.

The method will return either a hash or hash reference depending upon the
calling context.

=head1 AUTHOR

Jim Bacon, C<< <jim at nortx.com> >>

=head1 BUGS

Please report any bugs or feature requests to C<bug-module-cooker at rt.cpan.org>, or through
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Module-Cooker>.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.

You can also submit an issue via the GitHub repository listed below.

=head1 SUPPORT

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

    perldoc Module::Cooker


You can also look for information at:

=over 4

=item * GitHub:

L<https://github.com/boftx/Module-Cooker>

=item * RT: CPAN's request tracker (report bugs here)

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Module-Cooker>

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/Module-Cooker>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/Module-Cooker>

=item * Search CPAN

L<http://search.cpan.org/dist/Module-Cooker/>

=back


=head1 ACKNOWLEDGEMENTS

This module draws heavily upon ideas found in L<Distribution::Cooker>,
L<Module::Maker> and L<Module::Starter>.

Special thanks goes to Perl Monk
L<tobyink|http://www.perlmonks.org/?node_id=757127> for the module name
regex pattern and the L<Perl Monks|http://www.perlmonks.org> who assisted
with peer review of the code, test suite, and documentation.

=head1 SEE ALSO

L<Template>,
L<Jose's Guide for Creating Perl modules|http://www.perlmonks.org/?node_id=431702>

=head1 LICENSE AND COPYRIGHT

Copyright 2013 Jim Bacon.

This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.

See L<http://dev.perl.org/licenses/> for more information.

