pmsetup の改造がうまくできない

モジュールをちゃんとした雛形を使って作ることにした。でも、 Module::Starter とかを使うと Foo-Bar/lib/Foo/Bar.pm とかディレクトリを掘るので、フレームワークを使っていてコントローラーを作りたい場合などにいろいろ作られ過ぎて困る。あいにくヘルパーがないので、ヘルパーもどきというか

package Foo::Bar;
# $id$
# Kensuke Kaneko
use strict;

1;
__END__

以下 POD

みたいな雛形だけ作ってくれて、カレントディレクトリからみて lib/Proj/Foo/Bar.pm を作ってくれる、ような風に改造した。

そこまではできたけど、テストも追加したいと思って、 t/テスト番号_モジュール名.t というようなルールで勝手に番号がインクリメントされたテストが追加されたらいいなと思ってやってみたけど、 __DATA__ にかいたファイルの雛形で file: の部分は TT のシンタックスが使えず、仕方ないので自前で置換をしようとしたら正規表現がダメで動かない。。正規表現ってこれだから嫌いだよ。

#!/usr/bin/perl
use strict;
use warnings;
use ExtUtils::MakeMaker qw(prompt);
use File::Basename;
use File::Path;
use File::Spec;
use Template;
use YAML;
use File::Find;

my $path   = File::Spec->catfile($ENV{HOME}, "/.pmsetuprc");
my $config = eval { YAML::LoadFile($path) } || {};

my $save;
while (! $config->{author}) {
    $config->{author} = prompt("Your name: ", '');
    $save++;
}

while (! $config->{email}) {
    $config->{email} = prompt("Your email: ", '');
    $save++;
}

my $modname = shift @ARGV or die "Usage: $0 module\n";
   $modname =~ s/-/::/g;

write_plugin_files($modname, $config);

END {
    YAML::DumpFile($path, $config) if $save;
}

sub write_plugin_files {
    my($module, $config) = @_;

    # $module = "Foo::Bar"
    # $dist   = "Foo-Bar"
    # $path   = "Foo/Bar.pm"
    my @pkg  = split /::/, $module;
    my $dist = join "-", @pkg;
    my $distname = join "_", @pkg;
    my $path = join("/", @pkg) . ".pm";

    my $t_index;
    if (-e "t") {
        find(sub {
                 return unless $_ =~ /\.t$/;
                 my ($index) = $_ =~ /^(\d+)_(\w+)$/;
                 $t_index = ++$index;
                 $t_index = sprintf("%02.d", $t_index);
             }, "t");
    }
    else {
        $t_index = sprintf("%02.d", 10);
    }

    my @template = YAML::Load(join '', <DATA>);
    my $vars = { module => $module, path => $path,
                 config => $config, localtime => scalar localtime };
 
    for my $tmpl (@template) {
        my $file = $tmpl->{file};
           $file =~ s/(\$\w+)/$1/eeg;
        
warn $file;
        no strict 'refs';
        while ($file =~ s{<% (\w+) %>}{$$1}) {
            #no strict 'refs';
            #$file =~ s{<% (\w+) %>}{$$1}e;
        }
        $file =~ s{\s}{}g;
warn $file;
#           if ($file =~ m{<% (.*?) %>}) {
#               warn $1;
#               no strict 'refs';
#               while ($file =~ s/<% (\w+) %>/$$1/) {
#                   
#               }
#               $file =~ s/<% (\w+) %>/$$1/g;
#               warn $file;
#               $file =~ s/\s//g;
#           }
        write_file($file, $tmpl->{template}, $vars);
    }
}

sub write_file {
    my($path, $template, $vars) = @_;

    if (-e $path) {
        return;
    }

    my $dir = File::Basename::dirname($path);
    unless (-e $dir) {
        warn "Creating directory $dir\n";
        File::Path::mkpath($dir, 1, 0777);
    }

    my $tt = Template->new;
    $tt->process(\$template, $vars, \my $content);

    warn "Creating $path\n";
    open my $out, ">", $path or die "$path: $!";
    print $out $content;
    close $out;
}

__DATA__
---
file: t/00_compile.t
template: |
  use strict;
  use Test::More tests => 1;

  BEGIN { use_ok '[% module %]' }
---
file: t/<% t_index %>_<% distname %>.t
template: |
  use strict;
  use Test::More qw(no_plan);

  BEGIN { use_ok '[% module %]' }
---
file: t/97_podspell.t
template: |
  use Test::More;
  eval q{ use Test::Spelling };
  plan skip_all => "Test::Spelling is not installed." if $@;
  add_stopwords(<DATA>);
  all_pod_files_spelling_ok('lib');
  __DATA__
  Kensuke
  Kaneko
---
file: t/98_perlcritic.t
template: |
  use strict;
  use Test::More;
  eval q{ use Test::Perl::Critic };
  plan skip_all => "Test::Perl::Critic is not installed." if $@;
  all_critic_ok("lib");
---
file: t/99_pod.t
template: |
  use Test::More;
  eval "use Test::Pod 1.00";
  plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
  all_pod_files_ok();
---
file: lib/$path
template: |
  package [% module %];
  # $Id$
  # [% config.author %] <[% config.email %]>
  use strict;

  1;
  __END__

  =encoding utf-8

  =for stopwords

  =head1 NAME

  [% module %] -

  =head1 SYNOPSIS

    use [% module %];

  =head1 DESCRIPTION

  [% module %] is

  =head1 AUTHOR

  [% config.author %] E<lt>[% config.email %]E<gt>

  =head1 LICENSE

  This library is free software; you can redistribute it and/or modify
  it under the same terms as Perl itself.

  =head1 SEE ALSO

  =cut

write_plugin_files() の中でそのへんのことをやろうとしたけどダメだった。