view release on metacpan or  search on metacpan

lib/DBIx/Skinny/Schema.pm  view on Meta::CPAN

package DBIx::Skinny::Schema;
use strict;
use warnings;
use DBIx::Skinny::Util;

BEGIN {
    *utf8_on  = DBIx::Skinny::Util::utf8_on;
    *utf8_off = DBIx::Skinny::Util::utf8_off;
}

sub import {
    my $caller = caller;

    my @functions = qw/
        install_table
          schema pk columns schema_info column_type row_class
        install_inflate_rule
          inflate deflate call_inflate call_deflate
          callback _do_inflate
        install_common_trigger trigger call_trigger
        install_utf8_columns
          is_utf8_column utf8_on utf8_off
    /;
    no strict 'refs';
    for my $func (@functions) {
        *{"$caller\::$func"} = \&$func;
    }

    my $_schema_info = {};
    *{"$caller\::schema_info"} = sub { $_schema_info };
    my $_schema_inflate_rule = {};
    *{"$caller\::inflate_rules"} = sub { $_schema_inflate_rule };
    my $_schema_common_triggers = {};
    *{"$caller\::common_triggers"} = sub { $_schema_common_triggers };
    my $_utf8_columns = {};
    *{"$caller\::utf8_columns"} = sub { $_utf8_columns };

    strict->import;
    warnings->import;
}

sub install_table ($$) {
    my ($table, $install_code) = @_;

    my $class = caller;
    $class->schema_info->{_installing_table} = $table;
        $install_code->();
    $class->schema_info->{$table}->{row_class} ||= DBIx::Skinny::Util::mk_row_class($class, $table);

    delete $class->schema_info->{_installing_table};
}

sub schema (&) { shift }

sub pk {
    my @columns = @_;

    my $class = caller;
    $class->schema_info->{
        $class->schema_info->{_installing_table}
    }->{pk} = (@columns == 1 ? $columns[0] : \@columns);
}

sub row_class ($) {
    my $row_class = shift;

    DBIx::Skinny::Util::load_class($row_class) or die "$row_class not found or compile error.";
    my $class = caller;
    $class->schema_info->{
        $class->schema_info->{_installing_table}
    }->{row_class} = $row_class;
}

sub columns (@) {
    my @columns = @_;

    my (@_columns, %_column_types);
    for my $item (@columns) {
        if (not ref $item) {
            push @_columns, $item;
        } elsif (ref $item eq 'HASH') {
            push @_columns, $item->{name};
            $_column_types{$item->{name}} = $item->{type};
        } else {
            die "columns must be 'SCALAR' or 'HASHREF'";    
        }
    }

    my $class = caller;
    $class->schema_info->{
        $class->schema_info->{_installing_table}
    }->{columns} = \@_columns;

    $class->schema_info->{
        $class->schema_info->{_installing_table}
    }->{column_types} = \%_column_types;
}