package DBIx::Custom;

use Object::Simple -base;

our $VERSION = '0.1733';

use 5.008001;

use Carp 'croak';

use DBI;

use DBIx::Custom::Result;

use DBIx::Custom::Query;

use DBIx::Custom::QueryBuilder;

use DBIx::Custom::Where;

use DBIx::Custom::Model;

use DBIx::Custom::Tag;

use DBIx::Custom::Order;

use DBIx::Custom::Util qw/_array_to_hash _subname/;

use DBIx::Custom::Mapper;

use DBIx::Custom::NotExists;

use Encode qw/encode encode_utf8 decode_utf8/;

use Scalar::Util qw/weaken/;

use constant DEBUG => $ENV{DBIX_CUSTOM_DEBUG} || 0;

use constant DEBUG_ENCODING => $ENV{DBIX_CUSTOM_DEBUG_ENCODING} || 'UTF-8';

has [qw/connector dsn password quote user exclude_table user_table_info

        user_column_info/],

    cache => 0,

    cache_method => sub {

        sub {

            my $self = shift;

            $self->{_cached} ||= {};

            if (@_ > 1) {

                $self->{_cached}{$_[0]} = $_[1];

            }

            else {

                return $self->{_cached}{$_[0]};

            }

        }

    },

    option => sub { {} },

    default_option => sub {

        {

            RaiseError => 1,

            PrintError => 0,

            AutoCommit => 1

        }

    },

    filters => sub {

        {

            encode_utf8 => sub { encode_utf8($_[0]) },

            decode_utf8 => sub { decode_utf8($_[0]) }

        }

    },

    last_sql => '',

    models => sub { {} },

    query_builder => sub {

        my $self = shift;

        my $builder = DBIx::Custom::QueryBuilder->new(dbi => $self);

        weaken $builder->{dbi};

        return $builder;

    },

    result_class  => 'DBIx::Custom::Result',

    safety_character => '\w',

    separator => '.',

    stash => sub { {} },

    tag_parse => 1;

sub available_datatype {

    my $self = shift;

    my $data_types = '';

    for my $i (-1000 .. 1000) {

         my $type_info = $self->dbh->type_info($i);

         my $data_type = $type_info->{DATA_TYPE};

         my $type_name = $type_info->{TYPE_NAME};

         $data_types .= "$data_type ($type_name)\n"

           if defined $data_type;

    }

    return "Data Type maybe equal to Type Name" unless $data_types;

    $data_types = "Data Type (Type name)\n" . $data_types;

    return $data_types;

}

sub available_typename {

    my $self = shift;

    # Type Names

    my $type_names = {};

    $self->each_column(sub {

        my ($self, $table, $column, $column_info) = @_;

        $type_names->{$column_info->{TYPE_NAME}} = 1

          if $column_info->{TYPE_NAME};

    });

    my @output = sort keys %$type_names;

    unshift @output, "Type Name";

    return join "\n", @output;

}

our $AUTOLOAD;

sub AUTOLOAD {

    my $self = shift;

    # Method name

    my ($package, $mname) = $AUTOLOAD =~ /^([\w\:]+)\:\:(\w+)$/;

    # Call method

    $self->{_methods} ||= {};

    if (my $method = $self->{_methods}->{$mname}) {

        return $self->$method(@_)

    }

    elsif ($self->{dbh} && (my $dbh_method = $self->dbh->can($mname))) {

        $self->dbh->$dbh_method(@_);

    }

    else {

        croak qq{Can't locate object method "$mname" via "$package" }

            . _subname;

    }

}

sub assign_clause {

    my ($self, $param, $opts) = @_;

    my $wrap = $opts->{wrap} || {};

    # Create set tag

    my @params;

    my $safety = $self->safety_character;

    for my $column (sort keys %$param) {

        croak qq{"$column" is not safety column name } . _subname

          unless $column =~ /^[$safety\.]+$/;

        my $column_quote = $self->_q($column);

        $column_quote =~ s/\./$self->_q(".")/e;

        my $func = $wrap->{$column} || sub { $_[0] };

        push @params,

          ref $param->{$column} eq 'SCALAR' ? "$column_quote = " . ${$param->{$column}}

        : "$column_quote = " . $func->(":$column");

    }

    my $tag = join(', ', @params);

    return $tag;

}

sub column {

    my $self = shift;

    my $option = pop if ref $_[-1] eq 'HASH';

    my $real_table = shift;

    my $columns = shift;

    my $table = $option->{alias} || $real_table;

    # Columns

    unless ($columns) {

        $columns ||= $self->model($real_table)->columns;

    }

    # Separator

    my $separator = $self->separator;

    # Column clause

    my @column;

    $columns ||= [];

    push @column, $self->_q($table) . "." . $self->_q($_) .

      " as " . $self->_q("${table}${separator}$_")

      for @$columns;

    return join (', ', @column);

}

sub connect {

    my $self = ref $_[0] ? shift : shift->new(@_);

    my $connector = $self->connector;

    if (!ref $connector && $connector) {

        require DBIx::Connector;

        my $dsn = $self->dsn;

        my $user = $self->user;

        my $password = $self->password;

        my $option = $self->_option;

        my $connector = DBIx::Connector->new($dsn, $user, $password,

          {%{$self->default_option} , %$option});

        $self->connector($connector);

    }

    # Connect

    $self->dbh;

    return $self;

}

sub count { shift->select(column => 'count(*)', @_)->fetch_first->[0] }

sub dbh {

    my $self = shift;

    # Set

    if (@_) {

        $self->{dbh} = $_[0];

        return $self;

    }

    # Get

    else {

        # From Connction manager

        if (my $connector = $self->connector) {

            croak "connector must have dbh() method " . _subname

              unless ref $connector && $connector->can('dbh');

            $self->{dbh} = $connector->dbh;

        }

        # Connect

        $self->{dbh} ||= $self->_connect;

        # Quote

        if (!defined $self->reserved_word_quote && !defined $self->quote) {

            my $driver = $self->_driver;

            my $quote =  $driver eq 'odbc' ? '[]'

                       : $driver eq 'ado' ? '[]'

                       : $driver eq 'mysql' ? '`'

                       : '"';

            $self->quote($quote);

        }

        return $self->{dbh};

    }

}

sub delete {

    my ($self, %opt) = @_;

    warn "delete method where_param option is DEPRECATED!"

      if $opt{where_param};

    # Don't allow delete all rows

    croak qq{delete method where or id option must be specified } . _subname

      if !$opt{where} && !defined $opt{id} && !$opt{allow_delete_all};

    # Where

    my $where = defined $opt{id}

           ? $self->_id_to_param($opt{id}, $opt{primary_key}, $opt{table})

           : $opt{where};

    my $w = $self->_where_clause_and_param($where, $opt{where_param});

    # Delete statement

    my $sql = "delete ";

    $sql .= "$opt{prefix} " if defined $opt{prefix};

    $sql .= "from " . $self->_q($opt{table}) . " $w->{clause} ";

    # Execute query

    return $self->execute($sql, $w->{param}, %opt);

}

sub delete_all { shift->delete(allow_delete_all => 1, @_) }

sub DESTROY {}

sub create_model {

    my $self = shift;

    # Options

    my $opt = ref $_[0] eq 'HASH' ? $_[0] : {@_};

    $opt->{dbi} = $self;

    my $model_class = delete $opt->{model_class} || 'DBIx::Custom::Model';

    my $model_name  = delete $opt->{name};

    my $model_table = delete $opt->{table};

    $model_name ||= $model_table;

    # Create model

    my $model = $model_class->new($opt);

    weaken $model->{dbi};

    $model->name($model_name) unless $model->name;

    $model->table($model_table) unless $model->table;

    # Apply filter(DEPRECATED logic)

    if ($model->{filter}) {

        my $filter = ref $model->filter eq 'HASH'

                   ? [%{$model->filter}]

                   : $model->filter;

        $filter ||= [];

        warn "DBIx::Custom::Model filter method is DEPRECATED!"

          if @$filter;

        $self->_apply_filter($model->table, @$filter);

    }

    # Set model

    $self->model($model->name, $model);

    return $self->model($model->name);

}

sub each_column {

    my ($self, $cb, %options) = @_;

    my $user_column_info = $self->user_column_info;

    if ($user_column_info) {

        $self->$cb($_->{table}, $_->{column}, $_->{info}) for @$user_column_info;

    }

    else {

        my $re = $self->exclude_table || $options{exclude_table};

        # Tables

        my %tables;

        $self->each_table(sub { $tables{$_[1]}++ });

        # Iterate all tables

        my @tables = sort keys %tables;

        for (my $i = 0; $i < @tables; $i++) {

            my $table = $tables[$i];

            # Iterate all columns

            my $sth_columns;

            eval {$sth_columns = $self->dbh->column_info(undef, undef, $table, '%')};

            next if $@;

            while (my $column_info = $sth_columns->fetchrow_hashref) {

                my $column = $column_info->{COLUMN_NAME};

                $self->$cb($table, $column, $column_info);

            }

        }

    }

}

sub each_table {

    my ($self, $cb, %option) = @_;

    my $user_table_infos = $self->user_table_info;

    # Iterate tables

    if ($user_table_infos) {

        $self->$cb($_->{table}, $_->{info}) for @$user_table_infos;

    }

    else {

        my $re = $self->exclude_table || $option{exclude};

        my $sth_tables = $self->dbh->table_info;

        while (my $table_info = $sth_tables->fetchrow_hashref) {

            # Table

            my $table = $table_info->{TABLE_NAME};

            next if defined $re && $table =~ /$re/;

            $self->$cb($table, $table_info);

        }

    }

}

sub execute {

    my $self = shift;

    my $sql = shift;

    my $param;

    $param = shift if @_ % 2;

    my %opt = @_;

    # Options

    my $p = $opt{param} || {};

    $param ||= $p;

    my $tables = $opt{table} || [];

    $tables = [$tables] unless ref $tables eq 'ARRAY';

    my $filter = $opt{filter};

    $filter = _array_to_hash($filter);

    my $bind_type = $opt{bind_type} || $opt{type};

    $bind_type = _array_to_hash($bind_type);

    my $type_rule_off = $opt{type_rule_off};

    my $type_rule_off_parts = {

        1 => $opt{type_rule1_off},

        2 => $opt{type_rule2_off}

    };

    my $query_return = $opt{query};

    my $table_alias = $opt{table_alias} || {};

    my $after_build_sql = $opt{after_build_sql} || $opt{sqlfilter};

    warn "sqlfilter option is DEPRECATED" if $opt{sqlfilter};

    my $id = $opt{id};

    my $primary_key = $opt{primary_key};

    croak "execute method primary_key option " .

          "must be specified when id is specified " . _subname

      if defined $id && !defined $primary_key;

    $primary_key = [$primary_key] unless ref $primary_key eq 'ARRAY';

    my $append = $opt{append};

    $sql .= $append if defined $append && !ref $sql;

    my $query

      = ref $sql ? $sql : $self->_create_query($sql, $after_build_sql);

    # Save query

    $self->last_sql($query->sql);

    return $query if $query_return;

    # DEPRECATED! Merge query filter

    $filter ||= $query->{filter} || {};

    # Tables

    unshift @$tables, @{$query->{tables} || []};

    my $main_table = @{$tables}[-1];

    if (defined $id) {

        my $id_param = $self->_id_to_param($id, $primary_key, $main_table);

        $param = $self->merge_param($id_param, $param);

    }

    # DEPRECATED! Cleanup tables

    $tables = $self->_remove_duplicate_table($tables, $main_table)

      if @$tables > 1;

    # Type rule

    my $type_filters = {};

    unless ($type_rule_off) {

        for my $i (1, 2) {

            unless ($type_rule_off_parts->{$i}) {

                $type_filters->{$i} = {};

                for my $alias (keys %$table_alias) {

                    my $table = $table_alias->{$alias};

                    for my $column (keys %{$self->{"_into$i"}{key}{$table} || {}}) {

                        $type_filters->{$i}->{"$alias.$column"} = $self->{"_into$i"}{key}{$table}{$column};

                    }

                }

                $type_filters->{$i} = {%{$type_filters->{$i}}, %{$self->{"_into$i"}{key}{$main_table} || {}}}

                  if $main_table;

            }

        }

    }

    # DEPRECATED! Applied filter

    if ($self->{filter}{on}) {

        my $applied_filter = {};

        for my $table (@$tables) {

            $applied_filter = {

                %$applied_filter,

                %{$self->{filter}{out}->{$table} || {}}

            }

        }

        $filter = {%$applied_filter, %$filter};

    }

    # Replace filter name to code

    for my $column (keys %$filter) {

        my $name = $filter->{$column};

        if (!defined $name) {

            $filter->{$column} = undef;

        }

        elsif (ref $name ne 'CODE') {

          croak qq{Filter "$name" is not registered" } . _subname

            unless exists $self->filters->{$name};

          $filter->{$column} = $self->filters->{$name};

        }

    }

    # Create bind values

    my $bind = $self->_create_bind_values(

        $param,

        $query->columns,

        $filter,

        $type_filters,

        $bind_type

    );

    # Execute

    my $sth = $query->sth;

    my $affected;

    eval {

        for (my $i = 0; $i < @$bind; $i++) {

            my $bind_type = $bind->[$i]->{bind_type};

            $sth->bind_param(

                $i + 1,

                $bind->[$i]->{value},

                $bind_type ? $bind_type : ()

            );

        }

        $affected = $sth->execute;

    };

    $self->_croak($@, qq{. Following SQL is executed.\n}

      . qq{$query->{sql}\n} . _subname) if $@;

    # DEBUG message

    if (DEBUG) {

        print STDERR "SQL:\n" . $query->sql . "\n";

        my @output;

        for my $b (@$bind) {

            my $value = $b->{value};

            $value = 'undef' unless defined $value;

            $value = encode(DEBUG_ENCODING(), $value)

              if utf8::is_utf8($value);

            push @output, $value;

        }

        print STDERR "Bind values: " . join(', ', @output) . "\n\n";

    }

    # Select statement

    if ($sth->{NUM_OF_FIELDS}) {

        # DEPRECATED! Filter

        my $filter = {};

        if ($self->{filter}{on}) {

            $filter->{in}  = {};

            $filter->{end} = {};

            push @$tables, $main_table if $main_table;

            for my $table (@$tables) {

                for my $way (qw/in end/) {

                    $filter->{$way} = {

                        %{$filter->{$way}},

                        %{$self->{filter}{$way}{$table} || {}}

                    };

                }

            }

        }

        # Result

        my $result = $self->result_class->new(

            sth => $sth,

            dbi => $self,

            default_filter => $self->{default_in_filter},

            filter => $filter->{in} || {},

            end_filter => $filter->{end} || {},

            type_rule => {

                from1 => $self->type_rule->{from1},

                from2 => $self->type_rule->{from2}

            },

        );

        return $result;

    }

    # Not select statement

    else { return $affected }

}

sub get_table_info {

    my ($self, %opt) = @_;

    my $exclude = delete $opt{exclude};

    croak qq/"$_" is wrong option/ for keys %opt;

    my $table_info = [];

    $self->each_table(

        sub { push @$table_info, {table => $_[1], info => $_[2] } },

        exclude => $exclude

    );

    return [sort {$a->{table} cmp $b->{table} } @$table_info];

}

sub get_column_info {

    my ($self, %opt) = @_;

    my $exclude_table = delete $opt{exclude_table};

    croak qq/"$_" is wrong option/ for keys %opt;

    my $column_info = [];

    $self->each_column(

        sub { push @$column_info, {table => $_[1], column => $_[2], info => $_[3] } },

        exclude_table => $exclude_table

    );

    return [

      sort {$a->{table} cmp $b->{table} || $a->{column} cmp $b->{column} }

        @$column_info];

}

sub helper {

    my $self = shift;

    # Register method

    my $methods = ref $_[0] eq 'HASH' ? $_[0] : {@_};

    $self->{_methods} = {%{$self->{_methods} || {}}, %$methods};

    return $self;

}

sub insert {

    my $self = shift;

    # Options

    my $param = @_ % 2 ? shift : undef;

    my %opt = @_;

    warn "insert method param option is DEPRECATED" if $opt{param};

    $param ||= delete $opt{param} || {};

    # Timestamp

    if ($opt{timestamp} && (my $insert_timestamp = $self->insert_timestamp)) {

        my $columns = $insert_timestamp->[0];

        $columns = [$columns] unless ref $columns eq 'ARRAY';

        my $value = $insert_timestamp->[1];

        $value = $value->() if ref $value eq 'CODE';

        $param->{$_} = $value for @$columns;

    }

    # Merge id to parameter

    $param = $self->merge_param(

        $self->_id_to_param($opt{id}, $opt{primary_key}), $param)

      if defined $opt{id};

    # Insert statement

    my $sql = "insert ";

    $sql .= "$opt{prefix} " if defined $opt{prefix};

    $sql .= "into " . $self->_q($opt{table}) . " "

      . $self->values_clause($param, {wrap => $opt{wrap}}) . " ";

    # Execute query

    return $self->execute($sql, $param, %opt);

}

sub insert_timestamp {

    my $self = shift;

    if (@_) {

        $self->{insert_timestamp} = [@_];

        return $self;

    }

    return $self->{insert_timestamp};

}

sub include_model {

    my ($self, $name_space, $model_infos) = @_;

    # Name space

    $name_space ||= '';

    # Get Model infomations

    unless ($model_infos) {

        # Load name space module

        croak qq{"$name_space" is invalid class name } . _subname

          if $name_space =~ /[^\w:]/;

        eval "use $name_space";

        croak qq{Name space module "$name_space.pm" is needed. $@ }

            . _subname

          if $@;

        # Search model modules

        my $path = $INC{"$name_space.pm"};

        $path =~ s/\.pm$//;

        opendir my $dh, $path

          or croak qq{Can't open directory "$path": $! } . _subname

        $model_infos = [];

        while (my $module = readdir $dh) {

            push @$model_infos, $module

              if $module =~ s/\.pm$//;

        }

        close $dh;

    }

    # Include models

    for my $model_info (@$model_infos) {

        # Load model

        my $model_class;

        my $model_name;

        my $model_table;

        if (ref $model_info eq 'HASH') {

            $model_class = $model_info->{class};

            $model_name  = $model_info->{name};

            $model_table = $model_info->{table};

            $model_name  ||= $model_class;

            $model_table ||= $model_name;

        }

        else { $model_class = $model_name = $model_table = $model_info }

        my $mclass = "${name_space}::$model_class";

        croak qq{"$mclass" is invalid class name } . _subname

          if $mclass =~ /[^\w:]/;

        unless ($mclass->can('isa')) {

            eval "use $mclass";

            croak "$@ " . _subname if $@;

        }

        # Create model

        my $opt = {};

        $opt->{model_class} = $mclass if $mclass;

        $opt->{name}        = $model_name if $model_name;

        $opt->{table}       = $model_table if $model_table;

        $self->create_model($opt);

    }

    return $self;

}

sub like_value { sub { "%$_[0]%" } }

sub mapper {

    my $self = shift;

    return DBIx::Custom::Mapper->new(@_);

}

sub merge_param {

    my ($self, @params) = @_;

    # Merge parameters

    my $merge = {};

    for my $param (@params) {

        for my $column (keys %$param) {

            my $param_is_array = ref $param->{$column} eq 'ARRAY' ? 1 : 0;

            if (exists $merge->{$column}) {

                $merge->{$column} = [$merge->{$column}]

                  unless ref $merge->{$column} eq 'ARRAY';

                push @{$merge->{$column}},

                  ref $param->{$column} ? @{$param->{$column}} : $param->{$column};

            }

            else {

                $merge->{$column} = $param->{$column};

            }

        }

    }

    return $merge;

}

sub model {

    my ($self, $name, $model) = @_;

    # Set model

    if ($model) {

        $self->models->{$name} = $model;

        return $self;

    }

    # Check model existance

    croak qq{Model "$name" is not included } . _subname

      unless $self->models->{$name};

    # Get model

    return $self->models->{$name};

}

sub mycolumn {

    my ($self, $table, $columns) = @_;

    # Create column clause

    my @column;

    $columns ||= [];

    push @column, $self->_q($table) . "." . $self->_q($_) .

      " as " . $self->_q($_)

      for @$columns;

    return join (', ', @column);

}

sub new {

    my $self = shift->SUPER::new(@_);

    # Check attributes

    my @attrs = keys %$self;

    for my $attr (@attrs) {

        croak qq{Invalid attribute: "$attr" } . _subname

          unless $self->can($attr);

    }

    # DEPRECATED

    $self->{_tags} = {

        '?'     => \&DBIx::Custom::Tag::placeholder,

        '='     => \&DBIx::Custom::Tag::equal,

        '<>'    => \&DBIx::Custom::Tag::not_equal,

        '>'     => \&DBIx::Custom::Tag::greater_than,

        '<'     => \&DBIx::Custom::Tag::lower_than,

        '>='    => \&DBIx::Custom::Tag::greater_than_equal,

        '<='    => \&DBIx::Custom::Tag::lower_than_equal,

        'like'  => \&DBIx::Custom::Tag::like,

        'in'    => \&DBIx::Custom::Tag::in,

        'insert_param' => \&DBIx::Custom::Tag::insert_param,

        'update_param' => \&DBIx::Custom::Tag::update_param

    };

    return $self;

}

sub not_exists { DBIx::Custom::NotExists->singleton }

sub order {

    my $self = shift;

    return DBIx::Custom::Order->new(dbi => $self, @_);

}

sub register_filter {

    my $self = shift;

    # Register filter

    my $filters = ref $_[0] eq 'HASH' ? $_[0] : {@_};

    $self->filters({%{$self->filters}, %$filters});

    return $self;

}

sub select {

    my ($self, %opt) = @_;

    # Options

    my $table = $opt{table};

    my $tables = ref $table eq 'ARRAY' ? $table

               : defined $table ? [$table]

               : [];

    $opt{table} = $tables;

    my $where     = $opt{where} || {};

    my $param = $opt{param} || {}; # DEPRECATED!

    warn "select() param option is DEPRECATED!"

      if keys %$param;

    my $where_param = $opt{where_param} || $param || {};

    # Add relation tables(DEPRECATED!);

    if ($opt{relation}) {

        warn "select() relation option is DEPRECATED!";

        $self->_add_relation_table($tables, $opt{relation});

    }

    # Select statement

    my $sql = 'select ';

    # Prefix

    $sql .= "$opt{prefix} " if defined $opt{prefix};

    # Column clause

    if (defined $opt{column}) {

        my $columns

          = ref $opt{column} eq 'ARRAY' ? $opt{column} : [$opt{column}];

        for my $column (@$columns) {

            if (ref $column eq 'HASH') {

                $column = $self->column(%$column) if ref $column eq 'HASH';

            }

            elsif (ref $column eq 'ARRAY') {

                if (@$column == 3 && $column->[1] eq 'as') {

                    warn "[COLUMN, as => ALIAS] is DEPRECATED! use [COLUMN => ALIAS]";

                    splice @$column, 1, 1;

                }

                $column = join(' ', $column->[0], 'as', $self->_q($column->[1]));

            }

            unshift @$tables, @{$self->_search_tables($column)};

            $sql .= "$column, ";

        }

        $sql =~ s/, $/ /;

    }

    else { $sql .= '* ' }

    # Table

    $sql .= 'from ';

    if ($opt{relation}) {

        my $found = {};

        for my $table (@$tables) {

            $sql .= $self->_q($table) . ', ' unless $found->{$table};

            $found->{$table} = 1;

        }

    }

    else {

        my $main_table = $tables->[-1] || '';

        $sql .= $self->_q($main_table) . ' ';

    }

    $sql =~ s/, $/ /;

    croak "Not found table name " . _subname

      unless $tables->[-1];

    # Add tables in parameter

    unshift @$tables,

            @{$self->_search_tables(join(' ', keys %$where_param) || '')};

    # Where

    my $where_clause = '';

    $where = $self->_id_to_param($opt{id}, $opt{primary_key}, $tables->[-1])

      if defined $opt{id};

    if (ref $where eq 'ARRAY' && !ref $where->[0]) {

        $where_clause = "where " . $where->[0];

        $where_param = $where->[1];

    }

    elsif (ref $where) {

        $where = $self->_where_to_obj($where);

        $where_param = keys %$where_param

                     ? $self->merge_param($where_param, $where->param)

                     : $where->param;

        # String where

        $where_clause = $where->to_string;

    }

    elsif ($where) { $where_clause = "where $where" }

    # Add table names in where clause

    unshift @$tables, @{$self->_search_tables($where_clause)};

    # Push join

    $self->_push_join(\$sql, $opt{join}, $tables) if defined $opt{join};

    # Add where clause

    $sql .= "$where_clause ";

    # Relation(DEPRECATED!);

    $self->_push_relation(\$sql, $tables, $opt{relation}, $where_clause eq '' ? 1 : 0)

      if $opt{relation};

    # Execute query

    my $result = $self->execute($sql, $where_param, %opt);

    return $result;

}

sub setup_model {

    my $self = shift;

    # Setup model

    $self->each_column(

        sub {

            my ($self, $table, $column, $column_info) = @_;

            if (my $model = $self->models->{$table}) {

                push @{$model->columns}, $column;

            }

        }

    );

    return $self;

}

sub show_datatype {

    my ($self, $table) = @_;

    croak "Table name must be specified" unless defined $table;

    print "$table\n";

    my $result = $self->select(table => $table, where => "'0' <> '0'");

    my $sth = $result->sth;

    my $columns = $sth->{NAME};

    my $data_types = $sth->{TYPE};

    for (my $i = 0; $i < @$columns; $i++) {

        my $column = $columns->[$i];

        my $data_type = $data_types->[$i];

        print "$column: $data_type\n";

    }

}

sub show_typename {

    my ($self, $t) = @_;

    croak "Table name must be specified" unless defined $t;

    print "$t\n";

    $self->each_column(sub {

        my ($self, $table, $column, $infos) = @_;

        return unless $table eq $t;

        my $typename = $infos->{TYPE_NAME};

        print "$column: $typename\n";

    });

    return $self;

}

sub show_tables {

    my $self = shift;

    my %tables;

    $self->each_table(sub { $tables{$_[1]}++ });

    print join("\n", sort keys %tables) . "\n";

    return $self;

}

sub type_rule {

    my $self = shift;

    if (@_) {

        my $type_rule = ref $_[0] eq 'HASH' ? $_[0] : {@_};

        # Into

        for my $i (1 .. 2) {

            my $into = "into$i";

            my $exists_into = exists $type_rule->{$into};

            $type_rule->{$into} = _array_to_hash($type_rule->{$into});

            $self->{type_rule} = $type_rule;

            $self->{"_$into"} = {};

            for my $type_name (keys %{$type_rule->{$into} || {}}) {

                croak qq{type name of $into section must be lower case}

                  if $type_name =~ /[A-Z]/;

            }

            $self->each_column(sub {

                my ($dbi, $table, $column, $column_info) = @_;

                my $type_name = lc $column_info->{TYPE_NAME};

                if ($type_rule->{$into} &&

                    (my $filter = $type_rule->{$into}->{$type_name}))

                {

                    return unless exists $type_rule->{$into}->{$type_name};

                    if  (defined $filter && ref $filter ne 'CODE') 

                    {

                        my $fname = $filter;

                        croak qq{Filter "$fname" is not registered" } . _subname

                          unless exists $self->filters->{$fname};

                        $filter = $self->filters->{$fname};

                    }

                    $self->{"_$into"}{key}{$table}{$column} = $filter;

                    $self->{"_$into"}{dot}{"$table.$column"} = $filter;

                }

            });

        }

        # From

        for my $i (1 .. 2) {

            $type_rule->{"from$i"} = _array_to_hash($type_rule->{"from$i"});

            for my $data_type (keys %{$type_rule->{"from$i"} || {}}) {

                croak qq{data type of from$i section must be lower case or number}

                  if $data_type =~ /[A-Z]/;

                my $fname = $type_rule->{"from$i"}{$data_type};

                if (defined $fname && ref $fname ne 'CODE') {

                    croak qq{Filter "$fname" is not registered" } . _subname

                      unless exists $self->filters->{$fname};

                    $type_rule->{"from$i"}{$data_type} = $self->filters->{$fname};

                }

            }

        }

        return $self;

    }

    return $self->{type_rule} || {};