Getting started with DBIx::Class::Schema::Loader

README

Getting started with DBIx::Class::Schema::Loader

Avatars.pm

package MyApp::Schema::Avatars;

sub hogehoge {
}


1;

create_schema.pl

#!/usr/bin/perl

use strict;
use warnings;

require shift;

make_schema(@ARGV);

__END__

maintain_schema.pl

#!/usr/bin/perl

use strict;
use warnings;

use File::Path;
use File::Spec;
use FindBin;

# アプリケーション固有の設定
my $application_name
    = 'myapp';
my $application_classname
    = 'MyApp';

# 関数従属される値の設定
my $schema_name
    = $application_classname . '::Schema';
my $library_directory
    = File::Spec->catfile( $FindBin::Bin, qw(.. .. lib) );
my $schema_directory
    = File::Spec->catfile( $library_directory, (split '::', $schema_name) );
my $schema_path
    = $schema_directory . '.pm';
my $database_directory
    = File::Spec->catfile( $FindBin::Bin, qw(.. .. path to) );
my $database_path
    = File::Spec->catfile( $database_directory, $application_name . '.db' );
my $sql_command_path
    = File::Spec->catfile( $FindBin::Bin, '..', $application_name . '.sql' );
my $dsn
    = 'dbi:SQLite:dbname=' . $database_path;
my %script = (
    creator => File::Spec->catfile( $FindBin::Bin, qw(create_schema.pl) ),
    updator => File::Spec->catfile( $FindBin::Bin, qw(update_schema.pl) ),
    maker   => File::Spec->catfile( $FindBin::Bin, qw(make_schema.pl)   ),
);

# 既存ファイル群の削除
unlink $schema_path;
rmtree $schema_directory;

# SQLiteのDBファイルの作成
die 'SQL command file does not exist'
    unless -f $sql_command_path;
mkpath $database_directory;
system sprintf(
    'sqlite3 %s < %s',
        $database_path,
        $sql_command_path,
);

# スキーマの生成
system sprintf(
    'perl %s %s %s %s %s',
        $script{creator},
        $script{maker},
        $schema_name,
        $library_directory,
        $dsn,
);

# スキーマの更新（独自追加処理の注入）
system sprintf(
    'perl %s %s %s %s %s',
        $script{updator},
        $script{maker},
        $schema_name,
        $library_directory,
        $dsn,
);

__END__

=pod

=head1 NAME

maintain_schema - 

=head1 SYNOPSIS

    $ cwd
    /any/path/Getting-Started-With-DBIx-Class
    $ schema/sbin/maintain_schema.pl

=head1 SEE ALSO

=over 4

=item * http://d.hatena.ne.jp/ZIGOROu/20080318/1205828357

=item * http://www.geocities.jp/mickindex/database/db_manner.html

=back

=head1 TO DO

MSWin32だと\r\nになるのが嫌だ。\nに出来ない？　後から変えるのは（ハッシュ値が違ってしまうので）駄目。

MySQL Workbenchから*.sqlを持ってきて、DROP TABLE IF EXISTS xxxx;を列挙してから/schema/myapp.sqlに持ってくるようにしたいところ。

=cut

make_schema.pl

#!/usr/bin/perl

use strict;
use warnings;

use DBIx::Class::Schema::Loader qw(
    make_schema_at
);

sub make_schema {
    my ($schema_name, $library_directory, $dsn, @args) = @_;

    make_schema_at(
        $schema_name,
        {
            # デフォルトでロードするコンポーネント群
            components
                => [ qw(
                    ResultSetManager
                    UTF8Columns
                )],
            # スキーマクラスの出力先ディレクトリ
            dump_directory
                => $library_directory,
            # 元にあったファイルを再生成時に消すか否か
            really_erase_my_files
                => 1,
            # デバッグモードで稼働するか否か
            debug
                => 1,
        },
        [$dsn, @args],
    );

    return;
}

1;

__END__

Meta.pm

package MyApp::Schema::Meta;

# めめたぁっ！
sub memetah {
}


1;

myapp.sql

-- テスト用DB

-- 以下はMySQL Workbenchから持ってきた後にスクリプトで自動生成したい
DROP TABLE IF EXISTS avatars;
DROP TABLE IF EXISTS reces;
DROP TABLE IF EXISTS meta;

-- プレイヤーズキャラクター
CREATE TABLE avatars (
    id       INTEGER      PRIMARY KEY          NOT NULL -- 識別子
  , forename VARCHAR(255) NOT NULL  DEFAULT ''          -- 名
  , surname  VARCHAR(255) NOT NULL  DEFAULT ''          -- 性
);

-- 種族
CREATE TABLE races (
    id   INTEGER      PRIMARY KEY          NOT NULL -- 識別子
  , name VARCHAR(255) NOT NULL  DEFAULT ''          -- 名称
);

-- スキーマ自体の情報
CREATE TABLE meta (
      version    NUMERIC      NOT NULL PRIMARY KEY          -- バージョン
    , created_on VARCHAR(255) NOT NULL DEFAULT '1111/11/11' -- 作成日
);

update_schema.pl

#!/usr/bin/perl

use strict;
use warnings;

use File::Spec;
use FindBin;

require shift;

use lib File::Spec->catfile( $FindBin::Bin, qw(.. lib) );
make_schema(@ARGV);

__END__