package DBIx::Custom;

our $VERSION = '0.1667';

use 5.008001;

use strict;

use warnings;

use base 'Object::Simple';

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::Util;

use Encode qw/encode_utf8 decode_utf8/;

our @COMMON_ARGS = qw/table query filter type/;

__PACKAGE__->attr(

    [qw/data_source password pid user/],

    cache => 0,

    cache_method => sub {

        sub {

            my $self = shift;

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

            if (@_ > 1) {

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

            }

            else {

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

            }

        }

    },

    dbi_option => sub { {} },

    default_dbi_option => sub {

        {

            RaiseError => 1,

            PrintError => 0,

            AutoCommit => 1

        }

    },

    filters => sub {

        {

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

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

        }

    },

    models => sub { {} },

    query_builder => sub { DBIx::Custom::QueryBuilder->new },

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

    safety_character => '\w',

    stash => sub { {} }

);

our $AUTOLOAD;

sub AUTOLOAD {

    my $self = shift;

    # Method name

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

    # Method

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

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

        return $self->$method(@_)

    }

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

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

    }

    else {

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

    }

}

sub apply_filter {

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

    # Initialize filters

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

    $self->{filter}{out} ||= {};

    $self->{filter}{in} ||= {};

    $self->{filter}{end} ||= {};

    # Create filters

    my $usage = "Usage: \$dbi->apply_filter(" .

                "TABLE, COLUMN1, {in => INFILTER1, out => OUTFILTER1, end => ENDFILTER1}, " .

                "COLUMN2, {in => INFILTER2, out => OUTFILTER2, end => ENDFILTER2}, ...)";

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

        # Column

        my $column = $cinfos[$i];

        if (ref $column eq 'ARRAY') {

            foreach my $c (@$column) {

                push @cinfos, $c, $cinfos[$i + 1];

            }

            next;

        }

        # Filter info

        my $finfo = $cinfos[$i + 1] || {};

        croak "$usage (table: $table)" unless  ref $finfo eq 'HASH';

        foreach my $ftype (keys %$finfo) {

            croak "$usage (table: $table 2)" unless $ftype eq 'in' || $ftype eq 'out'

                             || $ftype eq 'end'; 

        }

        foreach my $way (qw/in out end/) {

            my $filter = $finfo->{$way};

            # State

            my $state = !exists $finfo->{$way} ? 'not_exists'

                      : !defined $filter        ? 'not_defined'

                      : ref $filter eq 'CODE'   ? 'code'

                      : 'name';

            next if $state eq 'not_exists';

            # Check filter

            croak qq{Filter "$filter" is not registered}

              if  $state eq 'name'

               && ! exists $self->filters->{$filter};

            # Filter

            my $f = $state eq 'not_defined' ? undef

                  : $state eq 'code'        ? $filter

                  : $self->filters->{$filter};

            $self->{filter}{$way}{$table}{$column} = $f;

            $self->{filter}{$way}{$table}{"$table.$column"} = $f;

            $self->{filter}{$way}{$table}{"${table}__$column"} = $f;

        }

    }

    return $self;

}

sub column {

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

    $columns ||= [];

    my @column;

    push @column, "$table.$_ as ${table}__$_" for @$columns;

    return join (', ', @column);

}

sub connect {

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

    my $dbh = $self->_connect;

    # Database handle

    $self->dbh($dbh);

    # Process ID

    $self->pid($$);

    return $self;

}

sub create_query {

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

    # Cache

    my $cache = $self->cache;

    # Create query

    my $query;

    if ($cache) {

        # Get query

        my $q = $self->cache_method->($self, $source);

        # Create query

        if ($q) {

            $query = DBIx::Custom::Query->new($q);

            $query->filters($self->filters);

        }

    }

    unless ($query) {

        # Create SQL object

        my $builder = $self->query_builder;

        # Create query

        $query = $builder->build_query($source);

        # Cache query

        $self->cache_method->($self, $source,

                             {sql     => $query->sql, 

                              columns => $query->columns,

                              tables  => $query->tables})

          if $cache;

    }

    # Prepare statement handle

    my $sth;

    eval { $sth = $self->dbh->prepare($query->{sql})};

    $self->_croak($@, qq{. Following SQL is executed. "$query->{sql}"}) if $@;

    # Set statement handle

    $query->sth($sth);

    # Set filters

    $query->filters($self->filters);

    return $query;

}

sub dbh {

    my $self = shift;

    if (@_) {

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

        return $self;

    }

    else {

        my $pid = $$;

        if ($self->pid eq $pid) {

            return $self->{dbh};

        }

        else {

            # Create new connection in child process

            croak "Process is forked in transaction"

              unless $self->{dbh}->{AutoCommit};

            $self->pid($pid);

            $self->{dbh}->{InactiveDestroy} = 1;

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

        }

    }

}

our %DELETE_ARGS

  = map { $_ => 1 } @COMMON_ARGS, qw/where append allow_delete_all/;

sub delete {

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

    # Check argument names

    foreach my $name (keys %args) {

        croak qq{Argument "$name" is invalid name}

          unless $DELETE_ARGS{$name};

    }

    # Arguments

    my $table = $args{table} || '';

    croak qq{"table" option must be specified} unless $table;

    my $where            = delete $args{where} || {};

    my $append           = delete $args{append};

    my $allow_delete_all = delete $args{allow_delete_all};

    # Where

    my $w = $self->_where($where);

    $where = $w->param;

    # String where

    my $swhere = "$w";

    croak qq{"where" must be specified}

      if $swhere eq '' && !$allow_delete_all;

    # SQL stack

    my @sql;

    # Delete

    push @sql, "delete from $table $swhere";

    push @sql, $append if $append;

    my $sql = join(' ', @sql);

    # Create query

    my $query = $self->create_query($sql);

    return $query if $args{query};

    # Execute query

    my $ret_val = $self->execute(

        $query,

        param  => $where,

        table => $table,

        %args

    );

    return $ret_val;

}

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

our %DELETE_AT_ARGS = (%DELETE_ARGS, where => 1, primary_key => 1);

sub delete_at {

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

    # Check argument names

    foreach my $name (keys %args) {

        croak qq{Argument "$name" is invalid name}

          unless $DELETE_AT_ARGS{$name};

    }

    # Primary key

    my $primary_keys = delete $args{primary_key};

    $primary_keys = [$primary_keys] unless ref $primary_keys;

    # Where clause

    my $where = {};

    if (exists $args{where}) {

        my $where_columns = delete $args{where};

        $where_columns = [$where_columns] unless ref $where_columns;

        croak qq{"where" must be constant value or array reference}

          unless !ref $where_columns || ref $where_columns eq 'ARRAY';

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

           $where->{$primary_keys->[$i]} = $where_columns->[$i];

        }

    }

    if (exists $args{param}) {

        my $param = delete $args{param};

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

            delete $param->{$primary_keys->[$i]};

        }

    }

    return $self->delete(where => $where, %args);

}

sub DESTROY { }

our %EXECUTE_ARGS = map { $_ => 1 } @COMMON_ARGS, 'param';

sub create_model {

    my $self = shift;

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

    $args->{dbi} = $self;

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

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

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

    $model_name ||= $model_table;

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

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

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

    # Apply filter

    croak "$model_class filter must be array reference"

      unless ref $model->filter eq 'ARRAY';

    $self->apply_filter($model->table, @{$model->filter});

    # Table - Model

    croak "Table name is duplicated"

      if exists $self->{_model_from}->{$model->table};

    $self->{_model_from}->{$model->table} = $model->name;

    # Table alias

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

    $self->{_table_alias} = {%{$self->{_table_alias}}, %{$model->table_alias}};

    # Set model

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

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

}

sub each_column {

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

    # Iterate all tables

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

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

        # Table

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

        # Iterate all columns

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

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

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

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

        }

    }

}

sub execute{

    my ($self, $query, %args)  = @_;

    # Check argument names

    foreach my $name (keys %args) {

        croak qq{Argument "$name" is invalid name}

          unless $EXECUTE_ARGS{$name};

    }

    my $params = $args{param} || {};

    # First argument is the soruce of SQL

    $query = $self->create_query($query)

      unless ref $query;

    # Applied filter

    my $filter = {};

    my $tables = $query->tables;

    my $arg_tables = $args{table} || [];

    $arg_tables = [$arg_tables]

      unless ref $arg_tables eq 'ARRAY';

    push @$tables, @$arg_tables;

    # Organize tables

    my %table_set = map {defined $_ ? ($_ => 1) : ()} @$tables;

    my $main_table = pop @$tables;

    delete $table_set{$main_table} if $main_table;

    foreach my $table (keys %table_set) {

        push @$tables, $table;

        if (my $dist = $self->{_table_alias}->{$table}) {

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

            unless ($self->{filter}{out}{$table}) {

                $self->{filter}{out} ||= {};

                $self->{filter}{in}  ||= {};

                $self->{filter}{end} ||= {};

                foreach my $type (qw/out in end/) {

                    foreach my $filter_name (keys %{$self->{filter}{$type}{$dist} || {}}) {

                        my $filter_name_alias = $filter_name;

                        $filter_name_alias =~ s/^$dist\./$table\./;

                        $filter_name_alias =~ s/^${dist}__/${table}__/; 

                        $self->{filter}{$type}{$table}{$filter_name_alias}

                          = $self->{filter}{$type}{$dist}{$filter_name}

                    }

                }

            }

        }

    }

    $tables = [keys %table_set];

    push @$tables, $main_table if $main_table;

    foreach my $table (@$tables) {

        next unless $table;

        $filter = {

            %$filter,

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

        }

    }

    # Filter argument

    my $f = DBIx::Custom::Util::array_to_hash($args{filter})

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

    foreach my $column (keys %$f) {

        my $fname = $f->{$column};

        if (!defined $fname) {

            $f->{$column} = undef;

        }

        elsif (ref $fname ne 'CODE') {

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

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

          $f->{$column} = $self->filters->{$fname};

        }

    }

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

    # Type

    my $type = DBIx::Custom::Util::array_to_hash($args{type});

    # Bind

    my $bind = $self->_bind($params, $query->columns, $filter, $type);

    # Execute

    my $sth = $query->sth;

    my $affected;

    eval {

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

            if (my $type = $bind->[$i]->{type}) {

                $sth->bind_param($i + 1, $bind->[$i]->{value}, $type);

            }

            else {

                $sth->bind_param($i + 1, $bind->[$i]->{value});

            }

        }

        $affected = $sth->execute;

    };

    $self->_croak($@, qq{. Following SQL is executed. "$query->{sql}"}) if $@;

    # Return resultset if select statement is executed

    if ($sth->{NUM_OF_FIELDS}) {

        # Result in and end filter

        my $in_filter  = {};

        my $end_filter = {};

        foreach my $table (@$tables) {

            next unless $table;

            $in_filter = {

                %$in_filter,

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

            };

            $end_filter = {

                %$end_filter,

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

            };

        }

        # Result

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

            sth            => $sth,

            filters        => $self->filters,

            filter_check   => $self->filter_check,

            default_filter => $self->{default_in_filter},

            filter         => $in_filter || {},

            end_filter     => $end_filter || {}

        );

        return $result;

    }

    return $affected;

}

our %INSERT_ARGS = map { $_ => 1 } @COMMON_ARGS, qw/param append/;

sub insert {

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

    # Check argument names

    foreach my $name (keys %args) {

        croak qq{Argument "$name" is invalid name}

          unless $INSERT_ARGS{$name};

    }

    # Arguments

    my $table  = delete $args{table};

    croak qq{"table" option must be specified} unless $table;

    my $param  = delete $args{param} || {};

    my $append = delete $args{append} || '';

    # Columns

    my @columns;

    my $safety = $self->safety_character;

    foreach my $column (keys %$param) {

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

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

        push @columns, $column;

    }

    # SQL stack

    my @sql;

    # Insert

    push @sql, "insert into $table {insert_param ". join(' ', @columns) . '}';

    push @sql, $append if $append;

    # SQL

    my $sql = join (' ', @sql);

    # Create query

    my $query = $self->create_query($sql);

    return $query if $args{query};

    # Execute query

    my $ret_val = $self->execute(

        $query,

        param  => $param,

        table => $table,

        %args

    );

    return $ret_val;

}

our %INSERT_AT_ARGS = (%INSERT_ARGS, where => 1, primary_key => 1);

sub insert_at {

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

    # Check argument names

    foreach my $name (keys %args) {

        croak qq{Argument "$name" is invalid name}

          unless $INSERT_AT_ARGS{$name};

    }

    # Primary key

    my $primary_keys = delete $args{primary_key};

    $primary_keys = [$primary_keys] unless ref $primary_keys;

    # Where clause

    my $where = {};

    my $param = {};

    if (exists $args{where}) {

        my $where_columns = delete $args{where};

        $where_columns = [$where_columns] unless ref $where_columns;

        croak qq{"where" must be constant value or array reference}

          unless !ref $where_columns || ref $where_columns eq 'ARRAY';

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

           $where->{$primary_keys->[$i]} = $where_columns->[$i];

        }

    }

    if (exists $args{param}) {

        $param = delete $args{param};

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

             delete $param->{$primary_keys->[$i]};

        }

    }

    $param = {%$param, %$where};

    return $self->insert(param => $param, %args);

}

sub insert_param {

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

    # Insert parameter tag

    my @tag;

    push @tag, '{insert_param';

    my $safety = $self->safety_character;

    foreach my $column (keys %$param) {

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

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

        push @tag, $column;

    }

    push @tag, '}';

    return join ' ', @tag;

}

sub include_model {

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

    $name_space ||= '';

    unless ($model_infos) {

        # Load name space module

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

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

        eval "use $name_space";

        croak qq{Name space module "$name_space.pm" is needed. $@} 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": $!};

        $model_infos = [];

        while (my $module = readdir $dh) {

            push @$model_infos, $module

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

        }

        close $dh;

    }

    foreach my $model_info (@$model_infos) {

        # Model class, name, table

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

        # Load

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

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

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

            eval "use $mclass";

            croak $@ if $@;

        }

        # Instantiate

        my $args = {};

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

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

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

        # Create model

        $self->create_model($args);

    }

    return $self;

}

sub method {

    my $self = shift;

    # Merge

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

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

    return $self;

}

sub model {

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

    # Set

    if ($model) {

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

        return $self;

    }

    # Check model existance

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

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

    # Get

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

}

sub mycolumn {

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

    $columns ||= [];

    my @column;

    push @column, "$table.$_ as $_" for @$columns;

    return join (', ', @column);

}

sub new {

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

    # Check attribute names

    my @attrs = keys %$self;

    foreach my $attr (@attrs) {

        croak qq{"$attr" is invalid attribute name}

          unless $self->can($attr);

    }

    $self->register_tag(

        '?'     => \&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 { bless {}, 'DBIx::Custom::NotExists' }

sub register_filter {

    my $invocant = shift;

    # Register filter

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

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

    return $invocant;

}

sub register_tag { shift->query_builder->register_tag(@_) }

our %SELECT_ARGS

  = map { $_ => 1 } @COMMON_ARGS, qw/column where append relation join/;

sub select {

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

    # Check argument names

    foreach my $name (keys %args) {

        croak qq{Argument "$name" is invalid name}

          unless $SELECT_ARGS{$name};

    }

    # Arguments

    my $table = delete $args{table};

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

               : defined $table ? [$table]

               : [];

    my $columns   = delete $args{column};

    my $where     = delete $args{where} || {};

    my $append    = delete $args{append};

    my $join      = delete $args{join} || [];

    croak qq{"join" must be array reference}

      unless ref $join eq 'ARRAY';

    my $relation = delete $args{relation};

    # Add relation tables(DEPRECATED!);

    $self->_add_relation_table($tables, $relation);

    # SQL stack

    my @sql;

    push @sql, 'select';

    if ($columns) {

        $columns = [$columns] if ! ref $columns;

        if (ref $columns eq 'HASH') {

            # Find tables

            my $main_table;

            my %tables;

            if ($columns->{table}) {

                foreach my $table (@{$columns->{table}}) {

                    if (($table || '') eq $tables->[-1]) {

                        $main_table = $table;

                    }

                    else {

                        $tables{$table} = 1;

                    }

                }

            }

            elsif ($columns->{all}) {

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

                foreach my $j (@$join) {

                    my $tables = $self->_tables($j);

                    foreach my $table (@$tables) {

                        $tables{$table} = 1;

                    }

                }

                delete $tables{$main_table};

            }

            push @sql, $columns->{prepend} if $columns->{prepend};

            # Column clause of main table

            if ($main_table) {

                push @sql, $self->model($main_table)->mycolumn;

                push @sql, ',';

            }

            # Column cluase of other tables

            foreach my $table (keys %tables) {

                unshift @$tables, $table;

                push @sql, $self->model($table)->column($table);

                push @sql, ',';

            }

            pop @sql if $sql[-1] eq ',';

        }

        else {

            foreach my $column (@$columns) {

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

                push @sql, ($column, ',');

            }

            pop @sql if $sql[-1] eq ',';

        }

    }

    # "*" is default

    else { push @sql, '*' }

    # Table

    push @sql, 'from';

    if ($relation) {

        my $found = {};

        foreach my $table (@$tables) {

            push @sql, ($table, ',') unless $found->{$table};

            $found->{$table} = 1;

        }

    }

    else {

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

        push @sql, $main_table;

    }

    pop @sql if ($sql[-1] || '') eq ',';

    # Main table

    croak "Not found table name" unless $tables->[-1];

    # Where

    my $w = $self->_where($where);

    $where = $w->param;

    # String where

    my $swhere = "$w";

    # Add table names in where clause

    unshift @$tables, @{$self->_tables($swhere)};

    # Push join

    $self->_push_join(\@sql, $join, $tables);

    # Add where clause

    push @sql, $swhere;

    # Relation(DEPRECATED!);

    $self->_push_relation(\@sql, $tables, $relation, $swhere eq '' ? 1 : 0);

    # Append statement

    push @sql, $append if $append;

    # SQL

    my $sql = join (' ', @sql);

    # Create query

    my $query = $self->create_query($sql);

    return $query if $args{query};

    # Execute query

    my $result = $self->execute(

        $query,

        param  => $where, 

        table => $tables,

        %args

    );

    return $result;

}

our %SELECT_AT_ARGS = (%SELECT_ARGS, where => 1, primary_key => 1);

sub select_at {

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

    # Check argument names

    foreach my $name (keys %args) {

        croak qq{Argument "$name" is invalid name}

          unless $SELECT_AT_ARGS{$name};

    }

    # Primary key

    my $primary_keys = delete $args{primary_key};

    $primary_keys = [$primary_keys] unless ref $primary_keys;

    # Table

    croak qq{"table" option must be specified} unless $args{table};

    my $table = ref $args{table} ? $args{table}->[-1] : $args{table};

    # Where clause

    my $where = {};

    if (exists $args{where}) {

        my $where_columns = delete $args{where};

        croak qq{"where" must be constant value or array reference}

          unless !ref $where_columns || ref $where_columns eq 'ARRAY';

        $where_columns = [$where_columns] unless ref $where_columns;

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

           $where->{$table . '.' . $primary_keys->[$i]} = $where_columns->[$i];

        }

    }

    if (exists $args{param}) {

        my $param = delete $args{param};

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

             delete $param->{$primary_keys->[$i]};

        }

    }

    return $self->select(where => $where, %args);

}

sub setup_model {

    my $self = shift;

    $self->each_column(

        sub {

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

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

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

            }

        }

    );

    return $self;

}

our %UPDATE_ARGS

  = map { $_ => 1 } @COMMON_ARGS, qw/param where append allow_update_all/;

sub update {

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

    # Check argument names

    foreach my $name (keys %args) {

        croak qq{Argument "$name" is invalid name}

          unless $UPDATE_ARGS{$name};

    }

    # Arguments

    my $table = delete $args{table} || '';

    croak qq{"table" option must be specified} unless $table;

    my $param            = delete $args{param} || {};

    my $where            = delete $args{where} || {};

    my $append           = delete $args{append} || '';

    my $allow_update_all = delete $args{allow_update_all};

    # Update keys

    my @clumns = keys %$param;

    # Columns

    my @columns;

    my $safety = $self->safety_character;

    foreach my $column (keys %$param) {

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

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

        push @columns, $column;

    }

    # Update clause

    my $update_clause = '{update_param ' . join(' ', @clumns) . '}';

    # Where

    my $w = $self->_where($where);

    $where = $w->param;

    # String where

    my $swhere = "$w";

    croak qq{"where" must be specified}

      if "$swhere" eq '' && !$allow_update_all;

    # SQL stack

    my @sql;

    # Update

    push @sql, "update $table $update_clause $swhere";

    push @sql, $append if $append;

    # Rearrange parameters

    foreach my $wkey (keys %$where) {

        if (exists $param->{$wkey}) {

            $param->{$wkey} = [$param->{$wkey}]

              unless ref $param->{$wkey} eq 'ARRAY';

            push @{$param->{$wkey}}, $where->{$wkey};

        }

        else {

            $param->{$wkey} = $where->{$wkey};

        }

    }

    # SQL

    my $sql = join(' ', @sql);

    # Create query

    my $query = $self->create_query($sql);

    return $query if $args{query};

    # Execute query

    my $ret_val = $self->execute(

        $query,

        param  => $param, 

        table => $table,

        %args

    );

    return $ret_val;

}

sub update_all { shift->update(allow_update_all => 1, @_) };

our %UPDATE_AT_ARGS = (%UPDATE_ARGS, where => 1, primary_key => 1);

sub update_at {

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