use 5.008007;

package DBIx::Custom;

use Object::Simple -base;

our $VERSION = '0.23';

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 safety_character/],

  async_conf => sub { {} },

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

  now => sub {

    sub {

      my ($sec, $min, $hour, $mday, $mon, $year) = localtime;

      $mon++;

      $year += 1900;

      my $now = sprintf("%04d-%02d-%02d %02d:%02d:%02d",

        $year, $mon, $mday, $hour, $min, $sec);

      return $now;

    }

  },

  query_builder => sub {

    my $self = shift;

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

    weaken $builder->{dbi};

    return $builder;

  },

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

  separator => '.',

  stash => sub { {} };

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 ($q, $p) = $self->_qp;

  # 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 (defined $columns) {

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

  }

  # Separator

  my $separator = $self->separator;

  # . is replaced

  my $t = $table;

  $t =~ s/\./$separator/g;

  # Column clause

  my @column;

  $columns ||= [];

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

    " as " . $self->q("${t}${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_one->[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 $w = $self->_where_clause_and_param($opt{where}, $opt{where_param},

    delete $opt{id}, $opt{primary_key}, $opt{table});

  # Delete statement

  my $sql = "delete ";

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

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

  # Execute query

  $opt{statement} = 'delete';

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

  $params = shift if @_ % 2;

  my %opt = @_;

  # Async query

  $opt{prepare_attr} = $self->async_conf->{prepare_attr} if $opt{async};

  if ($opt{async} && !$self->{_new_connection}) {

    my $dsn = $self->dsn;

    croak qq/Data source must be specified when "async" option is used/

      unless defined $dsn;

    my $user = $self->user;

    my $password = $self->password;

    my $option = $self->_option;

    my $new_dbi = bless {%$self}, ref $self;

    $new_dbi->connector(undef);

    $new_dbi->{dbh} = DBI->connect($dsn, $user, $password,

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

    $new_dbi->{_new_connection} = 1;

    return $new_dbi->execute($sql, defined $params ? ($params) : (), %opt);

  }

  # Options

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

  $params ||= $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};

  # Merge second parameter

  my @cleanup;

  my $saved_param;

  $opt{statement} ||= '';

  $opt{statement} = 'select' if $opt{select};

  if (($opt{statement} || '') ne 'insert' && ref $params eq 'ARRAY') {

    my $params2 = $params->[1];

    $params = $params->[0];

    for my $column (keys %$params2) {

      if (!exists $params->{$column}) {

        $params->{$column} = $params2->{$column};

        push @cleanup, $column;

      }

      else {

        delete $params->{$_} for @cleanup;

        @cleanup = ();

        $saved_param  = $params;

        $params = $self->merge_param($params, $params2);

        delete $saved_param->{$_} for (@{$opt{cleanup} || []});

        last;

      }

    }

  }

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

  # Append

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

  # Query

  my $query;

  if (ref $sql) {

    $query = $sql;

    warn "execute method receiving query object as first parameter is DEPRECATED!" .

      "because this is very buggy.";

  }

  else {

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

    unless ($query) {

      my $c = $self->{safety_character};

      # Check unsafety keys

      unless ((join('', keys %{$params->[0]}) || '') =~ /^[$c\.]+$/) {

        for my $column (keys %{$params->[0]}) {

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

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

        }

      }

      $query = $self->_create_query($sql,

        $opt{after_build_sql} || $opt{sqlfilter}, $opt{prepare_attr});

    }

    $query->{statement} = $opt{statement} || '';

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

  }

  # Save query

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

  # Return query

  if ($opt{query}) {

    for my $column (@cleanup, @{$opt{cleanup} || []}) {

      delete $_->{$column} for @$params;

    }

    return $query;

  };

  # Merge query filter(DEPRECATED!)

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

  # Tables

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

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

  # Merge id to parameter

  if (defined $opt{id}) {

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

    warn "execute method id option is DEPRECATED!" unless $statement;

    croak "execute id option must be specified with primary_key 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{id}}; $i++) {

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

      $key = "$main_table.$key" if $statement eq 'update' ||

        $statement eq 'delete' || $statement eq 'select';

      next if exists $params->[0]->{$key};

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

      push @cleanup, $key;1

    }

  }

  # Cleanup tables(DEPRECATED!)

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

    if @$tables > 1;

  # Type rule

  my $type_filters = {};

  my $type_rule_off = !$self->{_type_rule_is_called} || $opt{type_rule_off};

  unless ($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};

    }

  }

  # Execute

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

  my $affected;

  if ((!$query->{duplicate} || $opt{bulk_insert}) && $type_rule_off

    && !keys %$filter && !$self->{default_out_filter}

    && !$opt{bind_type} && !$opt{type} && !$ENV{DBIX_CUSTOM_DEBUG})

  {

    eval {

      if ($opt{bulk_insert}) {

        my %count;

        my $param = $params->[0];

        $affected = $sth->execute(map { $param->{$_}->[++$count{$_} - 1] }

          @{$query->{columns}});

      }

      else {

        for my $param (@$params) {

          $affected = $sth->execute(map { $param->{$_} }

            @{$query->{columns}});

        }

      }

    };

  }

  else {

    for my $param (@$params) {

      # Create bind values

      my ($bind, $bind_types) = $self->_create_bind_values($param, $query->{columns},

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

      # Execute

      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) }

        # 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";

        }

      };

    }

  }

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

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

  # Remove id from parameter

  for my $column (@cleanup, @{$opt{cleanup} || []}) {

    delete $_->{$column} for @$params;

  }

  # Not select statement

  return $affected if !$sth->{NUM_OF_FIELDS} && $opt{statement} ne 'select';

  # 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}

    },

  );

  if (my $cb = $opt{async}) {

    require AnyEvent;

    my $watcher;

    weaken $self;

    $watcher = AnyEvent->io(

      fh => $self->async_conf->{fh}->($self),

      poll => 'r',

      cb   => sub {

        $cb->($self, $result);

        undef $watcher;

        undef $result;

        undef $cb;

      },

    );

  }

  else { $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 $params = @_ % 2 ? shift : undef;

  my %opt = @_;

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

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

  my $multi;

  if (ref $params eq 'ARRAY') { $multi = 1 }

  else { $params = [$params] }

  # Timestamp(DEPRECATED!)

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

    warn "insert timestamp option is DEPRECATED! use ctime option";

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

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

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

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

    $params->[0]->{$_} = $value for @$columns;

  }

  # Created time and updated time

  my @timestamp_cleanup;

  warn "insert method created_at option is DEPRECATED! "

      . "use ctime option instead. " . _subname

    if $opt{created_at};

  warn "insert method updated_at option is DEPRECATED! "

      . "use mtime option instead. " . _subname

    if $opt{updated_at};

  $opt{ctime} ||= $opt{created_at};

  $opt{mtime} ||= $opt{updated_at};

  if (defined $opt{ctime} || defined $opt{mtime}) {

    my $now = $self->now;

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

    if (defined $opt{ctime}) {

      $_->{$opt{ctime}} = $now for @$params;

      push @timestamp_cleanup, $opt{ctime};

    }

    if (defined $opt{mtime}) {

      $_->{$opt{mtime}} = $now for @$params;

      push @timestamp_cleanup, $opt{mtime};

    }

  }

  # Merge id to parameter

  my @cleanup;

  my $id_param = {};

  if (defined $opt{id} && !$multi) {

    croak "insert id option must be specified with primary_key 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];

      next if exists $params->[0]->{$key};

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

      push @cleanup, $key;

    }

  }

  # Insert statement

  my $sql = "insert ";

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

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

  if ($opt{bulk_insert}) {

    $sql .= $self->_multi_values_clause($params, {wrap => $opt{wrap}}) . " ";

    my $new_param = {};

    $new_param->{$_} = [] for keys %{$params->[0]};

    for my $param (@$params) {

      push @{$new_param->{$_}}, $param->{$_} for keys %$param;

    }

    $params = [$new_param];

  }

  else {

    $sql .= $self->values_clause($params->[0], {wrap => $opt{wrap}}) . " ";

  }

  # Remove id from parameter

  delete $params->[0]->{$_} for @cleanup;

  # Execute query

  $opt{statement} = 'insert';

  $opt{cleanup} = \@timestamp_cleanup;

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

}

sub insert_timestamp {

  my $self = shift;

  warn "insert_timestamp method is DEPRECATED! use now attribute";

  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

    my @modules;

    while (my $file = readdir $dh) {

      my $file_abs = "$path/$file";

      if (-d $file_abs) {

        next if $file eq '.' || $file eq '..';

        opendir my $fq_dh, $file_abs

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

        while (my $fq_file = readdir $fq_dh) {

          my $fq_file_abs = "$file_abs/$fq_file";

          push @modules, "${file}::$fq_file" if -f $fq_file_abs;

        }

        close $fq_dh;

      }

      elsif(-f $file_abs) { push @modules, $file }

    }

    close $dh;

    $model_infos = [];

    for my $module (@modules) {

      if ($module =~ s/\.pm$//) { push @$model_infos, $module }

    }

  }

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

    }

    $model_class =~ s/\./::/g;

    $model_name =~ s/::/./;

    $model_table =~ s/::/./;

    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->_tq($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);

  }

  $self->{safety_character} = 'a-zA-Z0-9_'

    unless exists $self->{safety_character};

  # 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

  };

  $self->{tag_parse} = 1 unless exists $self->{tag_parse};

  $self->{cache} = 0 unless exists $self->{cache};

  return $self;

}

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

sub order {

  my $self = shift;

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

}

sub q { shift->_tq($_[0], $_[1], whole => 1) }

sub _tq {

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

  my $quote = $self->{reserved_word_quote}

    || $self->{quote} || $self->quote || '';

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

  my $p;

  if (defined $quote && length $quote > 1) {

    $p = substr($quote, 1, 1);

  }

  else { $p = $q }

  if ($quotemeta) {

    $q = quotemeta($q);

    $p = quotemeta($p);

  }

  if ($opt{whole}) { return "$q$value$p" }

  else {

    my @values = split /\./, $value;

    push @values, '' unless @values;

    for my $v (@values) { $v = "$q$v$p" }

    return join '.', @values;

  }

}

sub _qp {

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

  my $quote = $self->{reserved_word_quote}

    || $self->{quote} || $self->quote || '';

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

  my $p;

  if (defined $quote && length $quote > 1) {

    $p = substr($quote, 1, 1);

  }

  else { $p = $q }

  if ($opt{quotemeta}) {

    $q = quotemeta($q);

    $p = quotemeta($p);

  }

  return ($q, $p);

}

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 = shift;

  my $column = shift if @_ % 2;

  my %opt = @_;

  $opt{statement} = 'select';

  $opt{column} = $column if defined $column;

  # Options

  my $table_is_empty;

  my $tables = ref $opt{table} eq 'ARRAY' ? $opt{table}

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

    : [];

  $opt{table} = $tables;

  $table_is_empty = 1 unless @$tables;

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

  warn "select method where_param option is DEPRECATED!"

    if $opt{where_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') {

        warn "select column option [COLUMN => ALIAS] syntax is DEPRECATED!" .

          "use q method to quote the value";

        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)}

        unless $table_is_empty;

      $sql .= "$column, ";

    }

    $sql =~ s/, $/ /;

  }

  else { $sql .= '* ' }

  # Execute query without table

  return $self->execute($sql, {}, %opt) if $table_is_empty;

  # Table

  $sql .= 'from ';

  if ($opt{relation}) {

    my $found = {};

    for my $table (@$tables) {

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

      $found->{$table} = 1;

    }

  }

  else { $sql .= $self->_tq($tables->[-1] || '') . ' ' }

  $sql =~ s/, $/ /;

  # Add tables in parameter

  unshift @$tables,

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

  # Where

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

    delete $opt{id}, $opt{primary_key}, @$tables ? $tables->[-1] : undef);

  # 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

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

}

sub setup_model {

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

  # Setup model

  $self->each_column(

    sub {

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

      my $database = $column_info->{TABLE_SCHEM};

      return if exists $opt{database} && $opt{database} ne $database;

      $table = "$database.$table" if exists $opt{prefix};

      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 = lc $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 = lc $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};

  # Timestamp(DEPRECATED!)

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

    warn "update timestamp option is DEPRECATED! use mtime";

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

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

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

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

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

  }

  # Created time and updated time

  my @timestamp_cleanup;

  warn "update method update_at option is DEPRECATED! "

      . "use mtime option instead " . _subname

    if $opt{updated_at};

  $opt{mtime} ||= $opt{updated_at};

  if (defined $opt{mtime}) {