package DBIx::Custom;

our $VERSION = '0.1660';

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 password pid user/],

    cache => 1,

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

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

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

sub delete {

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

    # Check argument names

    foreach my $name (keys %args) {

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

          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 argument names

    foreach my $name (keys %args) {

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

          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 argument names

    foreach my $name (keys %args) {

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

          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;

    # Organize tables

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

    my $main_table = pop @$tables;

    delete $table_set{$main_table} if $main_table;

    $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_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 argument names

    foreach my $name (keys %args) {

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

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

        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 argument names

    foreach my $name (keys %args) {

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

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

sub select {

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

    # Check argument names

    foreach my $name (keys %args) {

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

          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 eq 'ARRAY';

    my $all_column = $args{all_column};

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

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

    my $append    = $args{append};

    my $filter    = $args{filter};

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

    croak qq{"join" must be array reference}

      unless ref $join eq 'ARRAY';

    # Add relation tables(DEPRECATED!);

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

    # SQL stack

    my @sql;

    push @sql, 'select';

    # Selection

    if ($selection) { 

        push @sql, $selection;

        if ($selection =~ /from\s+(?:\{table\s+)?([^\s\{]+?)\b/) {

             unshift @$tables, $1;

        }

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

    }

    # Clumn clause, countains all columns of joined tables

    elsif ($all_column) {

        # Find tables

        my $main_table;

        my %tables;

        if (ref $all_column eq 'ARRAY') {

            foreach my $table (@$all_column) {

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

                    $main_table = $table;

                }

                else {

                    $tables{$table} = 1;

                }

            }

        }

        else {

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

            foreach my $j (@$join) {

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

                foreach my $table (@$tables) {

                    $tables{$table} = 1;

                }

            }

            delete $tables{$main_table};

        }

        # Column clause of main table

        if ($main_table) {

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

            push @sql, ',';

        }

        # Column cluase of other tables

        foreach my $table (keys %tables) {

            unshift @$tables, $table;

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

                            ->column_clause(prefix => "${table}__");

            push @sql, ',';

        }

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

    }

    # Column clause

    elsif (@$columns) {

        foreach my $column (@$columns) {

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

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

        }

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

    }

    # "*" is default

    else { push @sql, '*' }

    # Table

    unless ($selection) {

        push @sql, 'from';

        if ($args{relation}) {

            my $found = {};

            foreach my $table (@$tables) {

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

                $found->{$table} = 1;

            }

        }

        else {

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

            push @sql, $self->view($main_table)

                     ? $self->view($main_table)

                     : $main_table;

        }

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

    }

    # Main table

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

    # Where

    my $w;

    if (ref $where eq 'HASH') {

        my $clause = ['and'];

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

        $w = $self->where(clause => $clause, 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";

    # 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, $args{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, 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 join all_column/;

sub select_at {

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

    # Check argument names

    foreach my $name (keys %args) {

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

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

        # View

        $self->view($model->table, $model->view) if $model->view;

        # 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 argument names

    foreach my $name (keys %args) {

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

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

    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) = @_;