Newer Older
3203 lines | 83.27kb
added common test executing ...
Yuki Kimoto authored on 2011-08-07
1
package DBIx::Custom;
2
use Object::Simple -base;
3

            
4
our $VERSION = '0.1711';
5
use 5.008001;
6

            
7
use Carp 'croak';
8
use DBI;
9
use DBIx::Custom::Result;
10
use DBIx::Custom::Query;
11
use DBIx::Custom::QueryBuilder;
12
use DBIx::Custom::Where;
13
use DBIx::Custom::Model;
14
use DBIx::Custom::Tag;
15
use DBIx::Custom::Order;
16
use DBIx::Custom::Util qw/_array_to_hash _subname/;
17
use Encode qw/encode encode_utf8 decode_utf8/;
18

            
19
use constant DEBUG => $ENV{DBIX_CUSTOM_DEBUG} || 0;
20
use constant DEBUG_ENCODING => $ENV{DBIX_CUSTOM_DEBUG_ENCODING} || 'UTF-8';
21

            
22
has [qw/connector dsn password quote user/],
23
    cache => 0,
24
    cache_method => sub {
25
        sub {
26
            my $self = shift;
27
            
28
            $self->{_cached} ||= {};
29
            
30
            if (@_ > 1) {
31
                $self->{_cached}{$_[0]} = $_[1];
32
            }
33
            else {
34
                return $self->{_cached}{$_[0]};
35
            }
36
        }
37
    },
38
    dbi_option => sub { {} },
39
    default_dbi_option => sub {
40
        {
41
            RaiseError => 1,
42
            PrintError => 0,
43
            AutoCommit => 1
44
        }
45
    },
46
    filters => sub {
47
        {
48
            encode_utf8 => sub { encode_utf8($_[0]) },
49
            decode_utf8 => sub { decode_utf8($_[0]) }
50
        }
51
    },
52
    last_sql => '',
53
    models => sub { {} },
54
    query_builder => sub { DBIx::Custom::QueryBuilder->new(dbi => shift) },
55
    result_class  => 'DBIx::Custom::Result',
56
    safety_character => '\w',
57
    stash => sub { {} },
58
    tag_parse => 1;
59

            
60
our $AUTOLOAD;
61
sub AUTOLOAD {
62
    my $self = shift;
63

            
64
    # Method name
65
    my ($package, $mname) = $AUTOLOAD =~ /^([\w\:]+)\:\:(\w+)$/;
66

            
67
    # Call method
68
    $self->{_methods} ||= {};
69
    if (my $method = $self->{_methods}->{$mname}) {
70
        return $self->$method(@_)
71
    }
72
    elsif ($self->{dbh} && (my $dbh_method = $self->dbh->can($mname))) {
73
        $self->dbh->$dbh_method(@_);
74
    }
75
    else {
76
        croak qq{Can't locate object method "$mname" via "$package" }
77
            . _subname;
78
    }
79
}
80

            
81
sub assign_param {
82
    my ($self, $param) = @_;
83
    
84
    # Create set tag
85
    my @params;
86
    my $safety = $self->safety_character;
87
    foreach my $column (sort keys %$param) {
88
        croak qq{"$column" is not safety column name } . _subname
89
          unless $column =~ /^[$safety\.]+$/;
90
        my $column_quote = $self->_q($column);
91
        $column_quote =~ s/\./$self->_q(".")/e;
92
        push @params, ref $param->{$column} eq 'SCALAR'
93
          ? "$column_quote = " . ${$param->{$column}}
94
          : "$column_quote = :$column";
95

            
96
    }
97
    my $tag = join(', ', @params);
98
    
99
    return $tag;
100
}
101

            
102
sub column {
103
    my $self = shift;
104
    my $option = pop if ref $_[-1] eq 'HASH';
105
    my $real_table = shift;
106
    my $columns = shift;
107
    my $table = $option->{alias} || $real_table;
108
    
109
    # Columns
110
    unless ($columns) {
111
        $columns ||= $self->model($real_table)->columns;
112
    }
113
    
114
    # Separator
115
    my $separator = $self->separator;
116
    
117
    # Column clause
118
    my @column;
119
    $columns ||= [];
120
    push @column, $self->_q($table) . "." . $self->_q($_) .
121
      " as " . $self->_q("${table}${separator}$_")
122
      for @$columns;
123
    
124
    return join (', ', @column);
125
}
126

            
127
sub connect {
128
    my $self = ref $_[0] ? shift : shift->new(@_);;
129
    
130
    # Connect
131
    $self->dbh;
132
    
133
    return $self;
134
}
135

            
136
sub dbh {
137
    my $self = shift;
138
    
139
    # Set
140
    if (@_) {
141
        $self->{dbh} = $_[0];
142
        
143
        return $self;
144
    }
145
    
146
    # Get
147
    else {
148
        # From Connction manager
149
        if (my $connector = $self->connector) {
150
            croak "connector must have dbh() method " . _subname
151
              unless ref $connector && $connector->can('dbh');
152
              
153
            $self->{dbh} = $connector->dbh;
154
        }
155
        
156
        # Connect
157
        $self->{dbh} ||= $self->_connect;
158
        
159
        # Quote
160
        if (!defined $self->reserved_word_quote && !defined $self->quote) {
161
            my $driver = $self->{dbh}->{Driver}->{Name};
162
            my $quote = $driver eq 'mysql' ? '`' : '"';
163
            $self->quote($quote);
164
        }
165
        
166
        return $self->{dbh};
167
    }
168
}
169

            
170
sub delete {
171
    my ($self, %args) = @_;
172

            
173
    # Arguments
174
    my $table = $args{table} || '';
175
    croak qq{"table" option must be specified. } . _subname
176
      unless $table;
177
    my $where            = delete $args{where} || {};
178
    my $append           = delete $args{append};
179
    my $allow_delete_all = delete $args{allow_delete_all};
180
    my $where_param      = delete $args{where_param} || {};
181
    my $id = delete $args{id};
182
    my $primary_key = delete $args{primary_key};
183
    croak "update method primary_key option " .
184
          "must be specified when id is specified " . _subname
185
      if defined $id && !defined $primary_key;
186
    $primary_key = [$primary_key] unless ref $primary_key eq 'ARRAY';
187
    my $prefix = delete $args{prefix};
188
    
189
    # Where
190
    $where = $self->_create_param_from_id($id, $primary_key) if defined $id;
191
    my $where_clause = '';
192
    if (ref $where eq 'ARRAY' && !ref $where->[0]) {
193
        $where_clause = "where " . $where->[0];
194
        $where_param = $where->[1];
195
    }
196
    elsif (ref $where) {
197
        $where = $self->_where_to_obj($where);
198
        $where_param = keys %$where_param
199
                     ? $self->merge_param($where_param, $where->param)
200
                     : $where->param;
201
        
202
        # String where
203
        $where_clause = $where->to_string;
204
    }
205
    elsif ($where) { $where_clause = "where $where" }
206
    croak qq{"where" must be specified } . _subname
207
      if $where_clause eq '' && !$allow_delete_all;
208

            
209
    # Delete statement
210
    my @sql;
211
    push @sql, "delete";
212
    push @sql, $prefix if defined $prefix;
213
    push @sql, "from " . $self->_q($table) . " $where_clause";
214
    push @sql, $append if defined $append;
215
    my $sql = join(' ', @sql);
216
    
217
    # Execute query
218
    return $self->execute($sql, $where_param, table => $table, %args);
219
}
220

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

            
223
sub DESTROY { }
224

            
225
sub create_model {
226
    my $self = shift;
227
    
228
    # Arguments
229
    my $args = ref $_[0] eq 'HASH' ? $_[0] : {@_};
230
    $args->{dbi} = $self;
231
    my $model_class = delete $args->{model_class} || 'DBIx::Custom::Model';
232
    my $model_name  = delete $args->{name};
233
    my $model_table = delete $args->{table};
234
    $model_name ||= $model_table;
235
    
236
    # Create model
237
    my $model = $model_class->new($args);
238
    $model->name($model_name) unless $model->name;
239
    $model->table($model_table) unless $model->table;
240
    
241
    # Apply filter(DEPRECATED logic)
242
    if ($model->{filter}) {
243
        my $filter = ref $model->filter eq 'HASH'
244
                   ? [%{$model->filter}]
245
                   : $model->filter;
246
        $filter ||= [];
247
        warn "DBIx::Custom::Model filter method is DEPRECATED!"
248
          if @$filter;
249
        $self->_apply_filter($model->table, @$filter);
250
    }
251
    
252
    # Set model
253
    $self->model($model->name, $model);
254
    
255
    return $self->model($model->name);
256
}
257

            
258
sub each_column {
259
    my ($self, $cb) = @_;
260
    
261
    # Iterate all tables
262
    my $sth_tables = $self->dbh->table_info;
263
    while (my $table_info = $sth_tables->fetchrow_hashref) {
264
        
265
        # Table
266
        my $table = $table_info->{TABLE_NAME};
267
        
268
        # Iterate all columns
269
        my $sth_columns = $self->dbh->column_info(undef, undef, $table, '%');
270
        while (my $column_info = $sth_columns->fetchrow_hashref) {
271
            my $column = $column_info->{COLUMN_NAME};
272
            $self->$cb($table, $column, $column_info);
273
        }
274
    }
275
}
276

            
277
sub each_table {
278
    my ($self, $cb) = @_;
279
    
280
    # Iterate all tables
281
    my $sth_tables = $self->dbh->table_info;
282
    while (my $table_info = $sth_tables->fetchrow_hashref) {
283
        
284
        # Table
285
        my $table = $table_info->{TABLE_NAME};
286
        $self->$cb($table, $table_info);
287
    }
288
}
289

            
290
our %VALID_ARGS = map { $_ => 1 } qw/append allow_delete_all
291
  allow_update_all bind_type column filter id join param prefix primary_key
292
  query relation table table_alias type type_rule_off type_rule1_off
293
  type_rule2_off wrap/;
294

            
295
sub execute {
296
    my $self = shift;
297
    my $query = shift;
298
    my $param;
299
    $param = shift if @_ % 2;
300
    my %args = @_;
301
    
302
    # Arguments
303
    my $p = delete $args{param} || {};
304
    $param ||= $p;
305
    my $tables = delete $args{table} || [];
306
    $tables = [$tables] unless ref $tables eq 'ARRAY';
307
    my $filter = delete $args{filter};
308
    $filter = _array_to_hash($filter);
309
    my $bind_type = delete $args{bind_type} || delete $args{type};
310
    $bind_type = _array_to_hash($bind_type);
311
    my $type_rule_off = delete $args{type_rule_off};
312
    my $type_rule_off_parts = {
313
        1 => delete $args{type_rule1_off},
314
        2 => delete $args{type_rule2_off}
315
    };
316
    my $query_return = delete $args{query};
317
    my $table_alias = delete $args{table_alias} || {};
318
    
319
    # Check argument names
320
    foreach my $name (keys %args) {
321
        croak qq{"$name" is wrong option } . _subname
322
          unless $VALID_ARGS{$name};
323
    }
324
    
325
    # Create query
326
    $query = $self->_create_query($query) unless ref $query;
327
    
328
    # Save query
329
    $self->last_sql($query->sql);
330

            
331
    return $query if $query_return;
332
    
333
    # DEPRECATED! Merge query filter
334
    $filter ||= $query->{filter} || {};
335
    
336
    # Tables
337
    unshift @$tables, @{$query->{tables} || []};
338
    my $main_table = @{$tables}[-1];
339
    
340
    # DEPRECATED! Cleanup tables
341
    $tables = $self->_remove_duplicate_table($tables, $main_table)
342
      if @$tables > 1;
343
    
344
    # Type rule
345
    my $type_filters = {};
346
    unless ($type_rule_off) {
347
        foreach my $i (1, 2) {
348
            unless ($type_rule_off_parts->{$i}) {
349
                $type_filters->{$i} = {};
350
                foreach my $alias (keys %$table_alias) {
351
                    my $table = $table_alias->{$alias};
352
                    
353
                    foreach my $column (keys %{$self->{"_into$i"}{key}{$table} || {}}) {
354
                        $type_filters->{$i}->{"$alias.$column"} = $self->{"_into$i"}{key}{$table}{$column};
355
                    }
356
                }
357
                $type_filters->{$i} = {%{$type_filters->{$i}}, %{$self->{"_into$i"}{key}{$main_table} || {}}}
358
                  if $main_table;
359
            }
360
        }
361
    }
362
    
363
    # DEPRECATED! Applied filter
364
    if ($self->{filter}{on}) {
365
        my $applied_filter = {};
366
        foreach my $table (@$tables) {
367
            $applied_filter = {
368
                %$applied_filter,
369
                %{$self->{filter}{out}->{$table} || {}}
370
            }
371
        }
372
        $filter = {%$applied_filter, %$filter};
373
    }
374
    
375
    # Replace filter name to code
376
    foreach my $column (keys %$filter) {
377
        my $name = $filter->{$column};
378
        if (!defined $name) {
379
            $filter->{$column} = undef;
380
        }
381
        elsif (ref $name ne 'CODE') {
382
          croak qq{Filter "$name" is not registered" } . _subname
383
            unless exists $self->filters->{$name};
384
          $filter->{$column} = $self->filters->{$name};
385
        }
386
    }
387
    
388
    # Create bind values
389
    my $bind = $self->_create_bind_values(
390
        $param,
391
        $query->columns,
392
        $filter,
393
        $type_filters,
394
        $bind_type
395
    );
396
    
397
    # Execute
398
    my $sth = $query->sth;
399
    my $affected;
400
    eval {
401
        for (my $i = 0; $i < @$bind; $i++) {
402
            my $bind_type = $bind->[$i]->{bind_type};
403
            $sth->bind_param(
404
                $i + 1,
405
                $bind->[$i]->{value},
406
                $bind_type ? $bind_type : ()
407
            );
408
        }
409
        $affected = $sth->execute;
410
    };
411
    
412
    $self->_croak($@, qq{. Following SQL is executed.\n}
413
      . qq{$query->{sql}\n} . _subname) if $@;
414
    
415
    # DEBUG message
416
    if (DEBUG) {
417
        print STDERR "SQL:\n" . $query->sql . "\n";
418
        my @output;
419
        foreach my $b (@$bind) {
420
            my $value = $b->{value};
421
            $value = 'undef' unless defined $value;
422
            $value = encode(DEBUG_ENCODING(), $value)
423
              if utf8::is_utf8($value);
424
            push @output, $value;
425
        }
426
        print STDERR "Bind values: " . join(', ', @output) . "\n\n";
427
    }
428
    
429
    # Select statement
430
    if ($sth->{NUM_OF_FIELDS}) {
431
        
432
        # DEPRECATED! Filter
433
        my $filter = {};
434
        if ($self->{filter}{on}) {
435
            $filter->{in}  = {};
436
            $filter->{end} = {};
437
            push @$tables, $main_table if $main_table;
438
            foreach my $table (@$tables) {
439
                foreach my $way (qw/in end/) {
440
                    $filter->{$way} = {
441
                        %{$filter->{$way}},
442
                        %{$self->{filter}{$way}{$table} || {}}
443
                    };
444
                }
445
            }
446
        }
447
        
448
        # Result
449
        my $result = $self->result_class->new(
450
            sth => $sth,
451
            dbi => $self,
452
            default_filter => $self->{default_in_filter},
453
            filter => $filter->{in} || {},
454
            end_filter => $filter->{end} || {},
455
            type_rule => {
456
                from1 => $self->type_rule->{from1},
457
                from2 => $self->type_rule->{from2}
458
            },
459
        );
460

            
461
        return $result;
462
    }
463
    
464
    # Not select statement
465
    else { return $affected }
466
}
467

            
468
sub insert {
469
    my $self = shift;
470
    
471
    # Arguments
472
    my $param;
473
    $param = shift if @_ % 2;
474
    my %args = @_;
475
    my $table  = delete $args{table};
476
    croak qq{"table" option must be specified } . _subname
477
      unless defined $table;
478
    my $p = delete $args{param} || {};
479
    $param  ||= $p;
480
    my $append = delete $args{append} || '';
481
    my $id = delete $args{id};
482
    my $primary_key = delete $args{primary_key};
483
    croak "insert method primary_key option " .
484
          "must be specified when id is specified " . _subname
485
      if defined $id && !defined $primary_key;
486
    $primary_key = [$primary_key] unless ref $primary_key eq 'ARRAY';
487
    my $prefix = delete $args{prefix};
488

            
489
    # Merge parameter
490
    if (defined $id) {
491
        my $id_param = $self->_create_param_from_id($id, $primary_key);
492
        $param = $self->merge_param($id_param, $param);
493
    }
494

            
495
    # Insert statement
496
    my @sql;
497
    push @sql, "insert";
498
    push @sql, $prefix if defined $prefix;
499
    push @sql, "into " . $self->_q($table) . " " . $self->insert_param($param);
500
    push @sql, $append if defined $append;
501
    my $sql = join (' ', @sql);
502
    
503
    # Execute query
504
    return $self->execute($sql, $param, table => $table, %args);
505
}
506

            
507
sub insert_param {
508
    my ($self, $param) = @_;
509
    
510
    # Create insert parameter tag
511
    my $safety = $self->safety_character;
512
    my @columns;
513
    my @placeholders;
514
    foreach my $column (sort keys %$param) {
515
        croak qq{"$column" is not safety column name } . _subname
516
          unless $column =~ /^[$safety\.]+$/;
517
        my $column_quote = $self->_q($column);
518
        $column_quote =~ s/\./$self->_q(".")/e;
519
        push @columns, $column_quote;
520
        push @placeholders, ref $param->{$column} eq 'SCALAR'
521
          ? ${$param->{$column}} : ":$column";
522
    }
523
    
524
    return '(' . join(', ', @columns) . ') ' . 'values ' .
525
           '(' . join(', ', @placeholders) . ')'
526
}
527

            
528
sub include_model {
529
    my ($self, $name_space, $model_infos) = @_;
530
    
531
    # Name space
532
    $name_space ||= '';
533
    
534
    # Get Model infomations
535
    unless ($model_infos) {
536

            
537
        # Load name space module
538
        croak qq{"$name_space" is invalid class name } . _subname
539
          if $name_space =~ /[^\w:]/;
540
        eval "use $name_space";
541
        croak qq{Name space module "$name_space.pm" is needed. $@ }
542
            . _subname
543
          if $@;
544
        
545
        # Search model modules
546
        my $path = $INC{"$name_space.pm"};
547
        $path =~ s/\.pm$//;
548
        opendir my $dh, $path
549
          or croak qq{Can't open directory "$path": $! } . _subname
550
        $model_infos = [];
551
        while (my $module = readdir $dh) {
552
            push @$model_infos, $module
553
              if $module =~ s/\.pm$//;
554
        }
555
        close $dh;
556
    }
557
    
558
    # Include models
559
    foreach my $model_info (@$model_infos) {
560
        
561
        # Load model
562
        my $model_class;
563
        my $model_name;
564
        my $model_table;
565
        if (ref $model_info eq 'HASH') {
566
            $model_class = $model_info->{class};
567
            $model_name  = $model_info->{name};
568
            $model_table = $model_info->{table};
569
            
570
            $model_name  ||= $model_class;
571
            $model_table ||= $model_name;
572
        }
573
        else { $model_class = $model_name = $model_table = $model_info }
574
        my $mclass = "${name_space}::$model_class";
575
        croak qq{"$mclass" is invalid class name } . _subname
576
          if $mclass =~ /[^\w:]/;
577
        unless ($mclass->can('isa')) {
578
            eval "use $mclass";
579
            croak "$@ " . _subname if $@;
580
        }
581
        
582
        # Create model
583
        my $args = {};
584
        $args->{model_class} = $mclass if $mclass;
585
        $args->{name}        = $model_name if $model_name;
586
        $args->{table}       = $model_table if $model_table;
587
        $self->create_model($args);
588
    }
589
    
590
    return $self;
591
}
592

            
593
sub map_param {
594
    my $self = shift;
595
    my $param = shift;
596
    my %map = @_;
597
    
598
    # Mapping
599
    my $map_param = {};
600
    foreach my $key (keys %map) {
601
        my $value_cb;
602
        my $condition;
603
        my $map_key;
604
        
605
        # Get mapping information
606
        if (ref $map{$key} eq 'ARRAY') {
607
            foreach my $some (@{$map{$key}}) {
608
                $map_key = $some unless ref $some;
609
                $condition = $some->{if} if ref $some eq 'HASH';
610
                $value_cb = $some if ref $some eq 'CODE';
611
            }
612
        }
613
        else {
614
            $map_key = $map{$key};
615
        }
616
        $value_cb ||= sub { $_[0] };
617
        $condition ||= sub { defined $_[0] && length $_[0] };
618

            
619
        # Map parameter
620
        my $value;
621
        if (ref $condition eq 'CODE') {
622
            $map_param->{$map_key} = $value_cb->($param->{$key})
623
              if $condition->($param->{$key});
624
        }
625
        elsif ($condition eq 'exists') {
626
            $map_param->{$map_key} = $value_cb->($param->{$key})
627
              if exists $param->{$key};
628
        }
629
        else { croak qq/Condition must be code reference or "exists" / . _subname }
630
    }
631
    
632
    return $map_param;
633
}
634

            
635
sub merge_param {
636
    my ($self, @params) = @_;
637
    
638
    # Merge parameters
639
    my $merge = {};
640
    foreach my $param (@params) {
641
        foreach my $column (keys %$param) {
642
            my $param_is_array = ref $param->{$column} eq 'ARRAY' ? 1 : 0;
643
            
644
            if (exists $merge->{$column}) {
645
                $merge->{$column} = [$merge->{$column}]
646
                  unless ref $merge->{$column} eq 'ARRAY';
647
                push @{$merge->{$column}},
648
                  ref $param->{$column} ? @{$param->{$column}} : $param->{$column};
649
            }
650
            else {
651
                $merge->{$column} = $param->{$column};
652
            }
653
        }
654
    }
655
    
656
    return $merge;
657
}
658

            
659
sub method {
660
    my $self = shift;
661
    
662
    # Register method
663
    my $methods = ref $_[0] eq 'HASH' ? $_[0] : {@_};
664
    $self->{_methods} = {%{$self->{_methods} || {}}, %$methods};
665
    
666
    return $self;
667
}
668

            
669
sub model {
670
    my ($self, $name, $model) = @_;
671
    
672
    # Set model
673
    if ($model) {
674
        $self->models->{$name} = $model;
675
        return $self;
676
    }
677
    
678
    # Check model existance
679
    croak qq{Model "$name" is not included } . _subname
680
      unless $self->models->{$name};
681
    
682
    # Get model
683
    return $self->models->{$name};
684
}
685

            
686
sub mycolumn {
687
    my ($self, $table, $columns) = @_;
688
    
689
    # Create column clause
690
    my @column;
691
    $columns ||= [];
692
    push @column, $self->_q($table) . "." . $self->_q($_) .
693
      " as " . $self->_q($_)
694
      for @$columns;
695
    
696
    return join (', ', @column);
697
}
698

            
699
sub new {
700
    my $self = shift->SUPER::new(@_);
701
    
702
    # Check attributes
703
    my @attrs = keys %$self;
704
    foreach my $attr (@attrs) {
705
        croak qq{"$attr" is wrong name } . _subname
706
          unless $self->can($attr);
707
    }
708
    
709
    # DEPRECATED!
710
    $self->query_builder->{tags} = {
711
        '?'     => \&DBIx::Custom::Tag::placeholder,
712
        '='     => \&DBIx::Custom::Tag::equal,
713
        '<>'    => \&DBIx::Custom::Tag::not_equal,
714
        '>'     => \&DBIx::Custom::Tag::greater_than,
715
        '<'     => \&DBIx::Custom::Tag::lower_than,
716
        '>='    => \&DBIx::Custom::Tag::greater_than_equal,
717
        '<='    => \&DBIx::Custom::Tag::lower_than_equal,
718
        'like'  => \&DBIx::Custom::Tag::like,
719
        'in'    => \&DBIx::Custom::Tag::in,
720
        'insert_param' => \&DBIx::Custom::Tag::insert_param,
721
        'update_param' => \&DBIx::Custom::Tag::update_param
722
    };
723
    
724
    return $self;
725
}
726

            
727
sub not_exists { bless {}, 'DBIx::Custom::NotExists' }
728

            
729
sub order {
730
    my $self = shift;
731
    return DBIx::Custom::Order->new(dbi => $self, @_);
732
}
733

            
734
sub register_filter {
735
    my $self = shift;
736
    
737
    # Register filter
738
    my $filters = ref $_[0] eq 'HASH' ? $_[0] : {@_};
739
    $self->filters({%{$self->filters}, %$filters});
740
    
741
    return $self;
742
}
743

            
744
sub select {
745
    my ($self, %args) = @_;
746

            
747
    # Arguments
748
    my $table = delete $args{table};
749
    my $tables = ref $table eq 'ARRAY' ? $table
750
               : defined $table ? [$table]
751
               : [];
752
    my $columns   = delete $args{column};
753
    my $where     = delete $args{where} || {};
754
    my $append    = delete $args{append};
755
    my $join      = delete $args{join} || [];
756
    croak qq{"join" must be array reference } . _subname
757
      unless ref $join eq 'ARRAY';
758
    my $relation = delete $args{relation};
759
    warn "select() relation option is DEPRECATED!"
760
      if $relation;
761
    my $param = delete $args{param} || {}; # DEPRECATED!
762
    warn "select() param option is DEPRECATED!"
763
      if keys %$param;
764
    my $where_param = delete $args{where_param} || $param || {};
765
    my $wrap = delete $args{wrap};
766
    my $id = delete $args{id};
767
    my $primary_key = delete $args{primary_key};
768
    croak "update method primary_key option " .
769
          "must be specified when id is specified " . _subname
770
      if defined $id && !defined $primary_key;
771
    $primary_key = [$primary_key] unless ref $primary_key eq 'ARRAY';
772
    my $prefix = delete $args{prefix};
773
    
774
    # Add relation tables(DEPRECATED!);
775
    $self->_add_relation_table($tables, $relation);
776
    
777
    # Select statement
778
    my @sql;
779
    push @sql, 'select';
780
    
781
    # Prefix
782
    push @sql, $prefix if defined $prefix;
783
    
784
    # Column clause
785
    if ($columns) {
786
        $columns = [$columns] unless ref $columns eq 'ARRAY';
787
        foreach my $column (@$columns) {
788
            if (ref $column eq 'HASH') {
789
                $column = $self->column(%$column) if ref $column eq 'HASH';
790
            }
791
            elsif (ref $column eq 'ARRAY') {
792
                if (@$column == 3 && $column->[1] eq 'as') {
793
                    warn "[COLUMN, as => ALIAS] is DEPRECATED! use [COLUMN => ALIAS]";
794
                    splice @$column, 1, 1;
795
                }
796
                
797
                $column = join(' ', $column->[0], 'as', $self->_q($column->[1]));
798
            }
799
            unshift @$tables, @{$self->_search_tables($column)};
800
            push @sql, ($column, ',');
801
        }
802
        pop @sql if $sql[-1] eq ',';
803
    }
804
    else { push @sql, '*' }
805
    
806
    # Table
807
    push @sql, 'from';
808
    if ($relation) {
809
        my $found = {};
810
        foreach my $table (@$tables) {
811
            push @sql, ($self->_q($table), ',') unless $found->{$table};
812
            $found->{$table} = 1;
813
        }
814
    }
815
    else {
816
        my $main_table = $tables->[-1] || '';
817
        push @sql, $self->_q($main_table);
818
    }
819
    pop @sql if ($sql[-1] || '') eq ',';
820
    croak "Not found table name " . _subname
821
      unless $tables->[-1];
822

            
823
    # Add tables in parameter
824
    unshift @$tables,
825
            @{$self->_search_tables(join(' ', keys %$where_param) || '')};
826
    
827
    # Where
828
    my $where_clause = '';
829
    $where = $self->_create_param_from_id($id, $primary_key) if defined $id;
830
    if (ref $where eq 'ARRAY' && !ref $where->[0]) {
831
        $where_clause = "where " . $where->[0];
832
        $where_param = $where->[1];
833
    }
834
    elsif (ref $where) {
835
        $where = $self->_where_to_obj($where);
836
        $where_param = keys %$where_param
837
                     ? $self->merge_param($where_param, $where->param)
838
                     : $where->param;
839
        
840
        # String where
841
        $where_clause = $where->to_string;
842
    }
843
    elsif ($where) { $where_clause = "where $where" }
844
    
845
    # Add table names in where clause
846
    unshift @$tables, @{$self->_search_tables($where_clause)};
847
    
848
    # Push join
849
    $self->_push_join(\@sql, $join, $tables);
850
    
851
    # Add where clause
852
    push @sql, $where_clause;
853
    
854
    # Relation(DEPRECATED!);
855
    $self->_push_relation(\@sql, $tables, $relation, $where_clause eq '' ? 1 : 0);
856
    
857
    # Append
858
    push @sql, $append if defined $append;
859
    
860
    # Wrap
861
    if ($wrap) {
862
        croak "wrap option must be array refrence " . _subname
863
          unless ref $wrap eq 'ARRAY';
864
        unshift @sql, $wrap->[0];
865
        push @sql, $wrap->[1];
866
    }
867
    
868
    # SQL
869
    my $sql = join (' ', @sql);
870
    
871
    # Execute query
872
    my $result = $self->execute($sql, $where_param, table => $tables, %args);
873
    
874
    return $result;
875
}
876

            
877
sub separator {
878
    my $self = shift;
879
    
880
    if (@_) {
881
        my $separator = $_[0] || '';
882
        croak qq{Separator must be "." or "__" or "-" } . _subname
883
          unless $separator eq '.' || $separator eq '__'
884
              || $separator eq '-';
885
        
886
        $self->{separator} = $separator;
887
    
888
        return $self;
889
    }
890
    return $self->{separator} ||= '.';
891
}
892

            
893
sub setup_model {
894
    my $self = shift;
895
    
896
    # Setup model
897
    $self->each_column(
898
        sub {
899
            my ($self, $table, $column, $column_info) = @_;
900
            if (my $model = $self->models->{$table}) {
901
                push @{$model->columns}, $column;
902
            }
903
        }
904
    );
905
    return $self;
906
}
907

            
908
sub available_data_type {
909
    my $self = shift;
910
    
911
    my $data_types = '';
912
    foreach my $i (-1000 .. 1000) {
913
         my $type_info = $self->dbh->type_info($i);
914
         my $data_type = $type_info->{DATA_TYPE};
915
         my $type_name = $type_info->{TYPE_NAME};
916
         $data_types .= "$data_type ($type_name)\n"
917
           if defined $data_type;
918
    }
919
    return "Data Type maybe equal to Type Name" unless $data_types;
920
    $data_types = "Data Type (Type name)\n" . $data_types;
921
    return $data_types;
922
}
923

            
924
sub available_type_name {
925
    my $self = shift;
926
    
927
    # Type Names
928
    my $type_names = {};
929
    $self->each_column(sub {
930
        my ($self, $table, $column, $column_info) = @_;
931
        $type_names->{$column_info->{TYPE_NAME}} = 1
932
          if $column_info->{TYPE_NAME};
933
    });
934
    my @output = sort keys %$type_names;
935
    unshift @output, "Type Name";
936
    return join "\n", @output;
937
}
938

            
939
sub type_rule {
940
    my $self = shift;
941
    
942
    if (@_) {
943
        my $type_rule = ref $_[0] eq 'HASH' ? $_[0] : {@_};
944
        
945
        # Into
946
        foreach my $i (1 .. 2) {
947
            my $into = "into$i";
948
            $type_rule->{$into} = _array_to_hash($type_rule->{$into});
949
            $self->{type_rule} = $type_rule;
950
            $self->{"_$into"} = {};
951
            foreach my $type_name (keys %{$type_rule->{$into} || {}}) {
952
                croak qq{type name of $into section must be lower case}
953
                  if $type_name =~ /[A-Z]/;
954
            }
955
            $self->each_column(sub {
956
                my ($dbi, $table, $column, $column_info) = @_;
957
                
958
                my $type_name = lc $column_info->{TYPE_NAME};
959
                if ($type_rule->{$into} &&
960
                    (my $filter = $type_rule->{$into}->{$type_name}))
961
                {
962
                    return unless exists $type_rule->{$into}->{$type_name};
963
                    if  (defined $filter && ref $filter ne 'CODE') 
964
                    {
965
                        my $fname = $filter;
966
                        croak qq{Filter "$fname" is not registered" } . _subname
967
                          unless exists $self->filters->{$fname};
968
                        
969
                        $filter = $self->filters->{$fname};
970
                    }
971

            
972
                    $self->{"_$into"}{key}{$table}{$column} = $filter;
973
                    $self->{"_$into"}{dot}{"$table.$column"} = $filter;
974
                }
975
            });
976
        }
977

            
978
        # From
979
        foreach my $i (1 .. 2) {
980
            $type_rule->{"from$i"} = _array_to_hash($type_rule->{"from$i"});
981
            foreach my $data_type (keys %{$type_rule->{"from$i"} || {}}) {
982
                croak qq{data type of from$i section must be lower case or number}
983
                  if $data_type =~ /[A-Z]/;
984
                my $fname = $type_rule->{"from$i"}{$data_type};
985
                if (defined $fname && ref $fname ne 'CODE') {
986
                    croak qq{Filter "$fname" is not registered" } . _subname
987
                      unless exists $self->filters->{$fname};
988
                    
989
                    $type_rule->{"from$i"}{$data_type} = $self->filters->{$fname};
990
                }
991
            }
992
        }
993
        
994
        return $self;
995
    }
996
    
997
    return $self->{type_rule} || {};
998
}
999

            
1000
sub update {
1001
    my $self = shift;
1002

            
1003
    # Arguments
1004
    my $param;
1005
    $param = shift if @_ % 2;
1006
    my %args = @_;
1007
    my $table = delete $args{table} || '';
1008
    croak qq{"table" option must be specified } . _subname
1009
      unless $table;
1010
    my $p = delete $args{param} || {};
1011
    $param  ||= $p;
1012
    my $where = delete $args{where} || {};
1013
    my $where_param = delete $args{where_param} || {};
1014
    my $append = delete $args{append} || '';
1015
    my $allow_update_all = delete $args{allow_update_all};
1016
    my $id = delete $args{id};
1017
    my $primary_key = delete $args{primary_key};
1018
    croak "update method primary_key option " .
1019
          "must be specified when id is specified " . _subname
1020
      if defined $id && !defined $primary_key;
1021
    $primary_key = [$primary_key] unless ref $primary_key eq 'ARRAY';
1022
    my $prefix = delete $args{prefix};
1023

            
1024
    # Update clause
1025
    my $update_clause = $self->update_param($param);
1026

            
1027
    # Where
1028
    $where = $self->_create_param_from_id($id, $primary_key) if defined $id;
1029
    my $where_clause = '';
1030
    if (ref $where eq 'ARRAY' && !ref $where->[0]) {
1031
        $where_clause = "where " . $where->[0];
1032
        $where_param = $where->[1];
1033
    }
1034
    elsif (ref $where) {
1035
        $where = $self->_where_to_obj($where);
1036
        $where_param = keys %$where_param
1037
                     ? $self->merge_param($where_param, $where->param)
1038
                     : $where->param;
1039
        
1040
        # String where
1041
        $where_clause = $where->to_string;
1042
    }
1043
    elsif ($where) { $where_clause = "where $where" }
1044
    croak qq{"where" must be specified } . _subname
1045
      if "$where_clause" eq '' && !$allow_update_all;
1046
    
1047
    # Merge param
1048
    $param = $self->merge_param($param, $where_param) if keys %$where_param;
1049
    
1050
    # Update statement
1051
    my @sql;
1052
    push @sql, "update";
1053
    push @sql, $prefix if defined $prefix;
1054
    push @sql, $self->_q($table) . " $update_clause $where_clause";
1055
    push @sql, $append if defined $append;
1056
    
1057
    # SQL
1058
    my $sql = join(' ', @sql);
1059
    
1060
    # Execute query
1061
    return $self->execute($sql, $param, table => $table, %args);
1062
}
1063

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

            
1066
sub update_param {
1067
    my ($self, $param, $opt) = @_;
1068
    
1069
    # Create update parameter tag
1070
    my $tag = $self->assign_param($param);
1071
    $tag = "set $tag" unless $opt->{no_set};
1072

            
1073
    return $tag;
1074
}
1075

            
1076
sub where { DBIx::Custom::Where->new(dbi => shift, @_) }
1077

            
1078
sub _create_query {
1079
    
1080
    my ($self, $source) = @_;
1081
    
1082
    # Cache
1083
    my $cache = $self->cache;
1084
    
1085
    # Query
1086
    my $query;
1087
    
1088
    # Get cached query
1089
    if ($cache) {
1090
        
1091
        # Get query
1092
        my $q = $self->cache_method->($self, $source);
1093
        
1094
        # Create query
1095
        if ($q) {
1096
            $query = DBIx::Custom::Query->new($q);
1097
            $query->{filters} = $self->filters;
1098
        }
1099
    }
1100
    
1101
    # Create query
1102
    unless ($query) {
1103

            
1104
        # Create query
1105
        my $builder = $self->query_builder;
1106
        $query = $builder->build_query($source);
1107

            
1108
        # Remove reserved word quote
1109
        if (my $q = $self->_quote) {
1110
            $q = quotemeta($q);
1111
            $_ =~ s/[$q]//g for @{$query->columns}
1112
        }
1113

            
1114
        # Save query to cache
1115
        $self->cache_method->(
1116
            $self, $source,
1117
            {
1118
                sql     => $query->sql, 
1119
                columns => $query->columns,
1120
                tables  => $query->{tables} || []
1121
            }
1122
        ) if $cache;
1123
    }
1124
    
1125
    # Save sql
1126
    $self->last_sql($query->sql);
1127
    
1128
    # Prepare statement handle
1129
    my $sth;
1130
    eval { $sth = $self->dbh->prepare($query->{sql})};
1131
    
1132
    if ($@) {
1133
        $self->_croak($@, qq{. Following SQL is executed.\n}
1134
                        . qq{$query->{sql}\n} . _subname);
1135
    }
1136
    
1137
    # Set statement handle
1138
    $query->sth($sth);
1139
    
1140
    # Set filters
1141
    $query->{filters} = $self->filters;
1142
    
1143
    return $query;
1144
}
1145

            
1146
sub _create_bind_values {
1147
    my ($self, $params, $columns, $filter, $type_filters, $bind_type) = @_;
1148
    
1149
    # Create bind values
1150
    my $bind = [];
1151
    my $count = {};
1152
    my $not_exists = {};
1153
    foreach my $column (@$columns) {
1154
        
1155
        # Value
1156
        my $value;
1157
        if(ref $params->{$column} eq 'ARRAY') {
1158
            my $i = $count->{$column} || 0;
1159
            $i += $not_exists->{$column} || 0;
1160
            my $found;
1161
            for (my $k = $i; $i < @{$params->{$column}}; $k++) {
1162
                if (ref $params->{$column}->[$k] eq 'DBIx::Custom::NotExists') {
1163
                    $not_exists->{$column}++;
1164
                }
1165
                else  {
1166
                    $value = $params->{$column}->[$k];
1167
                    $found = 1;
1168
                    last
1169
                }
1170
            }
1171
            next unless $found;
1172
        }
1173
        else { $value = $params->{$column} }
1174
        
1175
        # Filter
1176
        my $f = $filter->{$column} || $self->{default_out_filter} || '';
1177
        $value = $f->($value) if $f;
1178
        
1179
        # Type rule
1180
        foreach my $i (1 .. 2) {
1181
            my $type_filter = $type_filters->{$i};
1182
            my $tf = $self->{"_into$i"}->{dot}->{$column} || $type_filter->{$column};
1183
            $value = $tf->($value) if $tf;
1184
        }
1185
        
1186
        # Bind values
1187
        push @$bind, {value => $value, bind_type => $bind_type->{$column}};
1188
        
1189
        # Count up 
1190
        $count->{$column}++;
1191
    }
1192
    
1193
    return $bind;
1194
}
1195

            
1196
sub _create_param_from_id {
1197
    my ($self, $id, $primary_keys) = @_;
1198
    
1199
    # Create parameter
1200
    my $param = {};
1201
    if (defined $id) {
1202
        $id = [$id] unless ref $id;
1203
        croak qq{"id" must be constant value or array reference}
1204
            . " (" . (caller 1)[3] . ")"
1205
          unless !ref $id || ref $id eq 'ARRAY';
1206
        croak qq{"id" must contain values same count as primary key}
1207
            . " (" . (caller 1)[3] . ")"
1208
          unless @$primary_keys eq @$id;
1209
        for(my $i = 0; $i < @$primary_keys; $i ++) {
1210
           $param->{$primary_keys->[$i]} = $id->[$i];
1211
        }
1212
    }
1213
    
1214
    return $param;
1215
}
1216

            
1217
sub _connect {
1218
    my $self = shift;
1219
    
1220
    # Attributes
1221
    my $dsn = $self->data_source;
1222
    warn "data_source is DEPRECATED!\n"
1223
      if $dsn;
1224
    $dsn ||= $self->dsn;
1225
    croak qq{"dsn" must be specified } . _subname
1226
      unless $dsn;
1227
    my $user        = $self->user;
1228
    my $password    = $self->password;
1229
    my $dbi_option = {%{$self->dbi_options}, %{$self->dbi_option}};
1230
    warn "dbi_options is DEPRECATED! use dbi_option instead\n"
1231
      if keys %{$self->dbi_options};
1232
    
1233
    # Connect
1234
    my $dbh = eval {DBI->connect(
1235
        $dsn,
1236
        $user,
1237
        $password,
1238
        {
1239
            %{$self->default_dbi_option},
1240
            %$dbi_option
1241
        }
1242
    )};
1243
    
1244
    # Connect error
1245
    croak "$@ " . _subname if $@;
1246
    
1247
    return $dbh;
1248
}
1249

            
1250
sub _croak {
1251
    my ($self, $error, $append) = @_;
1252
    
1253
    # Append
1254
    $append ||= "";
1255
    
1256
    # Verbose
1257
    if ($Carp::Verbose) { croak $error }
1258
    
1259
    # Not verbose
1260
    else {
1261
        
1262
        # Remove line and module infromation
1263
        my $at_pos = rindex($error, ' at ');
1264
        $error = substr($error, 0, $at_pos);
1265
        $error =~ s/\s+$//;
1266
        croak "$error$append";
1267
    }
1268
}
1269

            
1270
sub _need_tables {
1271
    my ($self, $tree, $need_tables, $tables) = @_;
1272
    
1273
    # Get needed tables
1274
    foreach my $table (@$tables) {
1275
        if ($tree->{$table}) {
1276
            $need_tables->{$table} = 1;
1277
            $self->_need_tables($tree, $need_tables, [$tree->{$table}{parent}])
1278
        }
1279
    }
1280
}
1281

            
1282
sub _push_join {
1283
    my ($self, $sql, $join, $join_tables) = @_;
1284
    
1285
    # No join
1286
    return unless @$join;
1287
    
1288
    # Push join clause
1289
    my $tree = {};
1290
    for (my $i = 0; $i < @$join; $i++) {
1291
        
1292
        # Arrange
1293
        my $join_clause;;
1294
        my $option;
1295
        if (ref $join->[$i] eq 'HASH') {
1296
            $join_clause = $join->[$i]->{clause};
1297
            $option = {table => $join->[$i]->{table}};
1298
        }
1299
        else {
1300
            $join_clause = $join->[$i];
1301
            $option = {};
1302
        };
1303

            
1304
        # Find tables in join clause
1305
        my $table1;
1306
        my $table2;
1307
        if (my $table = $option->{table}) {
1308
            $table1 = $table->[0];
1309
            $table2 = $table->[1];
1310
        }
1311
        else {
1312
            my $q = $self->_quote;
1313
            my $j_clause = (split /\s+on\s+/, $join_clause)[-1];
1314
            $j_clause =~ s/'.+?'//g;
1315
            my $q_re = quotemeta($q);
1316
            $j_clause =~ s/[$q_re]//g;
1317
            my $c = $self->safety_character;
1318
            my $join_re = qr/(?:^|\s)($c+)\.$c+\s+=\s+($c+)\.$c+/;
1319
            if ($j_clause =~ $join_re) {
1320
                $table1 = $1;
1321
                $table2 = $2;
1322
            }
1323
        }
1324
        croak qq{join clause must have two table name after "on" keyword. } .
1325
              qq{"$join_clause" is passed }  . _subname
1326
          unless defined $table1 && defined $table2;
1327
        croak qq{right side table of "$join_clause" must be unique }
1328
            . _subname
1329
          if exists $tree->{$table2};
1330
        croak qq{Same table "$table1" is specified} . _subname
1331
          if $table1 eq $table2;
1332
        $tree->{$table2}
1333
          = {position => $i, parent => $table1, join => $join_clause};
1334
    }
1335
    
1336
    # Search need tables
1337
    my $need_tables = {};
1338
    $self->_need_tables($tree, $need_tables, $join_tables);
1339
    my @need_tables = sort { $tree->{$a}{position} <=> $tree->{$b}{position} } keys %$need_tables;
1340
    
1341
    # Add join clause
1342
    foreach my $need_table (@need_tables) {
1343
        push @$sql, $tree->{$need_table}{join};
1344
    }
1345
}
1346

            
1347
sub _quote {
1348
    my $self = shift;
1349
    
1350
    return defined $self->reserved_word_quote ? $self->reserved_word_quote
1351
         : defined $self->quote ? $self->quote
1352
         : '';
1353
}
1354

            
1355
sub _q {
1356
    my ($self, $value) = @_;
1357
    
1358
    my $quote = $self->_quote;
1359
    my $q = substr($quote, 0, 1) || '';
1360
    my $p;
1361
    if (defined $quote && length $quote > 1) {
1362
        $p = substr($quote, 1, 1);
1363
    }
1364
    else { $p = $q }
1365
    
1366
    return "$q$value$p";
1367
}
1368

            
1369
sub _remove_duplicate_table {
1370
    my ($self, $tables, $main_table) = @_;
1371
    
1372
    # Remove duplicate table
1373
    my %tables = map {defined $_ ? ($_ => 1) : ()} @$tables;
1374
    delete $tables{$main_table} if $main_table;
1375
    
1376
    my $new_tables = [keys %tables, $main_table ? $main_table : ()];
1377
    if (my $q = $self->_quote) {
1378
        $q = quotemeta($q);
1379
        $_ =~ s/[$q]//g for @$new_tables;
1380
    }
1381

            
1382
    return $new_tables;
1383
}
1384

            
1385
sub _search_tables {
1386
    my ($self, $source) = @_;
1387
    
1388
    # Search tables
1389
    my $tables = [];
1390
    my $safety_character = $self->safety_character;
1391
    my $q = $self->_quote;
1392
    my $q_re = quotemeta($q);
1393
    my $quoted_safety_character_re = $self->_q("?([$safety_character]+)");
1394
    my $table_re = $q ? qr/(?:^|[^$safety_character])$quoted_safety_character_re?\./
1395
                      : qr/(?:^|[^$safety_character])([$safety_character]+)\./;
1396
    while ($source =~ /$table_re/g) {
1397
        push @$tables, $1;
1398
    }
1399
    
1400
    return $tables;
1401
}
1402

            
1403
sub _where_to_obj {
1404
    my ($self, $where) = @_;
1405
    
1406
    my $obj;
1407
    
1408
    # Hash
1409
    if (ref $where eq 'HASH') {
1410
        my $clause = ['and'];
1411
        my $q = $self->_quote;
1412
        foreach my $column (keys %$where) {
1413
            my $column_quote = $self->_q($column);
1414
            $column_quote =~ s/\./$self->_q(".")/e;
1415
            push @$clause, "$column_quote = :$column" for keys %$where;
1416
        }
1417
        $obj = $self->where(clause => $clause, param => $where);
1418
    }
1419
    
1420
    # DBIx::Custom::Where object
1421
    elsif (ref $where eq 'DBIx::Custom::Where') {
1422
        $obj = $where;
1423
    }
1424
    
1425
    # Array
1426
    elsif (ref $where eq 'ARRAY') {
1427
        $obj = $self->where(
1428
            clause => $where->[0],
1429
            param  => $where->[1]
1430
        );
1431
    }
1432
    
1433
    # Check where argument
1434
    croak qq{"where" must be hash reference or DBIx::Custom::Where object}
1435
        . qq{or array reference, which contains where clause and parameter}
1436
        . _subname
1437
      unless ref $obj eq 'DBIx::Custom::Where';
1438
    
1439
    return $obj;
1440
}
1441

            
1442
sub _apply_filter {
1443
    my ($self, $table, @cinfos) = @_;
1444

            
1445
    # Initialize filters
1446
    $self->{filter} ||= {};
1447
    $self->{filter}{on} = 1;
1448
    $self->{filter}{out} ||= {};
1449
    $self->{filter}{in} ||= {};
1450
    $self->{filter}{end} ||= {};
1451
    
1452
    # Usage
1453
    my $usage = "Usage: \$dbi->apply_filter(" .
1454
                "TABLE, COLUMN1, {in => INFILTER1, out => OUTFILTER1, end => ENDFILTER1}, " .
1455
                "COLUMN2, {in => INFILTER2, out => OUTFILTER2, end => ENDFILTER2}, ...)";
1456
    
1457
    # Apply filter
1458
    for (my $i = 0; $i < @cinfos; $i += 2) {
1459
        
1460
        # Column
1461
        my $column = $cinfos[$i];
1462
        if (ref $column eq 'ARRAY') {
1463
            foreach my $c (@$column) {
1464
                push @cinfos, $c, $cinfos[$i + 1];
1465
            }
1466
            next;
1467
        }
1468
        
1469
        # Filter infomation
1470
        my $finfo = $cinfos[$i + 1] || {};
1471
        croak "$usage (table: $table) " . _subname
1472
          unless  ref $finfo eq 'HASH';
1473
        foreach my $ftype (keys %$finfo) {
1474
            croak "$usage (table: $table) " . _subname
1475
              unless $ftype eq 'in' || $ftype eq 'out' || $ftype eq 'end'; 
1476
        }
1477
        
1478
        # Set filters
1479
        foreach my $way (qw/in out end/) {
1480
        
1481
            # Filter
1482
            my $filter = $finfo->{$way};
1483
            
1484
            # Filter state
1485
            my $state = !exists $finfo->{$way} ? 'not_exists'
1486
                      : !defined $filter        ? 'not_defined'
1487
                      : ref $filter eq 'CODE'   ? 'code'
1488
                      : 'name';
1489
            
1490
            # Filter is not exists
1491
            next if $state eq 'not_exists';
1492
            
1493
            # Check filter name
1494
            croak qq{Filter "$filter" is not registered } . _subname
1495
              if  $state eq 'name'
1496
               && ! exists $self->filters->{$filter};
1497
            
1498
            # Set filter
1499
            my $f = $state eq 'not_defined' ? undef
1500
                  : $state eq 'code'        ? $filter
1501
                  : $self->filters->{$filter};
1502
            $self->{filter}{$way}{$table}{$column} = $f;
1503
            $self->{filter}{$way}{$table}{"$table.$column"} = $f;
1504
            $self->{filter}{$way}{$table}{"${table}__$column"} = $f;
1505
            $self->{filter}{$way}{$table}{"${table}-$column"} = $f;
1506
        }
1507
    }
1508
    
1509
    return $self;
1510
}
1511

            
1512
# DEPRECATED!
1513
sub create_query {
1514
    warn "create_query is DEPRECATED! use query option of each method";
1515
    shift->_create_query(@_);
1516
}
1517

            
1518
# DEPRECATED!
1519
sub apply_filter {
1520
    my $self = shift;
1521
    
1522
    warn "apply_filter is DEPRECATED!";
1523
    return $self->_apply_filter(@_);
1524
}
1525

            
1526
# DEPRECATED!
1527
our %SELECT_AT_ARGS = (%VALID_ARGS, where => 1, primary_key => 1);
1528
sub select_at {
1529
    my ($self, %args) = @_;
1530

            
1531
    warn "select_at is DEPRECATED! use update and id option instead";
1532

            
1533
    # Arguments
1534
    my $primary_keys = delete $args{primary_key};
1535
    $primary_keys = [$primary_keys] unless ref $primary_keys;
1536
    my $where = delete $args{where};
1537
    my $param = delete $args{param};
1538
    
1539
    # Check arguments
1540
    foreach my $name (keys %args) {
1541
        croak qq{"$name" is wrong option } . _subname
1542
          unless $SELECT_AT_ARGS{$name};
1543
    }
1544
    
1545
    # Table
1546
    croak qq{"table" option must be specified } . _subname
1547
      unless $args{table};
1548
    my $table = ref $args{table} ? $args{table}->[-1] : $args{table};
1549
    
1550
    # Create where parameter
1551
    my $where_param = $self->_create_param_from_id($where, $primary_keys);
1552
    
1553
    return $self->select(where => $where_param, %args);
1554
}
1555

            
1556
# DEPRECATED!
1557
our %DELETE_AT_ARGS = (%VALID_ARGS, where => 1, primary_key => 1);
1558
sub delete_at {
1559
    my ($self, %args) = @_;
1560

            
1561
    warn "delete_at is DEPRECATED! use update and id option instead";
1562
    
1563
    # Arguments
1564
    my $primary_keys = delete $args{primary_key};
1565
    $primary_keys = [$primary_keys] unless ref $primary_keys;
1566
    my $where = delete $args{where};
1567
    
1568
    # Check arguments
1569
    foreach my $name (keys %args) {
1570
        croak qq{"$name" is wrong option } . _subname
1571
          unless $DELETE_AT_ARGS{$name};
1572
    }
1573
    
1574
    # Create where parameter
1575
    my $where_param = $self->_create_param_from_id($where, $primary_keys);
1576
    
1577
    return $self->delete(where => $where_param, %args);
1578
}
1579

            
1580
# DEPRECATED!
1581
our %UPDATE_AT_ARGS = (%VALID_ARGS, where => 1, primary_key => 1);
1582
sub update_at {
1583
    my $self = shift;
1584

            
1585
    warn "update_at is DEPRECATED! use update and id option instead";
1586
    
1587
    # Arguments
1588
    my $param;
1589
    $param = shift if @_ % 2;
1590
    my %args = @_;
1591
    my $primary_keys = delete $args{primary_key};
1592
    $primary_keys = [$primary_keys] unless ref $primary_keys;
1593
    my $where = delete $args{where};
1594
    my $p = delete $args{param} || {};
1595
    $param  ||= $p;
1596
    
1597
    # Check arguments
1598
    foreach my $name (keys %args) {
1599
        croak qq{"$name" is wrong option } . _subname
1600
          unless $UPDATE_AT_ARGS{$name};
1601
    }
1602
    
1603
    # Create where parameter
1604
    my $where_param = $self->_create_param_from_id($where, $primary_keys);
1605
    
1606
    return $self->update(where => $where_param, param => $param, %args);
1607
}
1608

            
1609
# DEPRECATED!
1610
our %INSERT_AT_ARGS = (%VALID_ARGS, where => 1, primary_key => 1);
1611
sub insert_at {
1612
    my $self = shift;
1613
    
1614
    warn "insert_at is DEPRECATED! use insert and id option instead";
1615
    
1616
    # Arguments
1617
    my $param;
1618
    $param = shift if @_ % 2;
1619
    my %args = @_;
1620
    my $primary_key = delete $args{primary_key};
1621
    $primary_key = [$primary_key] unless ref $primary_key;
1622
    my $where = delete $args{where};
1623
    my $p = delete $args{param} || {};
1624
    $param  ||= $p;
1625
    
1626
    # Check arguments
1627
    foreach my $name (keys %args) {
1628
        croak qq{"$name" is wrong option } . _subname
1629
          unless $INSERT_AT_ARGS{$name};
1630
    }
1631
    
1632
    # Create where parameter
1633
    my $where_param = $self->_create_param_from_id($where, $primary_key);
1634
    $param = $self->merge_param($where_param, $param);
1635
    
1636
    return $self->insert(param => $param, %args);
1637
}
1638

            
1639
# DEPRECATED!
1640
sub register_tag {
1641
    warn "register_tag is DEPRECATED!";
1642
    shift->query_builder->register_tag(@_)
1643
}
1644

            
1645
# DEPRECATED!
1646
has 'data_source';
1647
has dbi_options => sub { {} };
1648
has filter_check  => 1;
1649
has 'reserved_word_quote';
1650

            
1651
# DEPRECATED!
1652
sub default_bind_filter {
1653
    my $self = shift;
1654
    
1655
    warn "default_bind_filter is DEPRECATED!";
1656
    
1657
    if (@_) {
1658
        my $fname = $_[0];
1659
        
1660
        if (@_ && !$fname) {
1661
            $self->{default_out_filter} = undef;
1662
        }
1663
        else {
1664
            croak qq{Filter "$fname" is not registered}
1665
              unless exists $self->filters->{$fname};
1666
        
1667
            $self->{default_out_filter} = $self->filters->{$fname};
1668
        }
1669
        return $self;
1670
    }
1671
    
1672
    return $self->{default_out_filter};
1673
}
1674

            
1675
# DEPRECATED!
1676
sub default_fetch_filter {
1677
    my $self = shift;
1678

            
1679
    warn "default_fetch_filter is DEPRECATED!";
1680
    
1681
    if (@_) {
1682
        my $fname = $_[0];
1683

            
1684
        if (@_ && !$fname) {
1685
            $self->{default_in_filter} = undef;
1686
        }
1687
        else {
1688
            croak qq{Filter "$fname" is not registered}
1689
              unless exists $self->filters->{$fname};
1690
        
1691
            $self->{default_in_filter} = $self->filters->{$fname};
1692
        }
1693
        
1694
        return $self;
1695
    }
1696
    
1697
    return $self->{default_in_filter};
1698
}
1699

            
1700
# DEPRECATED!
1701
sub insert_param_tag {
1702
    warn "insert_param_tag is DEPRECATED! " .
1703
         "use insert_param instead!";
1704
    return shift->insert_param(@_);
1705
}
1706

            
1707
# DEPRECATED!
1708
sub register_tag_processor {
1709
    warn "register_tag_processor is DEPRECATED!";
1710
    return shift->query_builder->register_tag_processor(@_);
1711
}
1712

            
1713
# DEPRECATED!
1714
sub update_param_tag {
1715
    warn "update_param_tag is DEPRECATED! " .
1716
         "use update_param instead";
1717
    return shift->update_param(@_);
1718
}
1719
# DEPRECATED!
1720
sub _push_relation {
1721
    my ($self, $sql, $tables, $relation, $need_where) = @_;
1722
    
1723
    if (keys %{$relation || {}}) {
1724
        push @$sql, $need_where ? 'where' : 'and';
1725
        foreach my $rcolumn (keys %$relation) {
1726
            my $table1 = (split (/\./, $rcolumn))[0];
1727
            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1728
            push @$tables, ($table1, $table2);
1729
            push @$sql, ("$rcolumn = " . $relation->{$rcolumn},  'and');
1730
        }
1731
    }
1732
    pop @$sql if $sql->[-1] eq 'and';    
1733
}
1734

            
1735
# DEPRECATED!
1736
sub _add_relation_table {
1737
    my ($self, $tables, $relation) = @_;
1738
    
1739
    if (keys %{$relation || {}}) {
1740
        foreach my $rcolumn (keys %$relation) {
1741
            my $table1 = (split (/\./, $rcolumn))[0];
1742
            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1743
            my $table1_exists;
1744
            my $table2_exists;
1745
            foreach my $table (@$tables) {
1746
                $table1_exists = 1 if $table eq $table1;
1747
                $table2_exists = 1 if $table eq $table2;
1748
            }
1749
            unshift @$tables, $table1 unless $table1_exists;
1750
            unshift @$tables, $table2 unless $table2_exists;
1751
        }
1752
    }
1753
}
1754

            
1755
1;
1756

            
1757
=head1 NAME
1758

            
1759
DBIx::Custom - Execute insert, update, delete, and select statement easily
1760

            
1761
=head1 SYNOPSYS
1762

            
1763
    use DBIx::Custom;
1764
    
1765
    # Connect
1766
    my $dbi = DBIx::Custom->connect(
1767
        dsn => "dbi:mysql:database=dbname",
1768
        user => 'ken',
1769
        password => '!LFKD%$&',
1770
        dbi_option => {mysql_enable_utf8 => 1}
1771
    );
1772

            
1773
    # Insert 
1774
    $dbi->insert({title => 'Perl', author => 'Ken'}, table  => 'book');
1775
    
1776
    # Update 
1777
    $dbi->update({title => 'Perl', author => 'Ken'}, table  => 'book',
1778
      where  => {id => 5});
1779
    
1780
    # Delete
1781
    $dbi->delete(table  => 'book', where => {author => 'Ken'});
1782

            
1783
    # Select
1784
    my $result = $dbi->select(table  => 'book',
1785
      column => ['title', 'author'], where  => {author => 'Ken'});
1786

            
1787
    # Select, more complex
1788
    my $result = $dbi->select(
1789
        table  => 'book',
1790
        column => [
1791
            {book => [qw/title author/]},
1792
            {company => ['name']}
1793
        ],
1794
        where  => {'book.author' => 'Ken'},
1795
        join => ['left outer join company on book.company_id = company.id'],
1796
        append => 'order by id limit 5'
1797
    );
1798
    
1799
    # Fetch
1800
    while (my $row = $result->fetch) {
1801
        
1802
    }
1803
    
1804
    # Fetch as hash
1805
    while (my $row = $result->fetch_hash) {
1806
        
1807
    }
1808
    
1809
    # Execute SQL with parameter.
1810
    $dbi->execute(
1811
        "select id from book where author = :author and title like :title",
1812
        {author => 'ken', title => '%Perl%'}
1813
    );
1814
    
1815
=head1 DESCRIPTIONS
1816

            
1817
L<DBIx::Custom> is L<DBI> wrapper module to execute SQL easily.
1818
This module have the following features.
1819

            
1820
=over 4
1821

            
1822
=item *
1823

            
1824
Execute C<insert>, C<update>, C<delete>, or C<select> statement easily
1825

            
1826
=item *
1827

            
1828
Create C<where> clause flexibly
1829

            
1830
=item *
1831

            
1832
Named place holder support
1833

            
1834
=item *
1835

            
1836
Model support
1837

            
1838
=item *
1839

            
1840
Connection manager support
1841

            
1842
=item *
1843

            
1844
Choice your favorite relational database management system,
1845
C<MySQL>, C<SQLite>, C<PostgreSQL>, C<Oracle>,
1846
C<Microsoft SQL Server>, C<Microsoft Access>, C<DB2> or anything, 
1847

            
1848
=item *
1849

            
1850
Filtering by data type or column name(EXPERIMENTAL)
1851

            
1852
=item *
1853

            
1854
Create C<order by> clause flexibly(EXPERIMENTAL)
1855

            
1856
=back
1857

            
1858
=head1 DOCUMENTATIONS
1859

            
1860
L<DBIx::Custom::Guide> - How to use L<DBIx::Custom>
1861

            
1862
L<DBIx::Custom Wiki|https://github.com/yuki-kimoto/DBIx-Custom/wiki>
1863
- Theare are various examples.
1864

            
1865
Module documentations - 
1866
L<DBIx::Custom::Result>,
1867
L<DBIx::Custom::Query>,
1868
L<DBIx::Custom::Where>,
1869
L<DBIx::Custom::Model>,
1870
L<DBIx::Custom::Order>
1871

            
1872
=head1 ATTRIBUTES
1873

            
1874
=head2 C<connector>
1875

            
1876
    my $connector = $dbi->connector;
1877
    $dbi = $dbi->connector($connector);
1878

            
1879
Connection manager object. if C<connector> is set, you can get C<dbh>
1880
through connection manager. Conection manager object must have C<dbh> mehtod.
1881

            
1882
This is L<DBIx::Connector> example. Please pass
1883
C<default_dbi_option> to L<DBIx::Connector> C<new> method.
1884

            
1885
    my $connector = DBIx::Connector->new(
1886
        "dbi:mysql:database=$DATABASE",
1887
        $USER,
1888
        $PASSWORD,
1889
        DBIx::Custom->new->default_dbi_option
1890
    );
1891
    
1892
    my $dbi = DBIx::Custom->connect(connector => $connector);
1893

            
1894
=head2 C<dsn>
1895

            
1896
    my $dsn = $dbi->dsn;
1897
    $dbi = $dbi->dsn("DBI:mysql:database=dbname");
1898

            
1899
Data source name, used when C<connect> method is executed.
1900

            
1901
=head2 C<dbi_option>
1902

            
1903
    my $dbi_option = $dbi->dbi_option;
1904
    $dbi = $dbi->dbi_option($dbi_option);
1905

            
1906
L<DBI> option, used when C<connect> method is executed.
1907
Each value in option override the value of C<default_dbi_option>.
1908

            
1909
=head2 C<default_dbi_option>
1910

            
1911
    my $default_dbi_option = $dbi->default_dbi_option;
1912
    $dbi = $dbi->default_dbi_option($default_dbi_option);
1913

            
1914
L<DBI> default option, used when C<connect> method is executed,
1915
default to the following values.
1916

            
1917
    {
1918
        RaiseError => 1,
1919
        PrintError => 0,
1920
        AutoCommit => 1,
1921
    }
1922

            
1923
=head2 C<filters>
1924

            
1925
    my $filters = $dbi->filters;
1926
    $dbi = $dbi->filters(\%filters);
1927

            
1928
Filters, registered by C<register_filter> method.
1929

            
1930
=head2 C<last_sql>
1931

            
1932
    my $last_sql = $dbi->last_sql;
1933
    $dbi = $dbi->last_sql($last_sql);
1934

            
1935
Get last successed SQL executed by C<execute> method.
1936

            
1937
=head2 C<models>
1938

            
1939
    my $models = $dbi->models;
1940
    $dbi = $dbi->models(\%models);
1941

            
1942
Models, included by C<include_model> method.
1943

            
1944
=head2 C<password>
1945

            
1946
    my $password = $dbi->password;
1947
    $dbi = $dbi->password('lkj&le`@s');
1948

            
1949
Password, used when C<connect> method is executed.
1950

            
1951
=head2 C<query_builder>
1952

            
1953
    my $sql_class = $dbi->query_builder;
1954
    $dbi = $dbi->query_builder(DBIx::Custom::QueryBuilder->new);
1955

            
1956
Query builder, default to L<DBIx::Custom::QueryBuilder> object.
1957

            
1958
=head2 C<quote>
1959

            
1960
     my quote = $dbi->quote;
1961
     $dbi = $dbi->quote('"');
1962

            
1963
Reserved word quote.
1964
Default to double quote '"' except for mysql.
1965
In mysql, default to back quote '`'
1966

            
1967
You can set quote pair.
1968

            
1969
    $dbi->quote('[]');
1970

            
1971
=head2 C<result_class>
1972

            
1973
    my $result_class = $dbi->result_class;
1974
    $dbi = $dbi->result_class('DBIx::Custom::Result');
1975

            
1976
Result class, default to L<DBIx::Custom::Result>.
1977

            
1978
=head2 C<safety_character>
1979

            
1980
    my $safety_character = $self->safety_character;
1981
    $dbi = $self->safety_character($character);
1982

            
1983
Regex of safety character for table and column name, default to '\w'.
1984
Note that you don't have to specify like '[\w]'.
1985

            
1986
=head2 C<tag_parse>
1987

            
1988
    my $tag_parse = $dbi->tag_parse(0);
1989
    $dbi = $dbi->tag_parse;
1990

            
1991
Enable DEPRECATED tag parsing functionality, default to 1.
1992
If you want to disable tag parsing functionality, set to 0.
1993

            
1994
=head2 C<user>
1995

            
1996
    my $user = $dbi->user;
1997
    $dbi = $dbi->user('Ken');
1998

            
1999
User name, used when C<connect> method is executed.
2000

            
2001
=head1 METHODS
2002

            
2003
L<DBIx::Custom> inherits all methods from L<Object::Simple>
2004
and use all methods of L<DBI>
2005
and implements the following new ones.
2006

            
2007
=head2 C<available_data_type> EXPERIMENTAL
2008

            
2009
    print $dbi->available_data_type;
2010

            
2011
Get available data types. You can use these data types
2012
in C<type rule>'s C<from1> and C<from2> section.
2013

            
2014
=head2 C<available_type_name> EXPERIMENTAL
2015

            
2016
    print $dbi->available_type_name;
2017

            
2018
Get available type names. You can use these type names in
2019
C<type_rule>'s C<into1> and C<into2> section.
2020

            
2021
=head2 C<assign_param> EXPERIMENTAL
2022

            
2023
    my $assign_param = $dbi->assign_param({title => 'a', age => 2});
2024

            
2025
Create assign parameter.
2026

            
2027
    title = :title, author = :author
2028

            
2029
This is equal to C<update_param> exept that set is not added.
2030

            
2031
=head2 C<column>
2032

            
2033
    my $column = $dbi->column(book => ['author', 'title']);
2034

            
2035
Create column clause. The follwoing column clause is created.
2036

            
2037
    book.author as "book.author",
2038
    book.title as "book.title"
2039

            
2040
You can change separator by C<separator> method.
2041

            
2042
    # Separator is double underbar
2043
    $dbi->separator('__');
2044
    
2045
    book.author as "book__author",
2046
    book.title as "book__title"
2047

            
2048
    # Separator is hyphen
2049
    $dbi->separator('-');
2050
    
2051
    book.author as "book-author",
2052
    book.title as "book-title"
2053
    
2054
=head2 C<connect>
2055

            
2056
    my $dbi = DBIx::Custom->connect(
2057
        dsn => "dbi:mysql:database=dbname",
2058
        user => 'ken',
2059
        password => '!LFKD%$&',
2060
        dbi_option => {mysql_enable_utf8 => 1}
2061
    );
2062

            
2063
Connect to the database and create a new L<DBIx::Custom> object.
2064

            
2065
L<DBIx::Custom> is a wrapper of L<DBI>.
2066
C<AutoCommit> and C<RaiseError> options are true, 
2067
and C<PrintError> option is false by default.
2068

            
2069
=head2 create_model
2070

            
2071
    my $model = $dbi->create_model(
2072
        table => 'book',
2073
        primary_key => 'id',
2074
        join => [
2075
            'inner join company on book.comparny_id = company.id'
2076
        ],
2077
    );
2078

            
2079
Create L<DBIx::Custom::Model> object and initialize model.
2080
the module is also used from C<model> method.
2081

            
2082
   $dbi->model('book')->select(...);
2083

            
2084
=head2 C<dbh>
2085

            
2086
    my $dbh = $dbi->dbh;
2087

            
2088
Get L<DBI> database handle. if C<connector> is set, you can get
2089
database handle through C<connector> object.
2090

            
2091
=head2 C<each_column>
2092

            
2093
    $dbi->each_column(
2094
        sub {
2095
            my ($dbi, $table, $column, $column_info) = @_;
2096
            
2097
            my $type = $column_info->{TYPE_NAME};
2098
            
2099
            if ($type eq 'DATE') {
2100
                # ...
2101
            }
2102
        }
2103
    );
2104

            
2105
Iterate all column informations of all table from database.
2106
Argument is callback when one column is found.
2107
Callback receive four arguments, dbi object, table name,
2108
column name and column information.
2109

            
2110
=head2 C<each_table>
2111

            
2112
    $dbi->each_table(
2113
        sub {
2114
            my ($dbi, $table, $table_info) = @_;
2115
            
2116
            my $table_name = $table_info->{TABLE_NAME};
2117
        }
2118
    );
2119

            
2120
Iterate all table informationsfrom database.
2121
Argument is callback when one table is found.
2122
Callback receive three arguments, dbi object, table name,
2123
table information.
2124

            
2125
=head2 C<execute>
2126

            
2127
    my $result = $dbi->execute(
2128
      "select * from book where title = :title and author like :author",
2129
      {title => 'Perl', author => '%Ken%'}
2130
    );
2131

            
2132
    my $result = $dbi->execute(
2133
      "select * from book where title = :book.title and author like :book.author",
2134
      {'book.title' => 'Perl', 'book.author' => '%Ken%'}
2135
    );
2136

            
2137
Execute SQL. SQL can contain column parameter such as :author and :title.
2138
You can append table name to column name such as :book.title and :book.author.
2139
Second argunet is data, embedded into column parameter.
2140
Return value is L<DBIx::Custom::Result> object when select statement is executed,
2141
or the count of affected rows when insert, update, delete statement is executed.
2142

            
2143
Named placeholder such as C<:title> is replaced by placeholder C<?>.
2144
    
2145
    # Original
2146
    select * from book where title = :title and author like :author
2147
    
2148
    # Replaced
2149
    select * from where title = ? and author like ?;
2150

            
2151
You can specify operator with named placeholder
2152
 by C<name{operator}> syntax.
2153

            
2154
    # Original
2155
    select * from book where :title{=} and :author{like}
2156
    
2157
    # Replaced
2158
    select * from where title = ? and author like ?;
2159

            
2160
Note that colons in time format such as 12:13:15 is exeption,
2161
it is not parsed as named placeholder.
2162
If you want to use colon generally, you must escape it by C<\\>
2163

            
2164
    select * from where title = "aa\\:bb";
2165

            
2166
The following opitons are available.
2167

            
2168
=over 4
2169

            
2170
=item C<filter>
2171
    
2172
    filter => {
2173
        title  => sub { uc $_[0] }
2174
        author => sub { uc $_[0] }
2175
    }
2176

            
2177
    # Filter name
2178
    filter => {
2179
        title  => 'upper_case',
2180
        author => 'upper_case'
2181
    }
2182
        
2183
    # At once
2184
    filter => [
2185
        [qw/title author/]  => sub { uc $_[0] }
2186
    ]
2187

            
2188
Filter. You can set subroutine or filter name
2189
registered by by C<register_filter>.
2190
This filter is executed before data is saved into database.
2191
and before type rule filter is executed.
2192

            
2193
=item C<query>
2194

            
2195
    query => 1
2196

            
2197
C<execute> method return L<DBIx::Custom::Query> object, not executing SQL.
2198
You can check SQL or get statment handle.
2199

            
2200
    my $sql = $query->sql;
2201
    my $sth = $query->sth;
2202
    my $columns = $query->columns;
2203
    
2204
If you want to execute SQL fast, you can do the following way.
2205

            
2206
    my $query;
2207
    foreach my $row (@$rows) {
2208
      $query ||= $dbi->insert($row, table => 'table1', query => 1);
2209
      $dbi->execute($query, $row, filter => {ab => sub { $_[0] * 2 }});
2210
    }
2211

            
2212
Statement handle is reused and SQL parsing is finished,
2213
so you can get more performance than normal way.
2214

            
2215
If you want to execute SQL as possible as fast and don't need filtering.
2216
You can do the following way.
2217
    
2218
    my $query;
2219
    my $sth;
2220
    foreach my $row (@$rows) {
2221
      $query ||= $dbi->insert($row, table => 'book', query => 1);
2222
      $sth ||= $query->sth;
2223
      $sth->execute(map { $row->{$_} } sort keys %$row);
2224
    }
2225

            
2226
Note that $row must be simple hash reference, such as
2227
{title => 'Perl', author => 'Ken'}.
2228
and don't forget to sort $row values by $row key asc order.
2229

            
2230
=item C<table>
2231
    
2232
    table => 'author'
2233

            
2234
If you want to omit table name in column name
2235
and enable C<into1> and C<into2> type filter,
2236
You must set C<table> option.
2237

            
2238
    $dbi->execute("select * from book where title = :title and author = :author",
2239
        {title => 'Perl', author => 'Ken', table => 'book');
2240

            
2241
    # Same
2242
    $dbi->execute(
2243
      "select * from book where title = :book.title and author = :book.author",
2244
      {title => 'Perl', author => 'Ken');
2245

            
2246
=item C<bind_type>
2247

            
2248
Specify database bind data type.
2249

            
2250
    bind_type => [image => DBI::SQL_BLOB]
2251
    bind_type => [[qw/image audio/] => DBI::SQL_BLOB]
2252

            
2253
This is used to bind parameter by C<bind_param> of statment handle.
2254

            
2255
    $sth->bind_param($pos, $value, DBI::SQL_BLOB);
2256

            
2257
=item C<table_alias> EXPERIMENTAL
2258

            
2259
    table_alias => {user => 'hiker'}
2260

            
2261
Table alias. Key is real table name, value is alias table name.
2262
If you set C<table_alias>, you can enable C<into1> and C<into2> type rule
2263
on alias table name.
2264

            
2265
=item C<type_rule_off> EXPERIMENTAL
2266

            
2267
    type_rule_off => 1
2268

            
2269
Turn C<into1> and C<into2> type rule off.
2270

            
2271
=item C<type_rule1_off> EXPERIMENTAL
2272

            
2273
    type_rule1_off => 1
2274

            
2275
Turn C<into1> type rule off.
2276

            
2277
=item C<type_rule2_off> EXPERIMENTAL
2278

            
2279
    type_rule2_off => 1
2280

            
2281
Turn C<into2> type rule off.
2282

            
2283
=back
2284

            
2285
=head2 C<delete>
2286

            
2287
    $dbi->delete(table => 'book', where => {title => 'Perl'});
2288

            
2289
Execute delete statement.
2290

            
2291
The following opitons are available.
2292

            
2293
=over 4
2294

            
2295
=item C<append>
2296

            
2297
Same as C<select> method's C<append> option.
2298

            
2299
=item C<filter>
2300

            
2301
Same as C<execute> method's C<filter> option.
2302

            
2303
=item C<id>
2304

            
2305
    id => 4
2306
    id => [4, 5]
2307

            
2308
ID corresponding to C<primary_key>.
2309
You can delete rows by C<id> and C<primary_key>.
2310

            
2311
    $dbi->delete(
2312
        parimary_key => ['id1', 'id2'],
2313
        id => [4, 5],
2314
        table => 'book',
2315
    );
2316

            
2317
The above is same as the followin one.
2318

            
2319
    $dbi->delete(where => {id1 => 4, id2 => 5}, table => 'book');
2320

            
2321
=item C<prefix>
2322

            
2323
    prefix => 'some'
2324

            
2325
prefix before table name section.
2326

            
2327
    delete some from book
2328

            
2329
=item C<query>
2330

            
2331
Same as C<execute> method's C<query> option.
2332

            
2333
=item C<table>
2334

            
2335
    table => 'book'
2336

            
2337
Table name.
2338

            
2339
=item C<where>
2340

            
2341
Same as C<select> method's C<where> option.
2342

            
2343
=item C<primary_key>
2344

            
2345
See C<id> option.
2346

            
2347
=item C<bind_type>
2348

            
2349
Same as C<execute> method's C<bind_type> option.
2350

            
2351
=item C<type_rule_off> EXPERIMENTAL
2352

            
2353
Same as C<execute> method's C<type_rule_off> option.
2354

            
2355
=item C<type_rule1_off> EXPERIMENTAL
2356

            
2357
    type_rule1_off => 1
2358

            
2359
Same as C<execute> method's C<type_rule1_off> option.
2360

            
2361
=item C<type_rule2_off> EXPERIMENTAL
2362

            
2363
    type_rule2_off => 1
2364

            
2365
Same as C<execute> method's C<type_rule2_off> option.
2366

            
2367
=back
2368

            
2369
=head2 C<delete_all>
2370

            
2371
    $dbi->delete_all(table => $table);
2372

            
2373
Execute delete statement for all rows.
2374
Options is same as C<delete>.
2375

            
2376
=head2 C<insert>
2377

            
2378
    $dbi->insert({title => 'Perl', author => 'Ken'}, table  => 'book');
2379

            
2380
Execute insert statement. First argument is row data. Return value is
2381
affected row count.
2382

            
2383
If you want to set constant value to row data, use scalar reference
2384
as parameter value.
2385

            
2386
    {date => \"NOW()"}
2387

            
2388
The following opitons are available.
2389

            
2390
=over 4
2391

            
2392
=item C<append>
2393

            
2394
Same as C<select> method's C<append> option.
2395

            
2396
=item C<filter>
2397

            
2398
Same as C<execute> method's C<filter> option.
2399

            
2400
=item C<id>
2401

            
2402
    id => 4
2403
    id => [4, 5]
2404

            
2405
ID corresponding to C<primary_key>.
2406
You can insert a row by C<id> and C<primary_key>.
2407

            
2408
    $dbi->insert(
2409
        {title => 'Perl', author => 'Ken'}
2410
        parimary_key => ['id1', 'id2'],
2411
        id => [4, 5],
2412
        table => 'book'
2413
    );
2414

            
2415
The above is same as the followin one.
2416

            
2417
    $dbi->insert(
2418
        {id1 => 4, id2 => 5, title => 'Perl', author => 'Ken'},
2419
        table => 'book'
2420
    );
2421

            
2422
=item C<prefix>
2423

            
2424
    prefix => 'or replace'
2425

            
2426
prefix before table name section
2427

            
2428
    insert or replace into book
2429

            
2430
=item C<primary_key>
2431

            
2432
    primary_key => 'id'
2433
    primary_key => ['id1', 'id2']
2434

            
2435
Primary key. This is used by C<id> option.
2436

            
2437
=item C<query>
2438

            
2439
Same as C<execute> method's C<query> option.
2440

            
2441
=item C<table>
2442

            
2443
    table => 'book'
2444

            
2445
Table name.
2446

            
2447
=item C<bind_type>
2448

            
2449
Same as C<execute> method's C<bind_type> option.
2450

            
2451
=item C<type_rule_off> EXPERIMENTAL
2452

            
2453
Same as C<execute> method's C<type_rule_off> option.
2454

            
2455
=item C<type_rule1_off> EXPERIMENTAL
2456

            
2457
    type_rule1_off => 1
2458

            
2459
Same as C<execute> method's C<type_rule1_off> option.
2460

            
2461
=item C<type_rule2_off> EXPERIMENTAL
2462

            
2463
    type_rule2_off => 1
2464

            
2465
Same as C<execute> method's C<type_rule2_off> option.
2466

            
2467
=back
2468

            
2469
=over 4
2470

            
2471
=head2 C<insert_param>
2472

            
2473
    my $insert_param = $dbi->insert_param({title => 'a', age => 2});
2474

            
2475
Create insert parameters.
2476

            
2477
    (title, author) values (title = :title, age = :age);
2478

            
2479
=head2 C<include_model>
2480

            
2481
    $dbi->include_model('MyModel');
2482

            
2483
Include models from specified namespace,
2484
the following layout is needed to include models.
2485

            
2486
    lib / MyModel.pm
2487
        / MyModel / book.pm
2488
                  / company.pm
2489

            
2490
Name space module, extending L<DBIx::Custom::Model>.
2491

            
2492
B<MyModel.pm>
2493

            
2494
    package MyModel;
2495
    use DBIx::Custom::Model -base;
2496
    
2497
    1;
2498

            
2499
Model modules, extending name space module.
2500

            
2501
B<MyModel/book.pm>
2502

            
2503
    package MyModel::book;
2504
    use MyModel -base;
2505
    
2506
    1;
2507

            
2508
B<MyModel/company.pm>
2509

            
2510
    package MyModel::company;
2511
    use MyModel -base;
2512
    
2513
    1;
2514
    
2515
MyModel::book and MyModel::company is included by C<include_model>.
2516

            
2517
You can get model object by C<model>.
2518

            
2519
    my $book_model = $dbi->model('book');
2520
    my $company_model = $dbi->model('company');
2521

            
2522
See L<DBIx::Custom::Model> to know model features.
2523

            
2524
=head2 C<map_param> EXPERIMENTAL
2525

            
2526
    my $map_param = $dbi->map_param(
2527
        {id => 1, authro => 'Ken', price => 1900},
2528
        'id' => 'book.id',
2529
        'author' => ['book.author' => sub { '%' . $_[0] . '%' }],
2530
        'price' => [
2531
            'book.price', {if => sub { length $_[0] }}
2532
        ]
2533
    );
2534

            
2535
Map paramters to other key and value. First argument is original
2536
parameter. this is hash reference. Rest argument is mapping.
2537
By default, Mapping is done if the value length is not zero.
2538

            
2539
=over 4
2540

            
2541
=item Key mapping
2542

            
2543
    'id' => 'book.id'
2544

            
2545
This is only key mapping. Value is same as original one.
2546

            
2547
    (id => 1) is mapped to ('book.id' => 1) if value length is not zero.
2548

            
2549
=item Key and value mapping
2550

            
2551
    'author' => ['book.author' => sub { '%' . $_[0] . '%' }]
2552

            
2553
This is key and value mapping. Frist element of array reference
2554
is mapped key name, second element is code reference to map the value.
2555

            
2556
    (author => 'Ken') is mapped to ('book.author' => '%Ken%')
2557
      if value length is not zero.
2558

            
2559
=item Condition
2560

            
2561
    'price' => ['book.price', {if => 'exists'}]
2562
    'price' => ['book.price', sub { '%' . $_[0] . '%' }, {if => 'exists'}]
2563
    'price' => ['book.price', {if => sub { defined shift }}]
2564

            
2565
If you need condition, you can sepecify it. this is code reference
2566
or 'exists'. By default, condition is the following one.
2567

            
2568
    sub { defined $_[0] && length $_[0] }
2569

            
2570
=back
2571

            
2572
=head2 C<merge_param>
2573

            
2574
    my $param = $dbi->merge_param({key1 => 1}, {key1 => 1, key2 => 2});
2575

            
2576
Merge parameters.
2577

            
2578
    {key1 => [1, 1], key2 => 2}
2579

            
2580
=head2 C<method>
2581

            
2582
    $dbi->method(
2583
        update_or_insert => sub {
2584
            my $self = shift;
2585
            
2586
            # Process
2587
        },
2588
        find_or_create   => sub {
2589
            my $self = shift;
2590
            
2591
            # Process
2592
        }
2593
    );
2594

            
2595
Register method. These method is called directly from L<DBIx::Custom> object.
2596

            
2597
    $dbi->update_or_insert;
2598
    $dbi->find_or_create;
2599

            
2600
=head2 C<model>
2601

            
2602
    my $model = $dbi->model('book');
2603

            
2604
Get a L<DBIx::Custom::Model> object,
2605

            
2606
=head2 C<mycolumn>
2607

            
2608
    my $column = $self->mycolumn(book => ['author', 'title']);
2609

            
2610
Create column clause for myself. The follwoing column clause is created.
2611

            
2612
    book.author as author,
2613
    book.title as title
2614

            
2615
=head2 C<new>
2616

            
2617
    my $dbi = DBIx::Custom->new(
2618
        dsn => "dbi:mysql:database=dbname",
2619
        user => 'ken',
2620
        password => '!LFKD%$&',
2621
        dbi_option => {mysql_enable_utf8 => 1}
2622
    );
2623

            
2624
Create a new L<DBIx::Custom> object.
2625

            
2626
=head2 C<not_exists>
2627

            
2628
    my $not_exists = $dbi->not_exists;
2629

            
2630
DBIx::Custom::NotExists object, indicating the column is not exists.
2631
This is used by C<clause> of L<DBIx::Custom::Where> .
2632

            
2633
=head2 C<order> EXPERIMENTAL
2634

            
2635
    my $order = $dbi->order;
2636

            
2637
Create a new L<DBIx::Custom::Order> object.
2638

            
2639
=head2 C<register_filter>
2640

            
2641
    $dbi->register_filter(
2642
        # Time::Piece object to database DATE format
2643
        tp_to_date => sub {
2644
            my $tp = shift;
2645
            return $tp->strftime('%Y-%m-%d');
2646
        },
2647
        # database DATE format to Time::Piece object
2648
        date_to_tp => sub {
2649
           my $date = shift;
2650
           return Time::Piece->strptime($date, '%Y-%m-%d');
2651
        }
2652
    );
2653
    
2654
Register filters, used by C<filter> option of many methods.
2655

            
2656
=head2 C<type_rule> EXPERIMENTAL
2657

            
2658
    $dbi->type_rule(
2659
        into1 => {
2660
            date => sub { ... },
2661
            datetime => sub { ... }
2662
        },
2663
        into2 => {
2664
            date => sub { ... },
2665
            datetime => sub { ... }
2666
        },
2667
        from1 => {
2668
            # DATE
2669
            9 => sub { ... },
2670
            # DATETIME or TIMESTAMP
2671
            11 => sub { ... },
2672
        }
2673
        from2 => {
2674
            # DATE
2675
            9 => sub { ... },
2676
            # DATETIME or TIMESTAMP
2677
            11 => sub { ... },
2678
        }
2679
    );
2680

            
2681
Filtering rule when data is send into and get from database.
2682
This has a little complex problem.
2683

            
2684
In C<into1> and C<into2> you can specify
2685
type name as same as type name defined
2686
by create table, such as C<DATETIME> or C<DATE>.
2687

            
2688
Note that type name and data type don't contain upper case.
2689
If these contain upper case charactor, you convert it to lower case.
2690

            
2691
C<into2> is executed after C<into1>.
2692

            
2693
Type rule of C<into1> and C<into2> is enabled on the following
2694
column name.
2695

            
2696
=over 4
2697

            
2698
=item 1. column name
2699

            
2700
    issue_date
2701
    issue_datetime
2702

            
2703
This need C<table> option in each method.
2704

            
2705
=item 2. table name and column name, separator is dot
2706

            
2707
    book.issue_date
2708
    book.issue_datetime
2709

            
2710
=back
2711

            
2712
You get all type name used in database by C<available_type_name>.
2713

            
2714
    print $dbi->available_type_name;
2715

            
2716
In C<from1> and C<from2> you specify data type, not type name.
2717
C<from2> is executed after C<from1>.
2718
You get all data type by C<available_data_type>.
2719

            
2720
    print $dbi->available_data_type;
2721

            
2722
You can also specify multiple types at once.
2723

            
2724
    $dbi->type_rule(
2725
        into1 => [
2726
            [qw/DATE DATETIME/] => sub { ... },
2727
        ],
2728
    );
2729

            
2730
=head2 C<select>
2731

            
2732
    my $result = $dbi->select(
2733
        table  => 'book',
2734
        column => ['author', 'title'],
2735
        where  => {author => 'Ken'},
2736
    );
2737
    
2738
Execute select statement.
2739

            
2740
The following opitons are available.
2741

            
2742
=over 4
2743

            
2744
=item C<append>
2745

            
2746
    append => 'order by title'
2747

            
2748
Append statement to last of SQL.
2749
    
2750
=item C<column>
2751
    
2752
    column => 'author'
2753
    column => ['author', 'title']
2754

            
2755
Column clause.
2756
    
2757
if C<column> is not specified, '*' is set.
2758

            
2759
    column => '*'
2760

            
2761
You can specify hash of array reference.
2762

            
2763
    column => [
2764
        {book => [qw/author title/]},
2765
        {person => [qw/name age/]}
2766
    ]
2767

            
2768
This is expanded to the following one by using C<colomn> method.
2769

            
2770
    book.author as "book.author",
2771
    book.title as "book.title",
2772
    person.name as "person.name",
2773
    person.age as "person.age"
2774

            
2775
You can specify array of array reference, first argument is
2776
column name, second argument is alias.
2777

            
2778
    column => [
2779
        ['date(book.register_datetime)' => 'book.register_date']
2780
    ];
2781

            
2782
Alias is quoted properly and joined.
2783

            
2784
    date(book.register_datetime) as "book.register_date"
2785

            
2786
=item C<filter>
2787

            
2788
Same as C<execute> method's C<filter> option.
2789

            
2790
=item C<id>
2791

            
2792
    id => 4
2793
    id => [4, 5]
2794

            
2795
ID corresponding to C<primary_key>.
2796
You can select rows by C<id> and C<primary_key>.
2797

            
2798
    $dbi->select(
2799
        parimary_key => ['id1', 'id2'],
2800
        id => [4, 5],
2801
        table => 'book'
2802
    );
2803

            
2804
The above is same as the followin one.
2805

            
2806
    $dbi->select(
2807
        where => {id1 => 4, id2 => 5},
2808
        table => 'book'
2809
    );
2810
    
2811
=item C<param> EXPERIMETNAL
2812

            
2813
    param => {'table2.key3' => 5}
2814

            
2815
Parameter shown before where clause.
2816
    
2817
For example, if you want to contain tag in join clause, 
2818
you can pass parameter by C<param> option.
2819

            
2820
    join  => ['inner join (select * from table2 where table2.key3 = :table2.key3)' . 
2821
              ' as table2 on table1.key1 = table2.key1']
2822

            
2823
=itme C<prefix>
2824

            
2825
    prefix => 'SQL_CALC_FOUND_ROWS'
2826

            
2827
Prefix of column cluase
2828

            
2829
    select SQL_CALC_FOUND_ROWS title, author from book;
2830

            
2831
=item C<join>
2832

            
2833
    join => [
2834
        'left outer join company on book.company_id = company_id',
2835
        'left outer join location on company.location_id = location.id'
2836
    ]
2837
        
2838
Join clause. If column cluase or where clause contain table name like "company.name",
2839
join clausees needed when SQL is created is used automatically.
2840

            
2841
    $dbi->select(
2842
        table => 'book',
2843
        column => ['company.location_id as location_id'],
2844
        where => {'company.name' => 'Orange'},
2845
        join => [
2846
            'left outer join company on book.company_id = company.id',
2847
            'left outer join location on company.location_id = location.id'
2848
        ]
2849
    );
2850

            
2851
In above select, column and where clause contain "company" table,
2852
the following SQL is created
2853

            
2854
    select company.location_id as location_id
2855
    from book
2856
      left outer join company on book.company_id = company.id
2857
    where company.name = ?;
2858

            
2859
You can specify two table by yourself. This is useful when join parser can't parse
2860
the join clause correctly. This is EXPERIMENTAL.
2861

            
2862
    $dbi->select(
2863
        table => 'book',
2864
        column => ['company.location_id as location_id'],
2865
        where => {'company.name' => 'Orange'},
2866
        join => [
2867
            {
2868
                clause => 'left outer join location on company.location_id = location.id',
2869
                table => ['company', 'location']
2870
            }
2871
        ]
2872
    );
2873

            
2874
=item C<primary_key>
2875

            
2876
    primary_key => 'id'
2877
    primary_key => ['id1', 'id2']
2878

            
2879
Primary key. This is used by C<id> option.
2880

            
2881
=item C<query>
2882

            
2883
Same as C<execute> method's C<query> option.
2884

            
2885
=item C<bind_type>
2886

            
2887
Same as C<execute> method's C<bind_type> option.
2888

            
2889
=item C<table>
2890

            
2891
    table => 'book'
2892

            
2893
Table name.
2894

            
2895
=item C<type_rule_off> EXPERIMENTAL
2896

            
2897
Same as C<execute> method's C<type_rule_off> option.
2898

            
2899
=item C<type_rule1_off> EXPERIMENTAL
2900

            
2901
    type_rule1_off => 1
2902

            
2903
Same as C<execute> method's C<type_rule1_off> option.
2904

            
2905
=item C<type_rule2_off> EXPERIMENTAL
2906

            
2907
    type_rule2_off => 1
2908

            
2909
Same as C<execute> method's C<type_rule2_off> option.
2910

            
2911
=item C<where>
2912
    
2913
    # Hash refrence
2914
    where => {author => 'Ken', 'title' => 'Perl'}
2915
    
2916
    # DBIx::Custom::Where object
2917
    where => $dbi->where(
2918
        clause => ['and', 'author = :author', 'title like :title'],
2919
        param  => {author => 'Ken', title => '%Perl%'}
2920
    );
2921
    
2922
    # Array reference 1 (array reference, hash referenc). same as above
2923
    where => [
2924
        ['and', 'author = :author', 'title like :title'],
2925
        {author => 'Ken', title => '%Perl%'}
2926
    ];    
2927
    
2928
    # Array reference 2 (String, hash reference)
2929
    where => [
2930
        'title like :title',
2931
        {title => '%Perl%'}
2932
    ]
2933
    
2934
    # String
2935
    where => 'title is null'
2936

            
2937
Where clause.
2938
    
2939
=item C<wrap> EXPERIMENTAL
2940

            
2941
Wrap statement. This is array reference.
2942

            
2943
    $dbi->select(wrap => ['select * from (', ') as t where ROWNUM < 10']);
2944

            
2945
This option is for Oracle and SQL Server paging process.
2946

            
2947
=back
2948

            
2949
=head2 C<update>
2950

            
2951
    $dbi->update({title => 'Perl'}, table  => 'book', where  => {id => 4});
2952

            
2953
Execute update statement. First argument is update row data.
2954

            
2955
If you want to set constant value to row data, use scalar reference
2956
as parameter value.
2957

            
2958
    {date => \"NOW()"}
2959

            
2960
The following opitons are available.
2961

            
2962
=over 4
2963

            
2964
=item C<append>
2965

            
2966
Same as C<select> method's C<append> option.
2967

            
2968
=item C<filter>
2969

            
2970
Same as C<execute> method's C<filter> option.
2971

            
2972
=item C<id>
2973

            
2974
    id => 4
2975
    id => [4, 5]
2976

            
2977
ID corresponding to C<primary_key>.
2978
You can update rows by C<id> and C<primary_key>.
2979

            
2980
    $dbi->update(
2981
        {title => 'Perl', author => 'Ken'}
2982
        parimary_key => ['id1', 'id2'],
2983
        id => [4, 5],
2984
        table => 'book'
2985
    );
2986

            
2987
The above is same as the followin one.
2988

            
2989
    $dbi->update(
2990
        {title => 'Perl', author => 'Ken'}
2991
        where => {id1 => 4, id2 => 5},
2992
        table => 'book'
2993
    );
2994

            
2995
=item C<prefix>
2996

            
2997
    prefix => 'or replace'
2998

            
2999
prefix before table name section
3000

            
3001
    update or replace book
3002

            
3003
=item C<primary_key>
3004

            
3005
    primary_key => 'id'
3006
    primary_key => ['id1', 'id2']
3007

            
3008
Primary key. This is used by C<id> option.
3009

            
3010
=item C<query>
3011

            
3012
Same as C<execute> method's C<query> option.
3013

            
3014
=item C<table>
3015

            
3016
    table => 'book'
3017

            
3018
Table name.
3019

            
3020
=item C<where>
3021

            
3022
Same as C<select> method's C<where> option.
3023

            
3024
=item C<bind_type>
3025

            
3026
Same as C<execute> method's C<bind_type> option.
3027

            
3028
=item C<type_rule_off> EXPERIMENTAL
3029

            
3030
Same as C<execute> method's C<type_rule_off> option.
3031

            
3032
=item C<type_rule1_off> EXPERIMENTAL
3033

            
3034
    type_rule1_off => 1
3035

            
3036
Same as C<execute> method's C<type_rule1_off> option.
3037

            
3038
=item C<type_rule2_off> EXPERIMENTAL
3039

            
3040
    type_rule2_off => 1
3041

            
3042
Same as C<execute> method's C<type_rule2_off> option.
3043

            
3044
=back
3045

            
3046
=head2 C<update_all>
3047

            
3048
    $dbi->update_all({title => 'Perl'}, table => 'book', );
3049

            
3050
Execute update statement for all rows.
3051
Options is same as C<update> method.
3052

            
3053
=head2 C<update_param>
3054

            
3055
    my $update_param = $dbi->update_param({title => 'a', age => 2});
3056

            
3057
Create update parameter tag.
3058

            
3059
    set title = :title, author = :author
3060

            
3061
=head2 C<where>
3062

            
3063
    my $where = $dbi->where(
3064
        clause => ['and', 'title = :title', 'author = :author'],
3065
        param => {title => 'Perl', author => 'Ken'}
3066
    );
3067

            
3068
Create a new L<DBIx::Custom::Where> object.
3069

            
3070
=head2 C<setup_model>
3071

            
3072
    $dbi->setup_model;
3073

            
3074
Setup all model objects.
3075
C<columns> of model object is automatically set, parsing database information.
3076

            
3077
=head1 ENVIRONMENT VARIABLE
3078

            
3079
=head2 C<DBIX_CUSTOM_DEBUG>
3080

            
3081
If environment variable C<DBIX_CUSTOM_DEBUG> is set to true,
3082
executed SQL and bind values are printed to STDERR.
3083

            
3084
=head2 C<DBIX_CUSTOM_DEBUG_ENCODING>
3085

            
3086
DEBUG output encoding. Default to UTF-8.
3087

            
3088
=head1 DEPRECATED FUNCTIONALITIES
3089

            
3090
L<DBIx::Custom>
3091

            
3092
    # Attribute methods
3093
    data_source # will be removed at 2017/1/1
3094
    dbi_options # will be removed at 2017/1/1
3095
    filter_check # will be removed at 2017/1/1
3096
    reserved_word_quote # will be removed at 2017/1/1
3097
    cache_method # will be removed at 2017/1/1
3098
    
3099
    # Methods
3100
    create_query # will be removed at 2017/1/1
3101
    apply_filter # will be removed at 2017/1/1
3102
    select_at # will be removed at 2017/1/1
3103
    delete_at # will be removed at 2017/1/1
3104
    update_at # will be removed at 2017/1/1
3105
    insert_at # will be removed at 2017/1/1
3106
    register_tag # will be removed at 2017/1/1
3107
    default_bind_filter # will be removed at 2017/1/1
3108
    default_fetch_filter # will be removed at 2017/1/1
3109
    insert_param_tag # will be removed at 2017/1/1
3110
    register_tag_processor # will be removed at 2017/1/1
3111
    update_param_tag # will be removed at 2017/1/1
3112
    
3113
    # Options
3114
    select method relation option # will be removed at 2017/1/1
3115
    select method param option # will be removed at 2017/1/1
3116
    select method column option [COLUMN, as => ALIAS] format
3117
      # will be removed at 2017/1/1
3118
    
3119
    # Others
3120
    execute("select * from {= title}"); # execute method's
3121
                                        # tag parsing functionality
3122
                                        # will be removed at 2017/1/1
3123
    Query caching # will be removed at 2017/1/1
3124

            
3125
L<DBIx::Custom::Model>
3126

            
3127
    # Attribute methods
3128
    filter # will be removed at 2017/1/1
3129
    name # will be removed at 2017/1/1
3130
    type # will be removed at 2017/1/1
3131

            
3132
L<DBIx::Custom::Query>
3133
    
3134
    # Attribute methods
3135
    default_filter # will be removed at 2017/1/1
3136
    table # will be removed at 2017/1/1
3137
    filters # will be removed at 2017/1/1
3138
    
3139
    # Methods
3140
    filter # will be removed at 2017/1/1
3141

            
3142
L<DBIx::Custom::QueryBuilder>
3143
    
3144
    # Attribute methods
3145
    tags # will be removed at 2017/1/1
3146
    tag_processors # will be removed at 2017/1/1
3147
    
3148
    # Methods
3149
    register_tag # will be removed at 2017/1/1
3150
    register_tag_processor # will be removed at 2017/1/1
3151
    
3152
    # Others
3153
    build_query("select * from {= title}"); # tag parsing functionality
3154
                                            # will be removed at 2017/1/1
3155

            
3156
L<DBIx::Custom::Result>
3157
    
3158
    # Attribute methods
3159
    filter_check # will be removed at 2017/1/1
3160
    
3161
    # Methods
3162
    end_filter # will be removed at 2017/1/1
3163
    remove_end_filter # will be removed at 2017/1/1
3164
    remove_filter # will be removed at 2017/1/1
3165
    default_filter # will be removed at 2017/1/1
3166

            
3167
L<DBIx::Custom::Tag>
3168

            
3169
    This module is DEPRECATED! # will be removed at 2017/1/1
3170

            
3171
=head1 BACKWORD COMPATIBLE POLICY
3172

            
3173
If a functionality is DEPRECATED, you can know it by DEPRECATED warnings
3174
except for attribute method.
3175
You can check all DEPRECATED functionalities by document.
3176
DEPRECATED functionality is removed after five years,
3177
but if at least one person use the functionality and tell me that thing
3178
I extend one year each time he tell me it.
3179

            
3180
EXPERIMENTAL functionality will be changed without warnings.
3181

            
3182
This policy was changed at 2011/6/28
3183

            
3184
=head1 BUGS
3185

            
3186
Please tell me bugs if found.
3187

            
3188
C<< <kimoto.yuki at gmail.com> >>
3189

            
3190
L<http://github.com/yuki-kimoto/DBIx-Custom>
3191

            
3192
=head1 AUTHOR
3193

            
3194
Yuki Kimoto, C<< <kimoto.yuki at gmail.com> >>
3195

            
3196
=head1 COPYRIGHT & LICENSE
3197

            
3198
Copyright 2009-2011 Yuki Kimoto, all rights reserved.
3199

            
3200
This program is free software; you can redistribute it and/or modify it
3201
under the same terms as Perl itself.
3202

            
3203
=cut