Tengで使うschemaクラスの雛形を作るスクリプトを作ってみた

　Teng のパッケージにある Teng::Schema::Dumper を使うことで schema クラスを作れるのは知ってるのですがこれを利用してモジュールの雛形まで作るスクリプトを作ってみた。いわゆる pmsetup とか Module::Setup みたいなやつです。

よく見るとやっつけ仕事な感じですね。

■利用方法

$ mk_teng_schema.pl [MODEL NAME] [DSN] [USER_NAME] [PASSWORD]
$ mk_teng_schema.pl MyApp::Model DBI:mysql:database=database_name username password

上記のように実行すると MyApp-Model のディレクトリが掘られて中にMyApp::Modelモジュールインストールに必要な Makefile.PLなどのファイル群がよしなに作られます。

■mk_teng_schema.pl

#!/usr/bin/env perl

use strict;
use warnings;
use Pod::Usage;
use Getopt::Long;
use File::Path qw/mkpath/;
use DBI;
use Teng::Schema::Dumper;
use Cwd;
# use Data::Dumper;

our $module;

GetOptions(
    'help' => \my $help,
) or pod2usage(0);

pod2usage(1) if $help;


sub _src_tmpl {
my ($module, $path) = @_;
my $module_lc = lc $module;
my $current_dir = getcwd();
my $confsrc = <<"...";
-- lib/$path.pm
package $module;
use parent 'Teng';
our \$VERSION = '0.01';
1;
__END__

=head1 NAME

$module - Application Model Class.

=head1 SYNOPSIS

use $module;

my \$teng = $module->new(
    {connect_info => 
        ['DBI:mysql:database=your_db_name', 'user', 'pass', 
            {mysql_enable_utf8 => 1, pg_enable_utf8 => 1, sqlite_unicode => 1}
    ]});

=head1 DESCRIPTION

Teng schema class.

=head1 LICENCE AND COPYRIGHT

Copyright (c) 2011, foo bar C<<  >>. All rights reserved.

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


-- lib/$path/Schema.pm
__SCHEMA__
__END__

-- t/00_compile.t

use strict;
use Test::More;

BEGIN { use_ok "$module" }

my \$teng = $module->new(
    {connect_info => 
        ['$ARGV[0]', '$ARGV[1]', '$ARGV[2]', {mysql_enable_utf8 => 1, pg_enable_utf8 => 1, sqlite_unicode => 1}]});


isa_ok \$teng, "$module";

done_testing;

-- Makefile.PL
use inc::Module::Install;
all_from 'lib/$path.pm';
readme_from('lib/$path.pm');
build_requires 'Test::More', 0.88;
test_requires 'Test::Requires';
auto_set_repository();
WriteAll;

-- MANIFEST.SKIP

\\bRCS\\b
\\bCVS\\b
\\.svn/
\\.git/
^MANIFEST\\.
^Makefile\$
~\$
\\.old\$
^blib/
^pm_to_blib
^MakeMaker-\\d
\\.gz\$
\\.cvsignore
\\.shipit

-- META.yml
---
abstract: ~
author: ~
build_requires:
  Test::More: 0.88
  Test::Requires: 0
distribution_type: module
generated_by: 'Module::Install version 0.77'
license: unknown
meta-spec:
  url: http://module-build.sourceforge.net/META-spec-v1.4.html
  version: 1.4
module_name: $module
name: $module
no_index:
  directory:
    - inc
    - t
version: 0.01

-- README
This is Perl module $module.

INSTALLATION

$module installation is straightforward. If your CPAN shell is set up,
you should just be able to do

    $ cpan $module

Download it, unpack it, then build it as per the usual:

    $ perl Makefile.PL
    $ make && make test

Then install it:

    $ make install

DOCUMENTATION

$module documentation is available as in POD. So you can do:

    $ perldoc $module

to read the documentation online with your favorite pager.

-- .gitignore
META.yml
Makefile
inc/
pm_to_blib
*~

-- .shipit
steps = FindVersion, ChangeVersion, CheckChangeLog, DistTest, Commit, Tag, MakeDist, UploadCPAN
git.push_to = origin


-- Changes
Revision history for Perl extension $module

0.01  Tue Apr 19 13:08:34 2011
        - original version

-- MANIFEST
.gitignore
Changes
inc/Module/Install.pm
inc/Module/Install/Base.pm
inc/Module/Install/Can.pm
inc/Module/Install/Fetch.pm
inc/Module/Install/Makefile.pm
inc/Module/Install/Metadata.pm
inc/Module/Install/Repository.pm
inc/Module/Install/Win32.pm
inc/Module/Install/WriteAll.pm
lib/$path.pm
Makefile.PL
MANIFEST
META.yml
README
t/00_compile.t
xt/pod.t

-- xt/pod.t
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();


...
$confsrc;
}

&main;exit;

sub _mkpath {
    my $path = shift || "PPP";
    print "make path: $path\n";
    mkpath $path;
}

sub main {
    $module = shift @ARGV or pod2usage(0);

    my $dbh = DBI->connect(@ARGV) or die "could not connect DBI";

    $module =~ s{-}{::}g;

    my @pkg = split /::/, $module;
    my $dist = join "-", @pkg;
    my $path = join "/", @pkg;

    mkdir $dist or die "Could not mkdir at " . $dist;
    chdir $dist or die "Could not chdir at " . $dist;

    map {_mkpath $_ } qw(t lib xt);
    _mkpath "lib/$path";
    _mkpath "lib/$path/Row";
    my $schema_class = Teng::Schema::Dumper->dump(dbh => $dbh, namespace => $module);
    my $src = _src_tmpl($module, $path);
    $src =~ s{__SCHEMA__}{$schema_class};

    my $conf = _parse_conf($src);

    while ( my ($file, $src ) = each %$conf ) {
        open my $fh, ">", $file or die "Could not Write File: ", $file;
        print $fh $src;
        close $fh;

    }
}

sub _parse_conf {
    my $filename;
    my $res;
    for my $line (split "\n", shift) {
        if ( $line =~ m{^--\s+(.+)$} ) {
            $filename = $1;
        } else {
            $filename or die "missing filename for first content";
            $res->{$filename} .= "$line\n";
        }
    }
    return $res;
}

__END__

=head1 NAME

mk_teng_schema.pl - this is Teng Schema template generate script

=head1 SYNOPSIS

create template Teng Schema class.

$ perl mk_teng_schema.pl [Model Name] [DSN] [USER] [PASS]

ex) $ mk_teng_schema.pl TEST::Model DBI:mysql:database=your_db_name user pass

=head1 LICENCE AND COPYRIGHT

Copyright (c) 2011, tooru midorikawa C<<  >>. All rights reserved.

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

created: 2011/11/20