#!/usr/local/bin/perl
######################################################################
# tmpl -- Mike Schilli, 2003 (m@perlmeister.com)
######################################################################
# Create new templates
######################################################################

my  $VERSION = "0.04";

use Pod::Usage;
use Getopt::Std;
use HTML::Template;
use File::Basename;
use File::Path;

use Log::Log4perl qw(:easy);
Log::Log4perl->easy_init({level => $DEBUG, layout => '%m%n'});

my $RCFILE = glob("~/." . basename($0));

getopts( 'hvpmdo', \ my %opts );

pod2usage(-verbose => 2) if $opts{h};
die basename($0) . " $VERSION\n" if $opts{v};
pod2usage(-verbose => 1) unless @ARGV;

if($opts{p} and $opts{m}) {

        # Build a .pm file
    my $data = tmpl_module();
    out($data, $ARGV[0]);
} elsif($opts{p} and $opts{d}) {

        # Build a perl module distribution
    (my $subdir = $ARGV[0]) =~ s#::#-#g;
    DEBUG "subdir: $subdir";
    (my $module_path = $ARGV[0]) =~ s#::#/#g;
    $module_path = "$subdir/lib/$module_path.pm";
    DEBUG "module_path: $module_path";

    rmtree $subdir if -d $subdir;

    my $module_dir  = dirname($module_path);
    DEBUG "Making directory $module_dir";
    mkpath $module_dir, 0, 0755;

    out(tmpl_module(), $module_path, 0644, { MODULE => $ARGV[0] });

    $module_path =~ s#.*?/##;
    out(tmpl_makefilepl(), "$subdir/Makefile.PL", 
        0644, { MODULE_PATH => $module_path, 
                MODULE => $ARGV[0],
                GITHUB_NAME => github_name($ARGV[0])
    });

    mkpath "$subdir/t", 0755;
    out(tmpl_test(), "$subdir/t/001Basic.t", 
        0644, { MODULE => $ARGV[0] });

    out(tmpl_manifest_skip(), "$subdir/MANIFEST.SKIP");
    out(tmpl_cvs_ignore(), "$subdir/.cvsignore");
    out(tmpl_git_ignore(), "$subdir/.gitignore");

    mkpath "$subdir/adm";
    out(tmpl_podok(),  "$subdir/adm/podok", 0755);
    out(tmpl_release(), "$subdir/adm/release", 0755);
    out(tmpl_changes(), "$subdir/Changes", 0644, {MODULE => $ARGV[0] });

    mkpath "$subdir/eg";

    DEBUG "Running 'updreadme'";
    chdir $subdir or die "Cannot chdir to $subdir";
    system("updreadme") and die "'updreadme' failed. Get it from " .
                                "http://perlmeister.com/scripts/updreadme.";

} elsif($opts{p}) {

        # Build a perl script
    my $data = tmpl_script();
    out($data, $ARGV[0], 0755);
} else {

    pod2usage(-verbose => 1);
}

################################
sub out {
################################
    my($string, $file, $perm, $params) = @_;

    my $template = HTML::Template->new(scalarref         => \$string, 
                                       die_on_bad_params => 0,
                                      );

    open FILE, "<$RCFILE" or die "Cannot open $RCFILE";
    while(<FILE>) {
        chomp;
        s/^\s*#.*//g;
        next unless length($_);
        if(/(\S+)\s+(.*)/) {
            $template->param($1 => $2);
        }
    }

    $template->param(END_MARKER => "__END__");

    my $module = "MODULE";
    if(defined $file) {
        ($module = $file) =~ s/\.pm$//;
    }

    if(defined $params) {
        for (keys %$params) {
            $template->param($_, $params->{$_}); 
        }
    }

    if($opts{p} and $opts{m}) {
        $template->param(MODULE => $module);
    }

    if(defined $file) {
        $template->param(FILE => $file);
    } else {
        $template->param(FILE => "FILE_NAME");
    }

    close FILE;

    $template->param(DATE => nice_date());

    my $output = $template->output;
    $output =~ s/^\*==/=/mg;

    if(defined $file) {
        if($opts{o}) {
            print $output;
            return;
        }
        die "$file already exists\n" if -e $file;
        open FILE, ">$file" or die "Cannot open $file ($!)";
        print FILE $output;
        close FILE;
        INFO "$file written";
        if($perm) {
            chmod $perm, $file or die "Cannot chmod $file ($!)";
        }
    } else {
        print $output;
    }
}

###################################
sub tmpl_manifest_skip {
###################################
return <<'EOT';
blib
^Makefile$
^Makefile.old$
CVS
.cvsignore
docs
MANIFEST.bak
adm/release
.git
EOT
}

###################################
sub tmpl_cvs_ignore {
###################################
return <<'EOT';
blib
pm_to_blib
Makefile
adm
.git
EOT
}

###################################
sub tmpl_git_ignore {
###################################
return <<'EOT';
blib
pm_to_blib
Makefile
adm
.cvsignore
CVS
EOT
}

###################################
sub tmpl_test {
###################################
return <<'EOT';
######################################################################
# Test suite for <TMPL_VAR NAME=MODULE>
# by <TMPL_VAR NAME=AUTHOR> <<TMPL_VAR NAME=EMAIL>>
######################################################################

use warnings;
use strict;

use Test::More qw(no_plan);
BEGIN { use_ok('<TMPL_VAR NAME=MODULE>') };

ok(1);
like("123", qr/^\d+$/);
EOT
}

###################################
sub tmpl_script {
###################################
return <<'EOT';
#!/usr/bin/perl
###########################################
# <TMPL_VAR NAME=FILE> 
# <TMPL_VAR NAME=YEAR>, <TMPL_VAR NAME=AUTHOR> <<TMPL_VAR NAME=EMAIL>>
###########################################
use strict;
use warnings;
use Getopt::Std;
use Pod::Usage;

use vars qw($CVSVERSION);

$CVSVERSION = '$Revision: 1.16 $';

getopts("hv", \my %opts);
pod2usage() if $opts{h};
if($opts{v}) {
    my ($version) = $CVSVERSION =~ /(\d\S+)/;
    die "$0 $version\n";
}

<TMPL_VAR NAME=END_MARKER>

*==head1 NAME

    <TMPL_VAR NAME=FILE> - blah blah blah

*==head1 DOWNLOAD

_SRC_HERE_

*==head1 DOWNLOAD

_SRC_HERE_

*==head1 SYNOPSIS

    <TMPL_VAR NAME=FILE> -xyz

*==head1 OPTIONS

*==over 8

*==item B<-x>

Prints this manual page in text format.

*==back

*==head1 DESCRIPTION

<TMPL_VAR NAME=FILE> blah blah blah.

*==head1 EXAMPLES

  $ <TMPL_VAR NAME=FILE> -x foo bar

*==head1 LEGALESE

Copyright <TMPL_VAR NAME=YEAR> by <TMPL_VAR NAME=AUTHOR>, all rights reserved.
This program is free software, you can redistribute it and/or
modify it under the same terms as Perl itself.

*==head1 AUTHOR

<TMPL_VAR NAME=YEAR>, <TMPL_VAR NAME=AUTHOR> <<TMPL_VAR NAME=EMAIL>>
EOT
}

###################################
sub tmpl_changes {
###################################
return <<'EOT';
######################################################################
Revision history for Perl extension <TMPL_VAR NAME=MODULE>

0.01  <TMPL_VAR NAME=DATE>
      * Where it all began.
EOT
}

###################################
sub tmpl_release {
###################################
return <<'EOT';
#!/usr/bin/perl
    # Available at http://perlmeister.com/scripts
use ModDevUtils;
use Test::Harness;

ModDevUtils::release() or exit 0;

my $admdir = ".";
$admdir = "adm" if -d "lib";
runtests("$admdir/podok");

my $ball = ModDevUtils::tarball_name();

my $USER       = "XXX";
my $HOST       = "YYY";
my $TMPDIR     = "/home/$USER/tmp";
my $RELSCRIPT  = "ZZZ";

    # Transfer tarball somewhere ...
print "Copying $ball to $HOST ...\n";
system("scp $ball $USER\@$HOST:$TMPDIR");
print "Releasing it on $HOST ...\n";
system("ssh -l $USER $HOST $RELSCRIPT $ball\n");
EOT
}

###################################
sub tmpl_podok {
###################################
return <<'EOT';
#!/usr/bin/perl
use Test::Pod;
use Test::More;
use File::Find;

podok(@ARGV);
0;

##################################################
sub podok {
##################################################
    my ($dir) = @_;

    $dir ||= ".";

    my @pms = ();

    File::Find::find( sub {
        return unless -f $_;
        return unless /\.pm$/;
        push @pms, "$File::Find::name";
    }, $dir);

    my $nof_tests = scalar @pms;

    plan tests => $nof_tests;

    for(@pms) {
        pod_ok($_);
    }
}
EOT
}

###################################
sub tmpl_makefilepl {
###################################
return <<'EOT';
######################################################################
# Makefile.PL for <TMPL_VAR NAME=MODULE>
# <TMPL_VAR NAME=YEAR>, <TMPL_VAR NAME=AUTHOR> <<TMPL_VAR NAME=EMAIL>>
######################################################################
use ExtUtils::MakeMaker;
my $meta_merge = {
    META_MERGE => {
        resources => {
            repository => 'http://github.com/<TMPL_VAR NAME=GITHUB_ID>/<TMPL_VAR NAME=GITHUB_NAME>',
        },
    }
};
WriteMakefile(
    'NAME'         => '<TMPL_VAR NAME=MODULE>',
    'VERSION_FROM' => '<TMPL_VAR NAME=MODULE_PATH>', # finds $VERSION
    'PREREQ_PM'    => {
    }, # e.g., Module::Name => 1.1
    $ExtUtils::MakeMaker::VERSION >= 6.50 ? (%$meta_merge) : (),
    ($] >= 5.005 ?    ## Add these new keywords supported since 5.005
      (ABSTRACT_FROM => '<TMPL_VAR NAME=MODULE_PATH>',
       AUTHOR     => '<TMPL_VAR NAME=AUTHOR> <<TMPL_VAR NAME=EMAIL>>') : ()),
);
EOT
}

###################################
sub tmpl_module {
###################################
return <<'EOT';
###########################################
# <TMPL_VAR NAME=MODULE> -- <TMPL_VAR NAME=YEAR>, <TMPL_VAR NAME=AUTHOR> <<TMPL_VAR NAME=EMAIL>>
###########################################
# Blah Blah Blah
###########################################

###########################################
package <TMPL_VAR NAME=MODULE>;
###########################################

use strict;
use warnings;

our $VERSION = "0.01";

###########################################
sub new {
###########################################
    my($class, %options) = @_;

    my $self = {
        %options,
    };

    bless $self, $class;
}

1;

<TMPL_VAR NAME=END_MARKER>

*==head1 NAME

<TMPL_VAR NAME=MODULE> - blah blah blah

*==head1 SYNOPSIS

    use <TMPL_VAR NAME=MODULE>;

*==head1 DESCRIPTION

<TMPL_VAR NAME=MODULE> blah blah blah.

*==head1 EXAMPLES

  $ perl -M<TMPL_VAR NAME=MODULE> -le 'print $foo'

*==head1 LEGALESE

Copyright <TMPL_VAR NAME=YEAR> by <TMPL_VAR NAME=AUTHOR>, all rights reserved.
This program is free software, you can redistribute it and/or
modify it under the same terms as Perl itself.

*==head1 AUTHOR

<TMPL_VAR NAME=YEAR>, <TMPL_VAR NAME=AUTHOR> <<TMPL_VAR NAME=EMAIL>>
EOT
}

##################################################
sub nice_date {
##################################################
    my ($time) = @_;

    $time = time() unless defined $time;

    my ($sec,$min,$hour,$mday,$mon,
        $year,$wday,$yday,$isdst) = localtime(time);

    return sprintf "%d/%02d/%02d",
                   $year+1900, $mon+1, $mday;
}

###########################################
sub github_name {
###########################################
    my($module) = @_;

    (my $gname = $module) =~ s/::/-/g;
    $gname = lc $gname;
    return "$gname" . "-perl";
}

__END__

=head1 NAME

    tmpl - Create new perl script and module templates

=head1 DOWNLOAD

_SRC_HERE_

=head1 SYNOPSIS

    tmpl -p script.pl
    tmpl -pm Module.pm
    tmpl -pd My::Module

=head1 OPTIONS

=over 8

=item B<-h>

Prints this manual page in text format.

=item B<-v>

Print the program's version.

=item B<-p>

Create a template for a perl script

=item B<-pm>

Create a template for a perl module

=item B<-pd>

Create a subdirectory with a perl module distribution

=back

=head1 DESCRIPTION

B<tmpl> creates templates for writing perl scripts and modules.

=head1 EXAMPLES

  $ tmpl -p script.pl

  $ tmpl -pm Module.pm

  $ tmpl -pd My::Module

=head2 FILES

    .tmpl
        AUTHOR    Mike Schilli
        EMAIL     m@perlmeister.com
        YEAR      2009
        GITHUB_ID mschilli

=head1 LEGALESE

Copyright 2003-2009 by Mike Schilli, all rights reserved.
This program is free software, you can redistribute it and/or
modify it under the same terms as Perl itself.

=head1 AUTHOR

2003, Mike Schilli <m@perlmeister.com>