App-Skeletor

 view release on metacpan or  search on metacpan

lib/App/Skeletor.pm  view on Meta::CPAN

use strict;
use warnings;

package App::Skeletor;

use Getopt::Long::Descriptive;
use File::Share 'dist_dir';
use Module::Runtime 'use_module';
use Path::Tiny;
use Template::Tiny;
use File::HomeDir;
use JSON::PP;

our $VERSION = '0.005';

sub getopt_spec {
  return (
    'skeletor %o',
    ['template|t=s', 'Namespace of the project templates', { required=>1 }],
    ['as|p=s', 'Target namespace of the new project', { required=>1 }],
    ['directory|d=s', 'Where to build the new project (default: cwd)', {default=>Path::Tiny->cwd}],
    ['author|a=s', 'Primary author for the project', { required=>1 }],
    ['year|y=i', 'Copyright year (default: current year)', {default=>(localtime)[5]+1900}],
    ['overwrite|o', 'overwrite existing files' ],
  );
}
sub path_to_share {
  my $project_template = shift;
  my $tmp;
  unless(eval { use_module $project_template }) {
    # cant use, assume not loaded.
    $tmp = Path::Tiny->tempdir;
    print "Template $project_template is not installed, creating temporary install into $tmp";
    `curl -L https://cpanmin.us | perl - --metacpan -l $tmp $project_template`;
    eval "use lib '$tmp/lib/perl5'";    
    use_module $project_template || die "Can't install and use $project_template";
  }
  $project_template=~s/::/-/g;
  my $ret = path(dist_dir($project_template), 'skel');
  return ($ret, $tmp);
}

sub template_as_name {
  my $name_proto = shift;
  $name_proto=~s/::/-/g;
  return $name_proto;
}

sub run {
  my ($class, @args) = @_;

  ## Look in homedir and grab any options
  if(-e(my $saved_options_path = path(File::HomeDir->my_home, '.skeletor.json'))) {
    print "Found user options at: $saved_options_path\n";
    my $json_opts = decode_json($saved_options_path->slurp);
    @args = (@args, %$json_opts);
  }

  local @ARGV = @args;

  my ($desc ,@spec) = getopt_spec;
  my ($opt, $usage) = describe_options($desc, @spec, {getopt_conf=>['pass_through']});
  my ($path_to_share, $tmp) = path_to_share($opt->template);

  ## Templates can add or override options
  if($opt->template->can('extra_getopt_spec')) {
    my @new_spec = (@spec, $opt->template->extra_getopt_spec);
    local @ARGV = @args;
    ($opt, $usage) = describe_options($desc, @new_spec);
  }

  my %template_var_names =  (
    (map { $_->{name} => $opt->${\$_->{name}} } @{$usage->{options}}),
    name => template_as_name($opt->as),
    namespace => $opt->as,
    project_fullpath => do {my $path = path(split('::', $opt->as)); "$path" },
    name_lowercase => lc(template_as_name($opt->as)),
    name_lc => lc(template_as_name($opt->as)),
    name_lowercase_underscore => do {
      my $val = lc(template_as_name($opt->as));
      $val=~s/-/_/g; $val;
    },
    name_lc_underscore => do {
      my $val = lc(template_as_name($opt->as));
      $val=~s/-/_/g; $val;
    },
  );

  my $tt = Template::Tiny->new(TRIM => 1);

  $path_to_share->visit(sub {
    my ($path, $stuff) = @_;
    return if $path=~m/\.DS_Store/g;
    my $expanded_path = $path;
    my $target_path = path($opt->directory, $expanded_path->relative($path_to_share));
    my (@vars) = ($target_path=~m/__(?:(?![__]_).)+__/g);
    foreach my $var(@vars) {
      my ($key) = ($var=~m/^__(\w+)__$/);
      my $subst = $template_var_names{$key} || die "$key not a defined variable";
      $target_path=~s/${var}/$subst/g;
    }

    $target_path = path($target_path);

    if(-e $target_path && !$opt->overwrite) {
      print "$target_path exists, skipping (set --overwrite to rebuild)\n";
      return;
    }
    
    if($expanded_path->is_file) {
      $expanded_path->parent->mkpath;
      if("$path"=~/\.ttt$/) {
        my $data = $expanded_path->slurp;
        $tt->process(\$data, \%template_var_names, \my $out);
        my ($new_target_path) = ("$target_path" =~m/^(.+)\.ttt$/);
        path($new_target_path)->touchpath;
        my $fh = path($new_target_path)->openw;
        print $fh $out;
        close($fh);
        path($new_target_path)->chmod($expanded_path->stat->mode);

      } else {
        $expanded_path->copy($target_path);
      }
    } elsif($path->is_dir) {
      $target_path->mkpath;
    } else {
      print "Don't know want $path is!";

 view all matches for this distribution
 view release on metacpan -  search on metacpan

( run in 0.362 second using v1.00-cache-2.02-grep-82fe00e-cpan-9e6bc14194b )