Inside of DBIx::Schema::DSL
TIME rest time current/total
TopicsPlaceHolder

Inside of DBIx::Schema::DSL

Shibuya.pm #18

Jul 5th, 2018

Profile

songmu

Mackerel

Mackerel

【宣伝】書籍発売中

【宣伝】みんなのGo言語

【宣伝】エンジニア積極採用中です！

DBIx::Schema::DSLの話

先程バージョン 1.0000 をshipしました

DBIx::Schema::DSL

package MySchema;
use DBIx::Schema::DSL;

database 'MySQL';

create_table author => columns {
    integer 'id', primary_key, auto_increment;
    varchar 'name';
    integer 'age';
    decimal 'height', precision => 4, scale => 1;

    add_index 'height_idx' => ['height'];

    has_many 'book';
};

create_table book => columns {
    primary_key 'id';
    varchar 'name';
    integer 'author_id';
    decimal 'price', size => [4,2];
    column 'meta', 'json';

    add_index 'author_id_idx' => ['author_id'];

    belongs_to 'author';
};

出力

% perl -ML -E 'say MySchema->output' > sql/myapp.sql

DBIx::Schema::DSL

メリデメ

メリット

デメリット

SQL::Translator

SQL::Translator is a group of Perl modules that manipulate structured data definitions (mostly database schemas)

http://sqlfairy.sourceforge.net/

SQL::Translator

主にSQLスキーマを読み込んで、Perlのオブジェクトにマッピングし、それを様々な形で出力可能にするすごいやつ。

SQL::Translator::Parser::*
↓
SQL::Translator
↓
SQL::Translator::Producer::*

SQL::Translator::Parser

SQL::Translator::Producer

SQL::Translator::Producer::Teng

DEMO

PerlによるDSLの作り方

DSLとは？

Perlで作られたDSL

LLで書くDSLの種類

言語内DSLの種類

Perlによる言語内DSLの作り方

DSLのシンタックスは関数として定義する

サブルーチンプロトタイプ

sub名の後にparenを付けて引数の型を指定することができる機能だが、今日ではほとんど使われないし使わないほうが良い。現代では、Perlにもsubroutine signatureがある。

DSLを作るときに活用されるという本来の目的とはちょっと違う用途に使われることがある。

サブルーチンプロトタイプの実例

sub CONST() { 'CONST' } # 定数

sub hoge($) {
    my $scalar = shift;
}

sub run(&) {
    my $code = shift;
    $code->();
}

コードブロックを受け取るプロトタイプ

sub run(&) {
    my $code = shift;
    $code->();
}

run( sub { ... });
# を以下のように書ける
run {
    ... # ここのコードが実行される
};

DBIx::Schema::DSLの場合

create_table book => columns {
    integer 'id',   primary_key, auto_increment;
    varchar 'name', null;
    integer 'author_id', not_null;
    decimal 'price', 'size' => [4,2];
    column  'meta', 'json';

    add_index  'author_id_idx' => ['author_id'];
    belongs_to 'author';
};

ここで使われているシンタックス一覧

状態の保存

単なる関数呼び出しなのにどこに状態を保存しているのか

callerを使った呼び出し元解決

my $pkg = caller;

クラス変数にコンテキストオブジェクトを隠す

sub contex {
    my $pkg = shift;
    die 'something went wrong when calling context method.' if $pkg eq __PACKAGE__;
    no strict 'refs';
    ${"$pkg\::CONTEXT"} ||= DBIx::Schema::DSL::Context->new;
}

my $c = caller->context; というコードが頻出する。

gotoの活用

goto &NAME

いくつかあるgoto。perldoc -f goto 参考のこと

The "goto &NAME" form is quite different from the other forms of "goto". In fact, it isn't a goto in the normal sense at all, and doesn't have the stigma associated with other gotos. Instead, it exits the current subroutine (losing any changes set by "local") and immediately calls in its place the named subroutine using the current value of @_. This is used by "AUTOLOAD" subroutines that wish to load another subroutine and then pretend that the other subroutine had been called in the first place (except that any modifications to @_ in the current subroutine are propagated to the other subroutine.) After the "goto", not even "caller" will be able to tell that this routine was called first.

NAME needn't be the name of a subroutine; it can be a scalar variable containing a code reference or a block that evaluates to a code reference.

つまり？

呼び出し元を変えないためにgotoを活用

integer 'id';
# 内部的には以下を呼び出している
column 'id, 'integer';

columnの定義は以下のような感じ

sub column($$;%) {
    my ($column_name, $data_type, @opt) = @_;
    ...

普通の関数呼び出しではダメ

sub integer {
    my $column_name = shift;
    column $column_name, 'integer', @_;
}

gotoを使う

引数(@_)を書き換えてから gotoで関数を呼び出す。

sub integer {
    my $column_name = shift;
    @_ = ($column_name, 'integer', @_);
    goto \&column;
}

これであたかもcolumn関数が呼び出し元のパッケージから直接呼び出されたかのようになる。

実際にintegerからcolumnを呼び出しているところ

for my $method (@column_methods) {
    no strict 'refs';
    *{__PACKAGE__."::$method"} = sub {
        use strict 'refs';
        my $column_name = shift;

        @_ = ($column_name, $method, @_);
        goto \&column;
    };
}

頑張ってますね。

ちょいネタ

void contexの判定

sub column($$;%) {
    my ($column_name, $data_type, @opt) = @_;
    croak '`column` function called in non void context'
        if defined wantarray;

wantarrayの返り値

以下のような呼び出しを避けられる

# 普通に代入
my $var = column ...;

# columns column の間違い
create_table 'hoge', column { # s/column/columns/g
    ...
};

# 行末のミス
column ..., # <- セミコロンじゃなくてカンマになってる
column ...;

関数呼び出し位置の制限

言語内DSLとエラーメッセージ

以上

ご質問あれば