package DBIx::Custom;

our $VERSION = '0.1675';

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

use constant DEBUG => $ENV{DBIX_CUSTOM_DEBUG} || 0;

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

__PACKAGE__->attr(

    [qw/connector 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',

    reserved_word_quote => '',

    safety_character => '\w',

    stash => sub { {} }

);

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

    }

}

sub apply_filter {

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

    # Initialize filters

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

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

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

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

    # Usage

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

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

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

    # Apply filter

    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 infomation

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

        }

        # Set filters

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

            # Filter

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

            # Filter state

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

                      : !defined $filter        ? 'not_defined'

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

                      : 'name';

            # Filter is not exists

            next if $state eq 'not_exists';

            # Check filter name

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

              if  $state eq 'name'

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

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

    # Reserved word quote

    my $q = $self->reserved_word_quote;

    # Column clause

    my @column;

    $columns ||= [];

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

    return join (', ', @column);

}

sub connect {

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

    # Connect

    $self->dbh;

    # Set process ID

    $self->pid($$);

    return $self;

}

sub create_query {

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

    # Cache

    my $cache = $self->cache;

    # Query

    my $query;

    # Get cached 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);

        }

    }

    # Create query

    unless ($query) {

        # Create query

        my $builder = $self->query_builder;

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

        # Remove reserved word quote

        if (my $q = $self->reserved_word_quote) {

            $_ =~ s/$q//g for @{$query->columns}

        }

        # Save query to cache

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

    # Set

    if (@_) {

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

        return $self;

    }

    # Get

    else {

        # From Connction manager

        if (my $connector = $self->connector) {

            croak "connector must have dbh() method"

              unless ref $connector && $connector->can('dbh');

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

        }

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

    }

}

our %DELETE_ARGS

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

sub delete {

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

    # Check arguments

    foreach my $name (keys %args) {

        croak qq{Argument "$name" is wrong 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};

    my $query_return     = delete $args{query};

    # Where

    $where = $self->_where_to_obj($where);

    # Where clause

    my $where_clause = $where->to_string;

    croak qq{"where" must be specified}

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

    # Delete statement

    my @sql;

    my $q = $self->reserved_word_quote;

    push @sql, "delete from $q$table$q $where_clause";

    push @sql, $append if $append;

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

    # Create query

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

    return $query if $query_return;

    # Execute query

    return $self->execute(

        $query,

        param => $where->param,

        table => $table,

        %args

    );

}

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

    # Arguments

    my $primary_keys = delete $args{primary_key};

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

    my $where = delete $args{where};

    # Check arguments

    foreach my $name (keys %args) {

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

          unless $DELETE_AT_ARGS{$name};

    }

    # Create where parameter

    my $where_param = $self->_create_where_param($where, $primary_keys);

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

}

sub DESTROY { }

sub create_model {

    my $self = shift;

    # Arguments

    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;

    # Create model

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

    # Associate table with 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);

        }

    }

}

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

sub execute {

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

    # Arguments

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

    my $tables = delete $args{table} || [];

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

    my $filter = delete $args{filter};

    $filter = DBIx::Custom::Util::array_to_hash($filter);

    my $type = delete $args{type};

    $type = DBIx::Custom::Util::array_to_hash($type);

    # Check argument names

    foreach my $name (keys %args) {

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

          unless $EXECUTE_ARGS{$name};

    }

    # Create query

    $query = $self->create_query($query) unless ref $query;

    $filter ||= $query->filter;

    # Tables

    unshift @$tables, @{$query->tables};

    my $main_table = pop @$tables;

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

    if (my $q = $self->reserved_word_quote) {

        $_ =~ s/$q//g for @$tables;

    }

    # Table alias

    foreach my $table (@$tables) {

        # No need

        next unless my $alias = $self->{_table_alias}->{$table};

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

        next if $self->{filter}{out}{$table};

        # Filter

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

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

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

        # Create alias filter

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

            my @filter_names = keys %{$self->{filter}{$type}{$alias} || {}};

            foreach my $filter_name (@filter_names) {

                my $filter_name_alias = $filter_name;

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

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

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

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

            }

        }

    }

    # Applied filter

    my $applied_filter = {};

    foreach my $table (@$tables) {

        $applied_filter = {

            %$applied_filter,

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

        }

    }

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

    # Replace filter name to code

    foreach 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"}

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

          $filter->{$column} = $self->filters->{$name};

        }

    }

    # Create bind values

    my $bind = $self->_create_bind_values(

        $param,

        $query->columns,

        $filter,

        $type

    );

    # Execute

    my $sth = $query->sth;

    my $affected;

    eval {

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

            my $type = $bind->[$i]->{type};

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

        }

        $affected = $sth->execute;

    };

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

    # Output SQL for debug

    warn $query->sql . "\n" if DEBUG;

    # Select statement

    if ($sth->{NUM_OF_FIELDS}) {

        # Filter

        my $filter = {};

        $filter->{in}  = {};

        $filter->{end} = {};

        foreach my $table (@$tables) {

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

                $filter->{$way} = {

                    %{$filter->{$way}},

                    %{$self->{filter}{$way}{$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         => $filter->{in} || {},

            end_filter     => $filter->{end} || {}

        );

        return $result;

    }

    # Not select statement

    else { return $affected }

}

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

sub insert {

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

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

    my $query_return  = delete $args{query};

    # Check arguments

    foreach my $name (keys %args) {

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

          unless $INSERT_ARGS{$name};

    }

    # Reserved word quote

    my $q = $self->reserved_word_quote;

    # Columns

    my @columns;

    my $safety = $self->safety_character;

    foreach my $column (keys %$param) {

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

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

          $column = "$q$column$q";

          $column =~ s/\./$q.$q/;

        push @columns, $column;

    }

    # Insert statement

    my @sql;

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

    push @sql, $append if $append;

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

    # Create query

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

    return $query if $query_return;

    # Execute query

    return $self->execute(

        $query,

        param => $param,

        table => $table,

        %args

    );

}

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

sub insert_at {

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

    # Arguments

    my $primary_keys = delete $args{primary_key};

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

    my $where = delete $args{where};

    my $param = delete $args{param};

    # Check arguments

    foreach my $name (keys %args) {

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

          unless $INSERT_AT_ARGS{$name};

    }

    # Create where parameter

    my $where_param = $self->_create_where_param($where, $primary_keys);

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

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

}

sub insert_param_tag {

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

    # Create insert parameter tag

    my $safety = $self->safety_character;

    my $q = $self->reserved_word_quote;

    my @columns;

    my @placeholders;

    foreach my $column (keys %$param) {

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

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

        $column = "$q$column$q";

        $column =~ s/\./$q.$q/;

        push @columns, $column;

        push @placeholders, "{? $column}";

    }

    return '(' . join(', ', @columns) . ') ' . 'values ' .

           '(' . join(', ', @placeholders) . ')'

}

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}

          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;

    }

    # Include models

    foreach my $model_info (@$model_infos) {

        # Load model

        my $model_class;

        my $model_name;

        my $model_table;

        if (ref $model_info eq 'HASH') {

            $model_class = $model_info->{class};

            $model_name  = $model_info->{name};

            $model_table = $model_info->{table};

            $model_name  ||= $model_class;

            $model_table ||= $model_name;

        }

        else { $model_class = $model_name = $model_table = $model_info }

        my $mclass = "${name_space}::$model_class";

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

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

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

            eval "use $mclass";

            croak $@ if $@;

        }

        # Create model

        my $args = {};

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

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

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

        $self->create_model($args);

    }

    return $self;

}

sub merge_param {

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

    # Merge parameters

    my $param = {};

    foreach my $p (@params) {

        foreach my $column (keys %$p) {

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

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

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

                push @{$param->{$column}}, $p->{$column};

            }

            else {

                $param->{$column} = $p->{$column};

            }

        }

    }

    return $param;

}

sub method {

    my $self = shift;

    # Register method

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

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

    return $self;

}

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}

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

    # Get model

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

}

sub mycolumn {

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

    # Create column clause

    my @column;

    my $q = $self->reserved_word_quote;

    $columns ||= [];

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

    return join (', ', @column);

}

sub new {

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

    # Check attributes

    my @attrs = keys %$self;

    foreach my $attr (@attrs) {

        croak qq{"$attr" is wrong name}

          unless $self->can($attr);

    }

    # Register tag

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

    # Register filter

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

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

    return $self;

}

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

our %SELECT_ARGS

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

sub select {

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

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

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

    my $query_return = $args{query};

    # Check arguments

    foreach my $name (keys %args) {

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

          unless $SELECT_ARGS{$name};

    }

    # Add relation tables(DEPRECATED!);

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

    # Select statement

    my @sql;

    push @sql, 'select';

    # Column clause

    if ($columns) {

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

        foreach my $column (@$columns) {

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

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

        }

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

    }

    else { push @sql, '*' }

    # Table

    push @sql, 'from';

    my $q = $self->reserved_word_quote;

    if ($relation) {

        my $found = {};

        foreach my $table (@$tables) {

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

            $found->{$table} = 1;

        }

    }

    else {

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

        push @sql, "$q$main_table$q";

    }

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

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

    # Add tables in parameter

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

    # Where

    $where = $self->_where_to_obj($where);

    $param = keys %$param ? $self->merge_param($param, $where->param)

                          : $where->param;

    # String where

    my $where_clause = $where->to_string;

    # Add table names in where clause

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

    # Push join

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

    # Add where clause

    push @sql, $where_clause;

    # Relation(DEPRECATED!);

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

    # Append

    push @sql, $append if $append;

    # SQL

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

    # Create query

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

    return $query if $query_return;

    # Execute query

    my $result = $self->execute(

        $query,

        param => $param, 

        table => $tables,

        %args

    );

    return $result;

}

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

sub select_at {

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

    # Arguments

    my $primary_keys = delete $args{primary_key};

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

    my $where = delete $args{where};

    my $param = delete $args{param};

    # Check arguments

    foreach my $name (keys %args) {

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

          unless $SELECT_AT_ARGS{$name};

    }

    # Table

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

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

    # Create where parameter

    my $where_param = $self->_create_where_param($where, $primary_keys);

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

}

sub setup_model {

    my $self = shift;

    # Setup model

    $self->each_column(

        sub {

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

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

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

            }

        }

    );

    return $self;

}

our %UPDATE_ARGS

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

sub update {

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

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

    # Check argument names

    foreach my $name (keys %args) {

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

          unless $UPDATE_ARGS{$name};

    }

    # Columns

    my @columns;

    my $safety = $self->safety_character;

    my $q = $self->reserved_word_quote;

    foreach my $column (keys %$param) {

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

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

          $column = "$q$column$q";

          $column =~ s/\./$q.$q/;

        push @columns, "$column";

    }

    # Update clause

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

    # Where

    $where = $self->_where_to_obj($where);

    my $where_clause = $where->to_string;

    croak qq{"where" must be specified}

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

    # Update statement

    my @sql;

    push @sql, "update $q$table$q $update_clause $where_clause";

    push @sql, $append if $append;

    # Merge parameters

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

    # SQL

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

    # Create query

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

    return $query if $args{query};