File Coverage

blib/lib/Catalyst/Helper/Model/CRUD.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

package Catalyst::Helper::Model::CRUD;

use strict;
use Jcode;
use XML::Simple;

our $VERSION = '0.21';

=head1 NAME

Catalyst::Helper::Model::CRUD - generate sqls, controllers and templates from DBDesigner 4 file

=head1 SYNOPSIS

    ./myapp_create.pl model DBIC CRUD [DBDesigner 4 File] [some modules]

=head1 DESCRIPTION

Helper for Catalyst::Plugin::CRUD.

This helper generates sqls, default controllers and default templates.

=head1 METHODS

=cut

# relation list
my @relations;

# table list
my @tables;

=head2 encode($str)

This method translates comment of DBDesigner4 to UTF-8.

=cut

sub encode {
    my ( $this, $str ) = @_;
    my @array = split( //, $str );
    my @list;
    for ( my $i = 0 ; $i < scalar(@array) ; $i++ ) {

        # translate "\\n" to "。"
        if ( $array[$i] eq '\\' && $array[ $i + 1 ] eq 'n' ) {
            push @list, 129;
            push @list, 66;
            $i++;

            # translate "\\\\" to "0x5C"
        }
        elsif ( $array[$i] eq '\\' && $array[ $i + 1 ] eq '\\' ) {
            push @list, 92;
            $i++;

            # "\\144" etc
        }
        elsif ( $array[$i] eq '\\' ) {
            push @list, $array[ $i + 1 ] . $array[ $i + 2 ] . $array[ $i + 3 ];
            $i += 3;

            # "[" etc
        }
        elsif ( 13 < ord( $array[$i] ) && ord( $array[$i] ) < 128 ) {
            push @list, ord( $array[$i] );
        }
    }

    # translate Shift-JIS to UTF-8
    my $result = pack( "C*", @list );
    return jcode( $result, 'sjis' )->utf8;
}

=head2 get_class_name($str)

This method translates hoge_fuga_master to HogeFugaMaster.

=cut

sub get_class_name {
    my ( $this, $str ) = @_;
    my @array = split( //, $str );
    for ( my $i = 0 ; $i < scalar(@array) ; $i++ ) {
        if ( $i == 0 ) {
            $array[$i] = uc $array[$i];
        }
        elsif ( $array[$i] eq '_' ) {
            $array[ $i + 1 ] = uc $array[ $i + 1 ];
        }
    }
    my $result = join( '', @array );
    $result =~ s/_//g;
    return $result;
}

=head2 get_relation($relation_id)

This method returns relation of appointed ID.

=cut

sub get_relation {
    my ( $this, $relation_id ) = @_;
    foreach my $relation (@relations) {
        if ( $relation_id eq $relation->{'ID'} ) {
            return $relation;
        }
    }
}

=head2 get_table($table_id)

This methods returns table of appointed ID.

=cut

sub get_table {
    my ( $this, $table_id ) = @_;
    foreach my $table (@tables) {
        if ( $table_id eq $table->{'ID'} ) {
            return $table;
        }
    }
}

=head2 get_setting_index($array, $name)

This method returns setting number of appointed name.

=cut

sub get_setting_index {
    my ( $this, $array, $name ) = @_;
    for ( my $i = 0 ; $i < scalar( @{$array} ) ; $i++ ) {
        if ( $name eq $array->[$i]->{'name'} ) {
            return $i;
        }
    }
    return -1;
}

=head2 get_primary(@sqls)

This method returns primary key name.

=cut

sub get_primary {
    my ( $this, @sqls ) = @_;
    for my $sql (@sqls) {
        if ( $sql->{type} eq 'serial' ) {
            return $sql->{name};
        }
    }
    return 'id';
}

=head2 get_columns(@sqls)

This method returns columns string.

=cut

sub get_columns {
    my ( $this, @sqls ) = @_;
    shift @sqls;
    my @names;
    for my $sql (@sqls) {
        push @names, $sql->{name};
    }
    return join( " ", @names );
}

=head2 mk_compclass($helper, $file, @limited_file)

This method analyse DBDesigner 4 file and generate sqls, controllers and templates.

=cut

sub mk_compclass {
    my ( $this, $helper, $file, @limited_file ) = @_;

    print "==========================================================\n";

    # ファイル名は必須
    unless ($file) {
        die "usage: ./myapp_create.pl model CRUD CRUD [DBDesigner 4 File] [some modules]\n";
        return 1;
    }

    # XMLファイル解析
    my $parser = new XML::Simple();
    my $tree   = $parser->XMLin($file);

    # SQL・コントローラ・テンプレート用のディレクトリを作る
    my $schema_dir     = sprintf( "%s/sql/schema",        $helper->{'base'} );
    my $i18n_dir       = sprintf( "%s/lib/%s/I18N",       $helper->{'base'}, $helper->{'app'} );
    my $controller_dir = sprintf( "%s/lib/%s/Controller", $helper->{'base'}, $helper->{'app'} );
    my $template_dir   = sprintf( "%s/root/template",     $helper->{'base'} );
    $helper->mk_dir($schema_dir);
    $helper->mk_dir($i18n_dir);
    $helper->mk_dir($controller_dir);
    $helper->mk_dir($template_dir);

    # リレーションとテーブル一覧を取得する
    if ( ref $tree->{'METADATA'}->{'RELATIONS'}->{'RELATION'} eq 'ARRAY' ) {
        @relations = @{ $tree->{'METADATA'}->{'RELATIONS'}->{'RELATION'} };
    }
    else {
        push( @relations, $tree->{'METADATA'}->{'RELATIONS'}->{'RELATION'} );
    }
    if ( ref $tree->{'METADATA'}->{'TABLES'}->{'TABLE'} eq 'ARRAY' ) {
        @tables = @{ $tree->{'METADATA'}->{'TABLES'}->{'TABLE'} };
    }
    else {
        push( @tables, $tree->{'METADATA'}->{'TABLES'}->{'TABLE'} );
    }

    # 指定したモジュールのみ
    my %limit;
    $limit{$_} = 1 foreach (@limited_file);

    # 言語ファイル用キーワードファイル
    my @keywords;

    foreach my $table (@tables) {
        my $model_name = $this->get_class_name( $table->{'Tablename'} );
        my $class_name = $model_name;
        $class_name =~ s/Master//g;

        # 指定したモジュールのみ
        if ( scalar @limited_file ) {
            next unless ( $limit{$class_name} );
        }

        # 言語ファイルに追加
        push @keywords,
            {
                name    => $class_name . '_class_name',
                desc_ja => $this->encode( $table->{'Comments'} ),
                desc_en => $class_name
            };

        # 各テーブルの列一覧取得
        my @columns = @{ $table->{'COLUMNS'}->{'COLUMN'} }
          if ref $table->{'COLUMNS'}->{'COLUMN'} eq 'ARRAY';

        # 各テーブルのインデックス覧取得
        my %indices;
        if ( ref( $table->{'INDICES'}->{'INDEX'} ) eq 'HASH' ) {

            # 要素一個のときはハッシュになってしまうのでその対策
            my $key = $table->{'INDICES'}->{'INDEX'}->{'INDEXCOLUMNS'}->{'INDEXCOLUMN'}->{'idColumn'};
            my $val = $table->{'INDICES'}->{'INDEX'}->{'FKRefDef_Obj_id'};

            # 主キーは無視する
            unless ( $val eq '-1' ) {
                $indices{$key} = $val;
            }
        }
        elsif ( ref( $table->{'INDICES'}->{'INDEX'} ) eq 'ARRAY' ) {
            foreach my $index ( @{ $table->{'INDICES'}->{'INDEX'} } ) {
                my $key = $index->{'INDEXCOLUMNS'}->{'INDEXCOLUMN'}->{'idColumn'};
                my $val = $index->{'FKRefDef_Obj_id'};

                # 主キーは無視する
                unless ( $val eq '-1' ) {
                    $indices{$key} = $val;
                }
            }
        }

        my @serials;     # シーケンス一覧
        my @sqls;        # SQL一覧
        my @settings;    # スキーマ一覧
        foreach my $column (@columns) {
            my $sql;
            my @setting;

            # カラム名
            push @setting, ( "        " . $column->{'ColName'} );

            # 型
            if ( $column->{'AutoInc'} eq "1" ) {

                # AutoInc="1" だったら「テーブル名_カラム名_seq」という
                # テーブルを Postgresql が自動作成するのでその対応
                $sql->{'type'} = "serial";
                push @setting, "SERIAL";
                push @serials,
                  sprintf( "GRANT ALL ON %s_%s_seq TO PUBLIC;\n", $table->{'Tablename'}, $column->{'ColName'} );
            }
            elsif ( $column->{'idDatatype'} eq '5' ) {
                $sql->{'type'} = "int";
                push @setting, "INTEGER";
            }
            elsif ( $column->{'idDatatype'} eq '14' ) {
                $sql->{'type'} = "date";
                push @setting, "DATE";
            }
            elsif ( $column->{'idDatatype'} eq '16' ) {
                $sql->{'type'} = "timestamp with time zone";
                push @setting, "TIMESTAMP with time zone";
            }
            elsif ( $column->{'idDatatype'} eq '20' ) {
                $sql->{'type'} = "varchar(255)";
                push @setting, "VARCHAR(255)";
            }
            elsif ( $column->{'idDatatype'} eq '22' ) {
                $sql->{'type'} = "bool";
                push @setting, "BOOL";
            }
            elsif ( $column->{'idDatatype'} eq '28' ) {
                $sql->{'type'} = "text";
                push @setting, "TEXT";
            }
            else {
                $sql->{'type'} = "text";
                push @setting, "TEXT";
            }

            # 主キーかどうか
            if ( $column->{'PrimaryKey'} eq '1' ) {
                $sql->{'primarykey'} = 1;
                push @setting, "PRIMARY KEY";
            }
            elsif ( 'id' eq lc( $column->{'ColName'} ) ) {

                # id は自動的に主キーにする
                $sql->{'primarykey'} = 1;
                push @setting, "PRIMARY KEY";
            }

            # デフォルト値
            if ( length( $column->{'DefaultValue'} ) > 0 ) {
                $sql->{'default'} = $column->{'DefaultValue'};
                push @setting, sprintf( "DEFAULT '%s'", $column->{'DefaultValue'} );
            }
            elsif ( $column->{'idDatatype'} eq '14' ) {

                # 日付は自動的に設定する
                $sql->{'default'} = "('now'::text)::timestamp";
                push @setting, "DEFAULT ('now'::text)::timestamp";
            }
            elsif ( $column->{'idDatatype'} eq '16' ) {

                # 日時は自動的に設定する
                $sql->{'default'} = "('now'::text)::timestamp";
                push @setting, "DEFAULT ('now'::text)::timestamp";
            }
            elsif ( 'disable' eq lc( $column->{'ColName'} ) ) {

                # disable は自動的に 0 にする
                $sql->{'default'} = "0";
                push @setting, "DEFAULT '0'";
            }

            # NOT NULL 制約
            if ( $column->{'NotNull'} eq '1' ) {
                $sql->{'notnull'} = 1;
                push @setting, "NOT NULL";
            }
            elsif ( 'disable' eq lc( $column->{'ColName'} ) ) {

                # disable は自動的に NOT NULL にする
                $sql->{'notnull'} = 1;
                push @setting, "NOT NULL";
            }

            # 参照制約
            if ( $indices{ $column->{'ID'} } ) {
                my $relation   = $this->get_relation( $indices{ $column->{'ID'} } );
                my $src_table  = $this->get_table( $relation->{'SrcTable'} );
                my $class_name = sprintf( "%s::Model::ShanonDBI::%s",
                    $helper->{'app'}, $this->get_class_name( $src_table->{'Tablename'} ) );
                $sql->{'references'} = {
                    class    => $class_name,
                    name     => 'id',
                    onupdate => 'cascade',
                    ondelete => 'cascade'
                };
                push @setting,
                  sprintf( "CONSTRAINT ref_%s REFERENCES %s (id) ON DELETE cascade ON UPDATE cascade",
                    $column->{'ColName'}, $src_table->{'Tablename'} );
            }

            # コメント
            if ( 'id' eq lc( $column->{'ColName'} ) ) {

                # id は自動的に ID にする
                push @setting, '/* ID */';
            }
            elsif ( 'disable' eq lc( $column->{'ColName'} ) ) {

                # disable は自動的に 削除 にする
                push @setting, '/* 削除 */';
            }
            elsif ( 'date_regist' eq lc( $column->{'ColName'} ) ) {

                # disable は自動的に 登録日時 にする
                push @setting, '/* 登録日時 */';
            }
            elsif ( 'date_update' eq lc( $column->{'ColName'} ) ) {

                # disable は自動的に 更新日時 にする
                push @setting, '/* 更新日時 */';
            }
            else {
                push @setting, sprintf( "/* %s */", $this->encode( $column->{'Comments'} ) );
            }

            # 言語ファイル
            if ( 'id' eq lc( $column->{'ColName'} ) ) {
                push @keywords,
                    {
                        name    => $class_name . '_' . $column->{'ColName'},
                        desc_ja => 'ID',
                        desc_en => 'ID'
                    };
            }
            elsif ( 'disable' eq lc( $column->{'ColName'} ) ) {
                push @keywords,
                    {
                        name    => $class_name . '_' . $column->{'ColName'},
                        desc_ja => '削除',
                        desc_en => 'DISABLE'
                    };
            }
            elsif ( 'date_regist' eq lc( $column->{'ColName'} ) ) {
                push @keywords,
                    {
                        name    => $class_name . '_' . $column->{'ColName'},
                        desc_ja => '登録日時',
                        desc_en => 'DATE_REGIST'
                    };
            }
            elsif ( 'date_update' eq lc( $column->{'ColName'} ) ) {
                push @keywords,
                    {
                        name    => $class_name . '_' . $column->{'ColName'},
                        desc_ja => '更新日時',
                        desc_en => 'DATE_UPDATE'
                    };
            }
            else {
                push @keywords,
                    {
                        name    => $class_name . '_' . $column->{'ColName'},
                        desc_ja =>
                            length( $column->{'Comments'} ) == 0 ?
                                uc $column->{'ColName'} : $this->encode( $column->{'Comments'} ),
                        desc_en => uc $column->{'ColName'}
                    };
            }

            # 列名の代入
            $sql->{'name'} = $column->{'ColName'};

            # 列の説明の代入
            $sql->{'desc'} = $class_name . '_' . $column->{'ColName'};

            push @sqls, $sql;
            push @settings, join( " ", @setting );
        }

        # SQL出力
        my $setting_vars;
        $setting_vars->{'table'}   = $table->{'Tablename'};
        $setting_vars->{'comment'} = $this->encode( $table->{'Comments'} );
        $setting_vars->{'columns'} = join( ",\n", @settings );
        $setting_vars->{'serials'} = join( "", @serials );
        $helper->render_file( 'schema_sql', "$schema_dir/$table->{'Tablename'}.sql", $setting_vars );

        # コントローラ出力
        my $controller_vars;
        $controller_vars->{'app_name'}   = $helper->{'app'};
        $controller_vars->{'path_name'}  = lc $class_name;
        $controller_vars->{'base_name'}  = $helper->{'name'};
        $controller_vars->{'model_name'} = $model_name;
        $controller_vars->{'class_name'} = $class_name;
        $controller_vars->{'comment'}    = $this->encode( $table->{'Comments'} );
        $controller_vars->{'primary'}    = $this->get_primary(@sqls);
        $controller_vars->{'columns'}    = $this->get_columns(@sqls);
        $controller_vars->{'sqls'}       = \@sqls;
        $helper->render_file( 'controller_class', "$controller_dir/$class_name.pm", $controller_vars );

        # テンプレート出力
        my $path_name = lc $class_name;
        $helper->mk_dir("$template_dir/$path_name");

        # Template-Toolkit
        $helper->render_file( 'create_tt', "$template_dir/$path_name/create.tt", $controller_vars );
        $helper->render_file( 'read_tt',   "$template_dir/$path_name/read.tt",   $controller_vars );
        $helper->render_file( 'update_tt', "$template_dir/$path_name/update.tt", $controller_vars );
        $helper->render_file( 'list_tt',   "$template_dir/$path_name/list.tt",   $controller_vars );

        # ClearSilver
        #$helper->render_file( 'create_cs', "$template_dir/$path_name/create.cs", $controller_vars );
        #$helper->render_file( 'read_cs',   "$template_dir/$path_name/read.cs",   $controller_vars );
        #$helper->render_file( 'update_cs', "$template_dir/$path_name/update.cs", $controller_vars );
        #$helper->render_file( 'list_cs',   "$template_dir/$path_name/list.cs",   $controller_vars );
    }

    # ヘッダー・フッター出力
    unless ( scalar @limited_file ) {
        my $header_footer_vars;
        $header_footer_vars->{'app_name'} = $helper->{'app'};

        # Template-Toolkit
        $helper->render_file( 'header_html', "$template_dir/header.tt", $header_footer_vars );
        $helper->render_file( 'footer_html', "$template_dir/footer.tt", $header_footer_vars );

        # ClearSilver
        #$helper->render_file( 'header_html', "$template_dir/header.cs", $header_footer_vars );
        #$helper->render_file( 'footer_html', "$template_dir/footer.cs", $header_footer_vars );
    }

    # 言語ファイル出力
    my $i18n_vars;
    $i18n_vars->{'keywords'} = \@keywords;
    if ( scalar @limited_file ) {
        $helper->render_file( 'ja_po', "$i18n_dir/ja.po", $i18n_vars );
        $helper->render_file( 'en_po', "$i18n_dir/en.po", $i18n_vars );
    } else {
        $helper->render_file( 'mini_ja_po', "$i18n_dir/ja.po", $i18n_vars );
        $helper->render_file( 'mini_en_po', "$i18n_dir/en.po", $i18n_vars );
    }

    print "==========================================================\n";
}

=head1 SEE ALSO

DBDesigner 4 -- http://fabforce.net/dbdesigner4/index.php

Catalyst::Helper::Model, Catalyst::Plugin::CRUD, XML::Simple

=head1 AUTHOR

Jun Shimizu, [e-mail]

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2006-2007 by Jun Shimizu

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.2 or,
at your option, any later version of Perl 5 you may have available.

=cut

1;

__DATA__