package DBIx::Custom;

our $VERSION = '0.1655';

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

__PACKAGE__->attr(

    [qw/data_source dbh password user/],

    cache => 1,

    dbi_option => sub { {} },

    default_dbi_option => sub {{

        RaiseError => 1,

        PrintError => 0,

        AutoCommit => 1

    }},

    models => sub { {} },

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

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

    safety_column_name => sub { qr/^[\w\.]*$/ },

    stash => sub { {} }

);

__PACKAGE__->attr(

    cache_method => sub {

        sub {

            my $self = shift;

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

            if (@_ > 1) {

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

            }

            else {

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

            }

        }

    }

);

__PACKAGE__->attr(

    filters => sub {

        {

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

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

        }

    }

);

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 ($self->dbh->can($mname)) {

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

    }

    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 method {

    my $self = shift;

    # Merge

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

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

    return $self;

}

sub connect {

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

    # Attributes

    my $data_source = $self->data_source;

    croak qq{"data_source" must be specified to connect()"}

      unless $data_source;

    my $user        = $self->user;

    my $password    = $self->password;

    my $dbi_option = {%{$self->dbi_options}, %{$self->dbi_option}};

    # Connect

    my $dbh = eval {DBI->connect(

        $data_source,

        $user,

        $password,

        {

            %{$self->default_dbi_option},

            %$dbi_option

        }

    )};

    # Connect error

    croak $@ if $@;

    # Database handle

    $self->dbh($dbh);

    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;

}

our %VALID_DELETE_ARGS

  = map { $_ => 1 } qw/table where append filter allow_delete_all query/;

sub delete {

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

    # Check arguments

    foreach my $name (keys %args) {

        croak qq{"$name" is invalid argument}

          unless $VALID_DELETE_ARGS{$name};

    }

    # Arguments

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

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

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

    my $append           = $args{append};

    my $filter           = $args{filter};

    my $allow_delete_all = $args{allow_delete_all};

    # Where

    my $w;

    if (ref $where eq 'HASH') {

        my $clause = ['and'];

        push @$clause, "{= $_}" for keys %$where;

        $w = $self->where;

        $w->clause($clause);

        $w->param($where);

    }

    elsif (ref $where eq 'DBIx::Custom::Where') {

        $w = $where;

        $where = $w->param;

    }    

    croak qq{"where" must be hash refernce or DBIx::Custom::Where object}

      unless ref $w eq 'DBIx::Custom::Where';

    # 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, filter => $filter,

        table => $table);

    return $ret_val;

}

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

our %VALID_DELETE_AT_ARGS

  = map { $_ => 1 } qw/table where append filter query

                       primary_key param/;

sub delete_at {

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

    # Check arguments

    foreach my $name (keys %args) {

        croak qq{"$name" is invalid argument}

          unless $VALID_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 %VALID_EXECUTE_ARGS = map { $_ => 1 } qw/param filter table/;

sub execute{

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

    # Check arguments

    foreach my $name (keys %args) {

        croak qq{"$name" is invalid argument}

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

    foreach my $table (@$tables) {

        next unless $table;

        $filter = {

            %$filter,

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

        }

    }

    # Filter argument

    my $f = DBIx::Custom::Util::array_filter_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};

    # Bind

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

    # Execute

    my $sth = $query->sth;

    my $affected;

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

    $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 %VALID_INSERT_ARGS = map { $_ => 1 } qw/table param append

                                            filter query/;

sub insert {

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

    # Check arguments

    foreach my $name (keys %args) {

        croak qq{"$name" is invalid argument}

          unless $VALID_INSERT_ARGS{$name};

    }

    # Arguments

    my $table  = $args{table};

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

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

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

    my $filter = $args{filter};

    # Columns

    my @columns;

    my $safety = $self->safety_column_name;

    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,

        filter => $filter,

        table => $table

    );

    return $ret_val;

}

our %VALID_INSERT_AT_ARGS

  = map { $_ => 1 } qw/table param

                       where append filter query

                       primary_key param/;

sub insert_at {

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

    # Check arguments

    foreach my $name (keys %args) {

        croak qq{"$name" is invalid argument}

          unless $VALID_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 paramter tag

    my @tag;

    push @tag, '{insert_param';

    my $safety = $self->safety_column_name;

    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 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 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 %VALID_SELECT_ARGS

  = map { $_ => 1 } qw/table column where append relation filter query selection left_join/;

sub select {

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

    # Check arguments

    foreach my $name (keys %args) {

        croak qq{"$name" is invalid argument}

          unless $VALID_SELECT_ARGS{$name};

    }

    # Arguments

    my $table = $args{table};

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

               : defined $table ? [$table]

               : [];

    my $columns   = $args{column} || [];

    $columns = [$columns] unless ref $columns;

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

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

    my $relation  = $args{relation} || {};

    my $append    = $args{append};

    my $filter    = $args{filter};

    my $left_join = $args{left_join} || [];

    my @left_join_tables;

    unshift @left_join_tables, $tables->[-1];

    # Relation

    if (!$selection && keys %$relation) {

        foreach my $rcolumn (keys %$relation) {

            my $table1 = (split (/\./, $rcolumn))[0];

            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];

            my $table1_exists;

            my $table2_exists;

            foreach my $table (@$tables) {

                $table1_exists = 1 if $table eq $table1;

                $table2_exists = 1 if $table eq $table2;

            }

            unshift @$tables, $table1 unless $table1_exists;

            unshift @$tables, $table2 unless $table2_exists;

        }

    }

    # SQL stack

    my @sql;

    push @sql, 'select';

    if ($selection) {

        push @sql, $selection;

        push @left_join_tables, @{$self->_tables($selection)};

    }

    else {

        # Column clause

        if (@$columns) {

            foreach my $column (@$columns) {

                push @left_join_tables, @{$self->_tables($column)};

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

            }

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

        }

        else { push @sql, '*' }

        # Table

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

        push @sql, 'from';

        foreach my $table (@$tables) {

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

        }

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

    }

    # Where

    my $w;

    if (ref $where eq 'HASH') {

        my $clause = ['and'];

        push @$clause, "{= $_}" for keys %$where;

        $w = $self->where;

        $w->clause($clause);

        $w->param($where);

    }

    elsif (ref $where eq 'DBIx::Custom::Where') {

        $w = $where;

        $where = $w->param;

    }

    croak qq{"where" must be hash reference or DBIx::Custom::Where object}

      unless ref $w eq 'DBIx::Custom::Where';

    # String where

    my $swhere = "$w";

    # Table name in Where

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

    # Left join

    if (@$left_join) {

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

            my $column1 = $left_join->[$i];

            my $column2 = $left_join->[$i + 1];

            my $table1 = (split (/\./, $column1))[0];

            my $table2 = (split (/\./, $column2))[0];

            my $table1_exists;

            my $table2_exists;

            foreach my $table (@left_join_tables) {

                $table1_exists = 1 if $table eq $table1;

                $table2_exists = 1 if $table eq $table2;

            }

            if ($table1_exists && $table2_exists) {

                push @sql, "left outer join $table2 on $column1 = $column2";

            }

        }

    }

    # Add where

    push @sql, $swhere;

    # Relation

    if (!$selection && keys %$relation) {

        push @sql, $swhere eq '' ? 'where' : 'and';

        foreach my $rcolumn (keys %$relation) {

            my $table1 = (split (/\./, $rcolumn))[0];

            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];

            push @$tables, ($table1, $table2);

            push @sql, ("$rcolumn = " . $relation->{$rcolumn},  'and');

        }

    }

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

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

    unshift @$tables, @left_join_tables;

    # Execute query

    my $result = $self->execute(

        $query, param  => $where, filter => $filter,

        table => $tables);

    return $result;

}

our %VALID_SELECT_AT_ARGS

  = map { $_ => 1 } qw/table column where append relation filter query selection

                       param primary_key left_join/;

sub select_at {

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

    # Check arguments

    foreach my $name (keys %args) {

        croak qq{"$name" is invalid argument}

          unless $VALID_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 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 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 $model = $mclass->new(dbi => $self);

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

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

        # Set

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

        # Apply filter

        croak "${name_space}::$model_class filter must be array reference"

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

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

    }

    return $self;

}

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 %VALID_UPDATE_ARGS

  = map { $_ => 1 } qw/table param

                       where append filter allow_update_all query/;

sub update {

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

    # Check arguments

    foreach my $name (keys %args) {

        croak qq{"$name" is invalid argument}

          unless $VALID_UPDATE_ARGS{$name};

    }

    # Arguments

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

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

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

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

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

    my $filter           = $args{filter};

    my $allow_update_all = $args{allow_update_all};

    # Update keys

    my @clumns = keys %$param;

    # Columns

    my @columns;

    my $safety = $self->safety_column_name;

    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;

    if (ref $where eq 'HASH') {

        my $clause = ['and'];

        push @$clause, "{= $_}" for keys %$where;

        $w = $self->where;

        $w->clause($clause);

        $w->param($where);

    }

    elsif (ref $where eq 'DBIx::Custom::Where') {

        $w = $where;

        $where = $w->param;

    }  

    croak qq{"where" must be hash refernce or DBIx::Custom::Where object}

      unless ref $w eq 'DBIx::Custom::Where';

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

                                 filter => $filter,

                                 table => $table);

    return $ret_val;

}

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

our %VALID_UPDATE_AT_ARGS

  = map { $_ => 1 } qw/table param

                       where append filter query

                       primary_key param/;

sub update_at {

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

    # Check arguments

    foreach my $name (keys %args) {

        croak qq{"$name" is invalid argument}

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

        }

    }

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

}

sub update_param {

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

    # Update parameter tag

    my @tag;

    push @tag, '{update_param';

    my $safety = $self->safety_column_name;

    foreach my $column (keys %$param) {

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

          unless $column =~ /$safety/;

        push @tag, $column;

    }

    push @tag, '}';