package DBIx::Custom;

use Object::Simple -base;

our $VERSION = '0.1737';

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/;

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} || {};

    my $safety = $self->{safety_character} || $self->safety_character;

    my $qp = $self->_q('');

    my $q = substr($qp, 0, 1) || '';

    my $p = substr($qp, 1, 1) || '';

    # Check unsafety keys

    unless ((join('', keys %$param) || '') =~ /^[$safety\.]+$/) {

        for my $column (keys %$param) {

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

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

        }

    }

    # Assign clause (performance is important)

    join(

      ', ',

      map {

          ref $param->{$_} eq 'SCALAR' ? "$q$_$p = " . ${$param->{$_}}

          : $wrap->{$_} ? "$q$_$p = " . $wrap->{$_}->(":$_")

          : "$q$_$p = :$_";

      } sort keys %$param

    );

}

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(delete $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

    $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;

    # Options

    my $param;

    $param = shift if @_ % 2;

    my %opt = @_;

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

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

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

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

    my $filter = ref $opt{filter} eq 'ARRAY' ?

      _array_to_hash($opt{filter}) : $opt{filter};

    # Append

    $sql .= $opt{append} if defined $opt{append} && !ref $sql;

    # Query

    my $query;

    if (ref $sql) { $query = $sql }

    else {

        $query = $opt{reuse}->{$sql} if $opt{reuse};

        $query = $self->_create_query($sql,$opt{after_build_sql} || $opt{sqlfilter})

          unless $query;

        $opt{reuse}->{$sql} = $query if $opt{reuse};

    }

    # Save query

    $self->{last_sql} = $query->{sql};

    # Return query

    return $query if $opt{query};

    # Merge query filter(DEPRECATED!)

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

    # Tables

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

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

    # Convert id to parameter

    if (defined $opt{id}) {

        $opt{statement} ||= '';

        my $id_param = $self->_id_to_param($opt{id}, $opt{primary_key},

          $opt{statement} eq 'insert' ? undef : $main_table);

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

    }

    # Cleanup tables(DEPRECATED!)

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

      if @$tables > 1;

    # Type rule

    my $type_filters = {};

    if ($self->{_type_rule_is_called}) {

        unless ($opt{type_rule_off}) {

            my $type_rule_off_parts = {

                1 => $opt{type_rule1_off},

                2 => $opt{type_rule2_off}

            };

            for my $i (1, 2) {

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

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

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

                    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;

                }

            }

        }

    }

    # Applied filter(DEPRECATED!)

    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, $bind_types) = $self->_create_bind_values($param, $query->columns,

      $filter, $type_filters, $opt{bind_type} || $opt{type} || {});

    # Execute

    my $sth = $query->{sth};

    my $affected;

    eval {

        if ($opt{bind_type} || $opt{type}) {

            $sth->bind_param($_ + 1, $bind->[$_],

                $bind_types->[$_] ? $bind_types->[$_] : ())

              for (0 .. @$bind - 1);

            $affected = $sth->execute;

        }

        else {

            $affected = $sth->execute(@$bind);

        }

    };

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

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

    # DEBUG message

    if ($ENV{DBIX_CUSTOM_DEBUG}) {

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

        my @output;

        for my $value (@$bind) {

            $value = 'undef' unless defined $value;

            $value = encode($ENV{DBIX_CUSTOM_DEBUG_ENCODING} || 'UTF-8', $value)

              if utf8::is_utf8($value);

            push @output, $value;

        }

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

    }

    # Not select statement

    return $affected unless $sth->{NUM_OF_FIELDS};

    # Filter(DEPRECATED!)

    my $infilter = {};

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

        $infilter->{in}  = {};

        $infilter->{end} = {};

        push @$tables, $main_table if $main_table;

        for my $table (@$tables) {

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

                $infilter->{$way} = {%{$infilter->{$way}},

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

            }

        }

    }

    # Result

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

        sth => $sth,

        dbi => $self,

        default_filter => $self->{default_in_filter},

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

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

        type_rule => {

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

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

        },

    );

    $result;

}

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

    if (defined $opt{id}) {

        croak "insert primary_key option must be specified with id option"

          unless $opt{primary_key};

        $opt{primary_key} = [$opt{primary_key}] unless ref $opt{primary_key};

        $opt{id} = [$opt{id}] unless ref $opt{id};

        for (my $i = 0; $i < @{$opt{primary_key}}; $i++) {

           my $key = $opt{primary_key}->[$i];

           croak "id already contain in parameter" if exists $param->{$key};

           $param->{$key} = $opt{id}->[$i];

        }

    }

    # 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}}) . " ";

    # Remove id from parameter

    if (defined $opt{id}) { delete $param->{$_} for @{$opt{primary_key}} }

    # Execute query

    $opt{statement} = 'insert';

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

}

sub _merge_id_to_param {

    my ($self, $id, $primary_keys, $param) = @_;

    # Create parameter

    $id = [$id] unless ref $id;

    return $param;

}

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 $tables = ref $opt{table} eq 'ARRAY' ? $opt{table}

               : defined $opt{table} ? [$opt{table}]

               : [];

    $opt{table} = $tables;

    my $where_param = $opt{where_param} || delete $opt{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

    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 { $sql .= $self->_q($tables->[-1] || '') . ' ' }

    $sql =~ s/, $/ /;

    croak "select method table option must be specified " . _subname

      unless $tables->[-1];

    # Add tables in parameter

    unshift @$tables,

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

    # Where

    my $where = defined $opt{id}

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

              : $opt{where};

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

    # Add table names in where clause

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

    # Join statement

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

    # Add where clause

    $sql .= "$w->{clause} ";

    # Relation(DEPRECATED!);

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

      if $opt{relation};

    # Execute query

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

    $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;

    $self->{_type_rule_is_called} = 1;

    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} || {};

}

sub update {

    my $self = shift;

    # Options

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

    my %opt = @_;

    warn "update param option is DEPRECATED!" if $opt{param};

    warn "update method where_param option is DEPRECATED!"

      if $opt{where_param};

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

    # Don't allow update all rows

    croak qq{update method where option must be specified } . _subname

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