DBIx-Custom / lib / DBIx / Custom.pm /
Newer Older
1334 lines | 33.01kb
packaging one directory
yuki-kimoto authored on 2009-11-16
1
use 5.008001;
2

            
3
package DBIx::Custom;
4
use Object::Simple;
5

            
cleanup and update docment
yuki-kimoto authored on 2009-11-19
6
our $VERSION = '0.0602';
packaging one directory
yuki-kimoto authored on 2009-11-16
7

            
8
use Carp 'croak';
9
use DBI;
10
use DBIx::Custom::Result;
11
use DBIx::Custom::SQL::Template;
12

            
13

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
14
### Accessors
packaging one directory
yuki-kimoto authored on 2009-11-16
15
sub user        : ClassObjectAttr { initialize => {clone => 'scalar'} }
16
sub password    : ClassObjectAttr { initialize => {clone => 'scalar'} }
17
sub data_source : ClassObjectAttr { initialize => {clone => 'scalar'} }
18
sub dbi_options : ClassObjectAttr { initialize => {clone => 'hash', 
19
                                                   default => sub { {} } } }
20
sub database    : ClassObjectAttr { initialize => {clone => 'scalar'} }
add port and host method
yuki-kimoto authored on 2009-11-16
21
sub host        : ClassObjectAttr { initialize => {clone => 'scalar'} }
22
sub port        : ClassObjectAttr { initialize => {clone => 'scalar'} }
packaging one directory
yuki-kimoto authored on 2009-11-16
23

            
24
sub bind_filter  : ClassObjectAttr { initialize => {clone => 'scalar'} }
25
sub fetch_filter : ClassObjectAttr { initialize => {clone => 'scalar'} }
26

            
27
sub no_bind_filters   : ClassObjectAttr { initialize => {clone => 'array'} }
28
sub no_fetch_filters  : ClassObjectAttr { initialize => {clone => 'array'} }
29

            
30
sub filters : ClassObjectAttr {
31
    type => 'hash',
32
    deref => 1,
33
    initialize => {
34
        clone   => 'hash',
35
        default => sub { {} }
36
    }
37
}
38

            
39
sub formats : ClassObjectAttr {
40
    type => 'hash',
41
    deref => 1,
42
    initialize => {
43
        clone   => 'hash',
44
        default => sub { {} }
45
    }
46
}
47

            
48
sub result_class : ClassObjectAttr {
49
    initialize => {
50
        clone   => 'scalar',
51
        default => 'DBIx::Custom::Result'
52
    }
53
}
54

            
55
sub sql_template : ClassObjectAttr {
56
    initialize => {
57
        clone   => sub {$_[0] ? $_[0]->clone : undef},
58
        default => sub {DBIx::Custom::SQL::Template->new}
59
    }
60
}
61

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
62
sub dbh : Attr {}
packaging one directory
yuki-kimoto authored on 2009-11-16
63

            
64

            
65
### Methods
66

            
67
# Add filter
68
sub add_filter {
69
    my $invocant = shift;
70
    
71
    my %old_filters = $invocant->filters;
72
    my %new_filters = ref $_[0] eq 'HASH' ? %{$_[0]} : @_;
73
    $invocant->filters(%old_filters, %new_filters);
74
    return $invocant;
75
}
76

            
77
# Add format
78
sub add_format{
79
    my $invocant = shift;
80
    
81
    my %old_formats = $invocant->formats;
82
    my %new_formats = ref $_[0] eq 'HASH' ? %{$_[0]} : @_;
83
    $invocant->formats(%old_formats, %new_formats);
84
    return $invocant;
85
}
86

            
87
# Auto commit
88
sub _auto_commit {
89
    my $self = shift;
90
    
91
    croak("Not yet connect to database") unless $self->dbh;
92
    
93
    if (@_) {
94
        $self->dbh->{AutoCommit} = $_[0];
95
        return $self;
96
    }
97
    return $self->dbh->{AutoCommit};
98
}
99

            
100
# Connect
101
sub connect {
102
    my $self = shift;
103
    my $data_source = $self->data_source;
104
    my $user        = $self->user;
105
    my $password    = $self->password;
106
    my $dbi_options  = $self->dbi_options;
107
    
108
    my $dbh = eval{DBI->connect(
109
        $data_source,
110
        $user,
111
        $password,
112
        {
113
            RaiseError => 1,
114
            PrintError => 0,
115
            AutoCommit => 1,
116
            %{$dbi_options || {} }
117
        }
118
    )};
119
    
120
    croak $@ if $@;
121
    
122
    $self->dbh($dbh);
123
    return $self;
124
}
125

            
126
# DESTROY
127
sub DESTROY {
128
    my $self = shift;
129
    $self->disconnect if $self->connected;
130
}
131

            
132
# Is connected?
133
sub connected {
134
    my $self = shift;
135
    return ref $self->{dbh} eq 'DBI::db';
136
}
137

            
138
# Disconnect
139
sub disconnect {
140
    my $self = shift;
141
    if ($self->connected) {
142
        $self->dbh->disconnect;
143
        delete $self->{dbh};
144
    }
145
}
146

            
147
# Reconnect
148
sub reconnect {
149
    my $self = shift;
150
    $self->disconnect if $self->connected;
151
    $self->connect;
152
}
153

            
154
# Prepare statement handle
155
sub prepare {
156
    my ($self, $sql) = @_;
157
    
158
    # Connect if not
159
    $self->connect unless $self->connected;
160
    
161
    # Prepare
162
    my $sth = eval{$self->dbh->prepare($sql)};
163
    
164
    # Error
165
    croak("$@<Your SQL>\n$sql") if $@;
166
    
167
    return $sth;
168
}
169

            
170
# Execute SQL directly
171
sub do{
172
    my ($self, $sql, @bind_values) = @_;
173
    
174
    # Connect if not
175
    $self->connect unless $self->connected;
176
    
177
    # Do
178
    my $ret_val = eval{$self->dbh->do($sql, @bind_values)};
179
    
180
    # Error
181
    if ($@) {
182
        my $error = $@;
183
        require Data::Dumper;
184
        
185
        my $bind_value_dump
186
          = Data::Dumper->Dump([\@bind_values], ['*bind_valuds']);
187
        
188
        croak("$error<Your SQL>\n$sql\n<Your bind values>\n$bind_value_dump\n");
189
    }
190
}
191

            
192
# Create query
193
sub create_query {
194
    my ($self, $template) = @_;
195
    my $class = ref $self;
196
    
197
    # Create query from SQL template
198
    my $sql_template = $self->sql_template;
199
    
200
    # Try to get cached query
201
    my $query = $class->_query_caches->{$template};
202
    
203
    # Create query
204
    unless ($query) {
205
        $query = eval{$sql_template->create_query($template)};
206
        croak($@) if $@;
207
        
208
        $class->_add_query_cache($template, $query);
209
    }
210
    
211
    # Connect if not
212
    $self->connect unless $self->connected;
213
    
214
    # Prepare statement handle
215
    my $sth = $self->prepare($query->{sql});
216
    
217
    # Set statement handle
218
    $query->sth($sth);
219
    
220
    # Set bind filter
221
    $query->bind_filter($self->bind_filter);
222
    
223
    # Set no filter keys when binding
224
    $query->no_bind_filters($self->no_bind_filters);
225
    
226
    # Set fetch filter
227
    $query->fetch_filter($self->fetch_filter);
228
    
229
    # Set no filter keys when fetching
230
    $query->no_fetch_filters($self->no_fetch_filters);
231
    
232
    return $query;
233
}
234

            
235
# Execute query
236
sub execute {
237
    my ($self, $query, $params)  = @_;
238
    $params ||= {};
239
    
240
    # First argument is SQL template
241
    if (!ref $query) {
242
        my $template = $query;
243
        $query = $self->create_query($template);
244
        my $query_edit_cb = $_[3];
245
        $query_edit_cb->($query) if ref $query_edit_cb eq 'CODE';
246
    }
247
    
248
    # Create bind value
249
    my $bind_values = $self->_build_bind_values($query, $params);
250
    
251
    # Execute
252
    my $sth = $query->sth;
253
    my $ret_val = eval{$sth->execute(@$bind_values)};
254
    
255
    # Execute error
256
    if (my $execute_error = $@) {
257
        require Data::Dumper;
258
        my $sql              = $query->{sql} || '';
259
        my $key_infos_dump   = Data::Dumper->Dump([$query->key_infos], ['*key_infos']);
260
        my $params_dump      = Data::Dumper->Dump([$params], ['*params']);
261
        
262
        croak("$execute_error" . 
263
              "<Your SQL>\n$sql\n" . 
264
              "<Your parameters>\n$params_dump");
265
    }
266
    
267
    # Return resultset if select statement is executed
268
    if ($sth->{NUM_OF_FIELDS}) {
269
        
270
        # Get result class
271
        my $result_class = $self->result_class;
272
        
273
        # Create result
274
        my $result = $result_class->new({
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
275
            _dbi             => $self,
packaging one directory
yuki-kimoto authored on 2009-11-16
276
            sth              => $sth,
277
            fetch_filter     => $query->fetch_filter,
278
            no_fetch_filters => $query->no_fetch_filters
279
        });
280
        return $result;
281
    }
282
    return $ret_val;
283
}
284

            
285
# Build binding values
286
sub _build_bind_values {
287
    my ($self, $query, $params) = @_;
288
    my $key_infos           = $query->key_infos;
289
    my $bind_filter         = $query->bind_filter;
290
    my $no_bind_filters_map = $query->_no_bind_filters_map || {};
291
    
292
    # binding values
293
    my @bind_values;
294
    
295
    # Create bind values
296
    KEY_INFOS :
297
    foreach my $key_info (@$key_infos) {
298
        # Set variable
299
        my $access_keys  = $key_info->{access_keys};
300
        my $original_key = $key_info->{original_key} || '';
301
        my $table        = $key_info->{table}        || '';
302
        my $column       = $key_info->{column}       || '';
303
        
304
        # Key is found?
305
        my $found;
306
        
307
        # Build bind values
308
        ACCESS_KEYS :
309
        foreach my $access_key (@$access_keys) {
310
            # Root parameter
311
            my $root_params = $params;
312
            
313
            # Search corresponding value
314
            for (my $i = 0; $i < @$access_key; $i++) {
315
                # Current key
316
                my $current_key = $access_key->[$i];
317
                
318
                # Last key
319
                if ($i == @$access_key - 1) {
320
                    # Key is array reference
321
                    if (ref $current_key eq 'ARRAY') {
322
                        # Filtering 
323
                        if ($bind_filter &&
324
                            !$no_bind_filters_map->{$original_key})
325
                        {
326
                            push @bind_values, 
327
                                 $bind_filter->($root_params->[$current_key->[0]], 
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
328
                                                $original_key, $self,
329
                                                {table => $table, column => $column});
packaging one directory
yuki-kimoto authored on 2009-11-16
330
                        }
331
                        # Not filtering
332
                        else {
333
                            push @bind_values,
334
                                 scalar $root_params->[$current_key->[0]];
335
                        }
336
                    }
337
                    # Key is string
338
                    else {
339
                        # Key is not found
340
                        next ACCESS_KEYS
341
                          unless exists $root_params->{$current_key};
342
                        
343
                        # Filtering
344
                        if ($bind_filter &&
345
                            !$no_bind_filters_map->{$original_key}) 
346
                        {
347
                            push @bind_values,
348
                                 $bind_filter->($root_params->{$current_key},
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
349
                                                $original_key, $self,
350
                                                {table => $table, column => $column});
packaging one directory
yuki-kimoto authored on 2009-11-16
351
                        }
352
                        # Not filtering
353
                        else {
354
                            push @bind_values,
355
                                 scalar $root_params->{$current_key};
356
                        }
357
                    }
358
                    
359
                    # Key is found
360
                    $found = 1;
361
                    next KEY_INFOS;
362
                }
363
                # First or middle key
364
                else {
365
                    # Key is array reference
366
                    if (ref $current_key eq 'ARRAY') {
367
                        # Go next key
368
                        $root_params = $root_params->[$current_key->[0]];
369
                    }
370
                    # Key is string
371
                    else {
372
                        # Not found
373
                        next ACCESS_KEYS
374
                          unless exists $root_params->{$current_key};
375
                        
376
                        # Go next key
377
                        $root_params = $root_params->{$current_key};
378
                    }
379
                }
380
            }
381
        }
382
        
383
        # Key is not found
384
        unless ($found) {
385
            require Data::Dumper;
386
            my $key_info_dump  = Data::Dumper->Dump([$key_info], ['*key_info']);
387
            my $params_dump    = Data::Dumper->Dump([$params], ['*params']);
388
            croak("Corresponding key is not found in your parameters\n" . 
389
                  "<Key information>\n$key_info_dump\n\n" .
390
                  "<Your parameters>\n$params_dump\n");
391
        }
392
    }
393
    return \@bind_values;
394
}
395

            
396
# Run transaction
397
sub run_transaction {
398
    my ($self, $transaction) = @_;
399
    
400
    # Check auto commit
401
    croak("AutoCommit must be true before transaction start")
402
      unless $self->_auto_commit;
403
    
404
    # Auto commit off
405
    $self->_auto_commit(0);
406
    
407
    # Run transaction
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
408
    eval {$transaction->($self)};
packaging one directory
yuki-kimoto authored on 2009-11-16
409
    
410
    # Tranzaction error
411
    my $transaction_error = $@;
412
    
413
    # Tranzaction is failed.
414
    if ($transaction_error) {
415
        # Rollback
416
        eval{$self->dbh->rollback};
417
        
418
        # Rollback error
419
        my $rollback_error = $@;
420
        
421
        # Auto commit on
422
        $self->_auto_commit(1);
423
        
424
        if ($rollback_error) {
425
            # Rollback is failed
426
            croak("${transaction_error}Rollback is failed : $rollback_error");
427
        }
428
        else {
429
            # Rollback is success
430
            croak("${transaction_error}Rollback is success");
431
        }
432
    }
433
    # Tranzaction is success
434
    else {
435
        # Commit
436
        eval{$self->dbh->commit};
437
        my $commit_error = $@;
438
        
439
        # Auto commit on
440
        $self->_auto_commit(1);
441
        
442
        # Commit is failed
443
        croak($commit_error) if $commit_error;
444
    }
445
}
446

            
447
# Get last insert id
448
sub last_insert_id {
449
    my $self = shift;
add Oracle, DB2, Pg,
yuki-kimoto authored on 2009-11-16
450
    my $class = ref $self;
451
    croak "'$class' do not suppert 'last_insert_id'";
packaging one directory
yuki-kimoto authored on 2009-11-16
452
}
453

            
454
# Insert
455
sub insert {
insert, update, delete appnd...
yuki-kimoto authored on 2009-11-16
456
    my $self             = shift;
457
    my $table            = shift || '';
458
    my $insert_params    = shift || {};
459
    my $append_statement = shift unless ref $_[0];
460
    my $query_edit_cb    = shift;
packaging one directory
yuki-kimoto authored on 2009-11-16
461
    
462
    # Insert keys
463
    my @insert_keys = keys %$insert_params;
464
    
465
    # Not exists insert keys
466
    croak("Key-value pairs for insert must be specified to 'insert' second argument")
467
      unless @insert_keys;
468
    
469
    # Templte for insert
470
    my $template = "insert into $table {insert " . join(' ', @insert_keys) . '}';
insert, update, delete appnd...
yuki-kimoto authored on 2009-11-16
471
    $template .= " $append_statement" if $append_statement;
packaging one directory
yuki-kimoto authored on 2009-11-16
472
    # Create query
473
    my $query = $self->create_query($template);
474
    
475
    # Query edit callback must be code reference
476
    croak("Query edit callback must be code reference")
477
      if $query_edit_cb && ref $query_edit_cb ne 'CODE';
478
    
479
    # Query edit if need
480
    $query_edit_cb->($query) if $query_edit_cb;
481
    
482
    # Execute query
483
    my $ret_val = $self->execute($query, $insert_params);
484
    
485
    return $ret_val;
486
}
487

            
488
# Update
489
sub update {
insert, update, delete appnd...
yuki-kimoto authored on 2009-11-16
490
    my $self             = shift;
491
    my $table            = shift || '';
492
    my $update_params    = shift || {};
493
    my $where_params     = shift || {};
494
    my $append_statement = shift unless ref $_[0];
495
    my $query_edit_cb    = shift;
496
    my $options          = shift;
packaging one directory
yuki-kimoto authored on 2009-11-16
497
    
498
    # Update keys
499
    my @update_keys = keys %$update_params;
500
    
501
    # Not exists update kyes
502
    croak("Key-value pairs for update must be specified to 'update' second argument")
503
      unless @update_keys;
504
    
505
    # Where keys
506
    my @where_keys = keys %$where_params;
507
    
508
    # Not exists where keys
509
    croak("Key-value pairs for where clause must be specified to 'update' third argument")
510
      if !@where_keys && !$options->{allow_update_all};
511
    
512
    # Update clause
513
    my $update_clause = '{update ' . join(' ', @update_keys) . '}';
514
    
515
    # Where clause
516
    my $where_clause = '';
517
    if (@where_keys) {
518
        $where_clause = 'where ';
519
        foreach my $where_key (@where_keys) {
520
            $where_clause .= "{= $where_key} and ";
521
        }
522
        $where_clause =~ s/ and $//;
523
    }
524
    
525
    # Template for update
526
    my $template = "update $table $update_clause $where_clause";
insert, update, delete appnd...
yuki-kimoto authored on 2009-11-16
527
    $template .= " $append_statement" if $append_statement;
packaging one directory
yuki-kimoto authored on 2009-11-16
528
    
529
    # Create query
530
    my $query = $self->create_query($template);
531
    
532
    # Query edit callback must be code reference
533
    croak("Query edit callback must be code reference")
534
      if $query_edit_cb && ref $query_edit_cb ne 'CODE';
535
    
536
    # Query edit if need
537
    $query_edit_cb->($query) if $query_edit_cb;
538
    
539
    # Rearrange parammeters
540
    my $params = {'#update' => $update_params, %$where_params};
541
    
542
    # Execute query
543
    my $ret_val = $self->execute($query, $params);
544
    
545
    return $ret_val;
546
}
547

            
548
# Update all rows
549
sub update_all {
insert, update, delete appnd...
yuki-kimoto authored on 2009-11-16
550
    my $self             = shift;
551
    my $table            = shift || '';
552
    my $update_params    = shift || {};
553
    my $append_statement = shift unless ref $_[0];
554
    my $query_edit_cb    = shift;
555
    my $options          = {allow_update_all => 1};
556
    
557
    return $self->update($table, $update_params, {}, $append_statement,
558
                         $query_edit_cb, $options);
packaging one directory
yuki-kimoto authored on 2009-11-16
559
}
560

            
561
# Delete
562
sub delete {
insert, update, delete appnd...
yuki-kimoto authored on 2009-11-16
563
    my $self             = shift;
564
    my $table            = shift || '';
565
    my $where_params     = shift || {};
566
    my $append_statement = shift unless ref $_[0];
567
    my $query_edit_cb    = shift;
568
    my $options          = shift;
packaging one directory
yuki-kimoto authored on 2009-11-16
569
    
570
    # Where keys
571
    my @where_keys = keys %$where_params;
572
    
573
    # Not exists where keys
574
    croak("Key-value pairs for where clause must be specified to 'delete' second argument")
575
      if !@where_keys && !$options->{allow_delete_all};
576
    
577
    # Where clause
578
    my $where_clause = '';
579
    if (@where_keys) {
580
        $where_clause = 'where ';
581
        foreach my $where_key (@where_keys) {
582
            $where_clause .= "{= $where_key} and ";
583
        }
584
        $where_clause =~ s/ and $//;
585
    }
586
    
587
    # Template for delete
588
    my $template = "delete from $table $where_clause";
insert, update, delete appnd...
yuki-kimoto authored on 2009-11-16
589
    $template .= " $append_statement" if $append_statement;
packaging one directory
yuki-kimoto authored on 2009-11-16
590
    
591
    # Create query
592
    my $query = $self->create_query($template);
593
    
594
    # Query edit callback must be code reference
595
    croak("Query edit callback must be code reference")
596
      if $query_edit_cb && ref $query_edit_cb ne 'CODE';
597
    
598
    # Query edit if need
599
    $query_edit_cb->($query) if $query_edit_cb;
600
    
601
    # Execute query
602
    my $ret_val = $self->execute($query, $where_params);
603
    
604
    return $ret_val;
605
}
606

            
607
# Delete all rows
608
sub delete_all {
insert, update, delete appnd...
yuki-kimoto authored on 2009-11-16
609
    my $self             = shift;
610
    my $table            = shift || '';
611
    my $append_statement = shift unless ref $_[0];
612
    my $query_edit_cb    = shift;
613
    my $options          = {allow_delete_all => 1};
614
    
615
    return $self->delete($table, {}, $append_statement, $query_edit_cb,
616
                         $options);
packaging one directory
yuki-kimoto authored on 2009-11-16
617
}
618

            
619
sub _select_usage { return << 'EOS' }
620
Your select arguments is wrong.
621
select usage:
622
$dbi->select(
623
    $table,                # must be string or array ref
624
    [@$columns],           # must be array reference. this is optional
625
    {%$where_params},      # must be hash reference.  this is optional
626
    $append_statement,     # must be string.          this is optional
627
    $query_edit_callback   # must be code reference.  this is optional
628
);
629
EOS
630

            
631
sub select {
632
    my $self = shift;
633
    
634
    # Check argument
635
    croak($self->_select_usage) unless @_;
636
    
637
    # Arguments
638
    my $tables = shift || '';
639
    $tables    = [$tables] unless ref $tables;
640
    
641
    my $columns          = ref $_[0] eq 'ARRAY' ? shift : [];
642
    my $where_params     = ref $_[0] eq 'HASH'  ? shift : {};
643
    my $append_statement = $_[0] && !ref $_[0]  ? shift : '';
644
    my $query_edit_cb    = shift if ref $_[0] eq 'CODE';
645
    
646
    # Check rest argument
647
    croak($self->_select_usage) if @_;
648
    
649
    # SQL template for select statement
650
    my $template = 'select ';
651
    
652
    # Join column clause
653
    if (@$columns) {
654
        foreach my $column (@$columns) {
655
            $template .= "$column, ";
656
        }
657
        $template =~ s/, $/ /;
658
    }
659
    else {
660
        $template .= '* ';
661
    }
662
    
663
    # Join table
664
    $template .= 'from ';
665
    foreach my $table (@$tables) {
666
        $template .= "$table, ";
667
    }
668
    $template =~ s/, $/ /;
669
    
670
    # Where clause keys
671
    my @where_keys = keys %$where_params;
672
    
673
    # Join where clause
674
    if (@where_keys) {
675
        $template .= 'where ';
676
        foreach my $where_key (@where_keys) {
677
            $template .= "{= $where_key} and ";
678
        }
679
    }
680
    $template =~ s/ and $//;
681
    
682
    # Append something to last of statement
683
    if ($append_statement =~ s/^where //) {
684
        if (@where_keys) {
685
            $template .= " and $append_statement";
686
        }
687
        else {
688
            $template .= " where $append_statement";
689
        }
690
    }
691
    else {
692
        $template .= " $append_statement";
693
    }
694
    
695
    # Create query
696
    my $query = $self->create_query($template);
697
    
698
    # Query edit
699
    $query_edit_cb->($query) if $query_edit_cb;
700
    
701
    # Execute query
702
    my $result = $self->execute($query, $where_params);
703
    
704
    return $result;
705
}
706

            
707
sub _query_caches     : ClassAttr { type => 'hash',
708
                                    auto_build => sub {shift->_query_caches({}) } }
709
                                    
710
sub _query_cache_keys : ClassAttr { type => 'array',
711
                                    auto_build => sub {shift->_query_cache_keys([])} }
712
                                    
713
sub query_cache_max   : ClassAttr { auto_build => sub {shift->query_cache_max(50)} }
714

            
715
# Add query cahce
716
sub _add_query_cache {
717
    my ($class, $template, $query) = @_;
718
    my $query_cache_keys = $class->_query_cache_keys;
719
    my $query_caches     = $class->_query_caches;
720
    
721
    return $class if $query_caches->{$template};
722
    
723
    $query_caches->{$template} = $query;
724
    push @$query_cache_keys, $template;
725
    
726
    my $overflow = @$query_cache_keys - $class->query_cache_max;
727
    
728
    for (my $i = 0; $i < $overflow; $i++) {
729
        my $template = shift @$query_cache_keys;
730
        delete $query_caches->{$template};
731
    }
732
    
733
    return $class;
734
}
735

            
736
# Both bind_filter and fetch_filter off
737
sub filter_off {
738
    my $self = shift;
739
    
740
    # filter off
741
    $self->bind_filter(undef);
742
    $self->fetch_filter(undef);
743
    
744
    return $self;
745
}
746

            
747
Object::Simple->build_class;
748

            
749
=head1 NAME
750

            
751
DBIx::Custom - Customizable simple DBI
752

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
753
=head1 Version
packaging one directory
yuki-kimoto authored on 2009-11-16
754

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
755
Version 0.0601
packaging one directory
yuki-kimoto authored on 2009-11-16
756

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
757
=head1 Caution
packaging one directory
yuki-kimoto authored on 2009-11-16
758

            
759
This module is now experimental stage.
760

            
761
I want you to try this module
762
because I want this module stable, and not to damage your DB data by this module bug.
763

            
764
Please tell me bug if you find
765

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
766
=head1 Synopsys
packaging one directory
yuki-kimoto authored on 2009-11-16
767

            
768
  my $dbi = DBIx::Custom->new;
769
  
770
  my $query = $dbi->create_query($template);
771
  $dbi->execute($query);
772

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
773
=head1 Accessors
packaging one directory
yuki-kimoto authored on 2009-11-16
774

            
775
=head2 user
776

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
777
Set and get database user name
778
    
779
    # For object
780
    $self  = $self->user($user);
781
    $user  = $self->user;
782
    
783
    # For class
784
    $class = $class->user($user);
785
    $user  = $class->user;
packaging one directory
yuki-kimoto authored on 2009-11-16
786
    
787
    # Sample
788
    $dbi->user('taro');
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
789
    
packaging one directory
yuki-kimoto authored on 2009-11-16
790
=head2 password
791

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
792
Set and get database password
793
    
794
    # For object
795
    $self     = $self->password($password);
796
    $password = $self->password;
797

            
798
    # For class
799
    $class    = $class->password($password);
800
    $password = $class->password;
packaging one directory
yuki-kimoto authored on 2009-11-16
801
    
802
    # Sample
803
    $dbi->password('lkj&le`@s');
804

            
805
=head2 data_source
806

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
807
Set and get database data source
808
    
809
    # For object
810
    $self        = $self->data_source($data_soruce);
811
    $data_source = $self->data_source;
812
    
813
    # For class
814
    $class       = $class->data_source($data_soruce);
815
    $data_source = $class->data_source;
packaging one directory
yuki-kimoto authored on 2009-11-16
816
    
817
    # Sample(SQLite)
818
    $dbi->data_source(dbi:SQLite:dbname=$database);
819
    
820
    # Sample(MySQL);
821
    $dbi->data_source("dbi:mysql:dbname=$database");
822
    
823
    # Sample(PostgreSQL)
824
    $dbi->data_source("dbi:Pg:dbname=$database");
825
    
826
=head2 database
827

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
828
Set and get database name
829

            
830
    # For object
831
    $self     = $self->database($database);
832
    $database = $self->database;
833

            
834
    # For class
835
    $class    = $class->database($database);
836
    $database = $class->database;
837
    
838
    # Sample
839
    $dbi->database('books');
packaging one directory
yuki-kimoto authored on 2009-11-16
840

            
add port and host method
yuki-kimoto authored on 2009-11-16
841
=head2 host
842

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
843
Set and get host name
844

            
845
    # For object
846
    $self = $self->host($host);
847
    $host = $self->host;
848

            
849
    # For class
850
    $class = $class->host($host);
851
    $host  = $class->host;
852
    
853
    # Sample
854
    $dbi->host('somehost.com');
855
    $dbi->host('127.1.2.3');
add port and host method
yuki-kimoto authored on 2009-11-16
856

            
857
=head2 port
858

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
859
Set and get port
860

            
861
    # For object
862
    $self = $self->port($port);
863
    $port = $self->port;
add port and host method
yuki-kimoto authored on 2009-11-16
864

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
865
    # For class
866
    $class = $class->port($port);
867
    $port = $class->port;
868
    
869
    # Sample
870
    $dbi->port(1198);
packaging one directory
yuki-kimoto authored on 2009-11-16
871

            
872
=head2 dbi_options
873

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
874
Set and get DBI option
packaging one directory
yuki-kimoto authored on 2009-11-16
875

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
876
    # For object
877
    $self        = $self->dbi_options({$options => $value, ...});
878
    $dbi_options = $self->dbi_options;
879
    
880
    # For class
881
    $class       = $class->dbi_options({$options => $value, ...});
882
    $dbi_options = $class->dbi_options;
883
    
packaging one directory
yuki-kimoto authored on 2009-11-16
884
    # Sample
885
    $dbi->dbi_options({PrintError => 0, RaiseError => 1});
886

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
887
=head2 sql_template
packaging one directory
yuki-kimoto authored on 2009-11-16
888

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
889
Set and get SQL::Template object
packaging one directory
yuki-kimoto authored on 2009-11-16
890

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
891
    # For object
892
    $self         = $self->sql_template($sql_template);
893
    $sql_template = $self->sql_template;
packaging one directory
yuki-kimoto authored on 2009-11-16
894

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
895
    # For class
896
    $class        = $class->sql_template($sql_template);
897
    $sql_template = $class->sql_template;
packaging one directory
yuki-kimoto authored on 2009-11-16
898

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
899
    # Sample
900
    $dbi->sql_template(DBI::Cutom::SQL::Template->new);
packaging one directory
yuki-kimoto authored on 2009-11-16
901

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
902
=head2 filters
packaging one directory
yuki-kimoto authored on 2009-11-16
903

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
904
Set and get filters
packaging one directory
yuki-kimoto authored on 2009-11-16
905

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
906
    # For object
907
    $self    = $self->filters($filters);
908
    $filters = $self->filters;
packaging one directory
yuki-kimoto authored on 2009-11-16
909

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
910
    # For class
911
    $class   = $class->filters($filters);
912
    $filters = $class->filters;
packaging one directory
yuki-kimoto authored on 2009-11-16
913
    
914
    # Sample
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
915
    $ret = $dbi->filters->{encode_utf8}->($value);
packaging one directory
yuki-kimoto authored on 2009-11-16
916

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
917
=head2 formats
packaging one directory
yuki-kimoto authored on 2009-11-16
918

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
919
Set and get formats
packaging one directory
yuki-kimoto authored on 2009-11-16
920

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
921
    # For object
922
    $self    = $self->formats($formats);
923
    $formats = $self->formats;
924

            
925
    # For class
926
    $self    = $self->formats($formats);
927
    $formats = $self->formats;
928

            
929
    # Sample
930
    $datetime_format = $dbi->formats->{datetime};
packaging one directory
yuki-kimoto authored on 2009-11-16
931

            
932
=head2 bind_filter
933

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
934
Set and get binding filter
packaging one directory
yuki-kimoto authored on 2009-11-16
935

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
936
    # For object
937
    $self        = $self->bind_filter($bind_filter);
938
    $bind_filter = $self->bind_filter
packaging one directory
yuki-kimoto authored on 2009-11-16
939

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
940
    # For object
941
    $class       = $class->bind_filter($bind_filter);
942
    $bind_filter = $class->bind_filter
943

            
944
    # Sample
945
    $dbi->bind_filter(sub {
946
        my ($value, $key, $dbi, $infos) = @_;
947
        
948
        # edit $value
949
        
950
        return $value;
951
    });
packaging one directory
yuki-kimoto authored on 2009-11-16
952

            
953
=head2 fetch_filter
954

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
955
Set and get Fetch filter
956

            
957
    # For object
958
    $self         = $self->fetch_filter($fetch_filter);
959
    $fetch_filter = $self->fetch_filter;
960

            
961
    # For class
962
    $class        = $class->fetch_filter($fetch_filter);
963
    $fetch_filter = $class->fetch_filter;
packaging one directory
yuki-kimoto authored on 2009-11-16
964

            
965
    # Sample
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
966
    $dbi->fetch_filter(sub {
967
        my ($value, $key, $dbi, $infos) = @_;
968
        
969
        # edit $value
970
        
971
        return $value;
972
    });
packaging one directory
yuki-kimoto authored on 2009-11-16
973

            
974
=head2 no_bind_filters
975

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
976
Set and get no filter keys when binding
977
    
978
    # For object
979
    $self            = $self->no_bind_filters($no_bind_filters);
980
    $no_bind_filters = $self->no_bind_filters;
981

            
982
    # For class
983
    $class           = $class->no_bind_filters($no_bind_filters);
984
    $no_bind_filters = $class->no_bind_filters;
985

            
986
    # Sample
987
    $dbi->no_bind_filters(qw/title author/);
packaging one directory
yuki-kimoto authored on 2009-11-16
988

            
989
=head2 no_fetch_filters
990

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
991
Set and get no filter keys when fetching
992

            
993
    # For object
994
    $self             = $self->no_fetch_filters($no_fetch_filters);
995
    $no_fetch_filters = $self->no_fetch_filters;
996

            
997
    # For class
998
    $class            = $class->no_fetch_filters($no_fetch_filters);
999
    $no_fetch_filters = $class->no_fetch_filters;
1000

            
1001
    # Sample
1002
    $dbi->no_fetch_filters(qw/title author/);
packaging one directory
yuki-kimoto authored on 2009-11-16
1003

            
1004
=head2 result_class
1005

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1006
Set and get resultset class
1007

            
1008
    # For object
packaging one directory
yuki-kimoto authored on 2009-11-16
1009
    $self         = $dbi->result_class($result_class);
1010
    $result_class = $dbi->result_class;
1011
    
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1012
    # For class
1013
    $class        = $class->result_class($result_class);
1014
    $result_class = $class->result_class;
1015
    
packaging one directory
yuki-kimoto authored on 2009-11-16
1016
    # Sample
1017
    $dbi->result_class('DBIx::Custom::Result');
1018

            
1019
=head2 dbh
1020

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1021
Get database handle
1022
    
1023
    $self = $self->dbh($dbh);
1024
    $dbh  = $self->dbh;
1025
    
1026
    # Sample
1027
    $table_info = $dbi->dbh->table_info
1028
    
1029
=head2 query_cache_max
1030

            
1031
Set and get query cache max
1032

            
1033
    $class           = $class->query_cache_max($query_cache_max);
1034
    $query_cache_max = $class->query_cache_max;
1035
    
1036
    # Sample
1037
    DBIx::Custom->query_cache_max(50);
packaging one directory
yuki-kimoto authored on 2009-11-16
1038

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1039
DBIx::Custom cache queries for performance.
1040

            
1041
Default is 50
1042

            
1043
=head1 Methods
packaging one directory
yuki-kimoto authored on 2009-11-16
1044

            
1045
=head2 connect
1046

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1047
Connect to database
1048

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1049
    $self = $dbi->connect;
1050
    
1051
    # Sample
1052
    $dbi = DBIx::Custom->new(user => 'taro', password => 'lji8(', 
1053
                            data_soruce => "dbi:mysql:dbname=$database");
1054
    $dbi->connect;
1055

            
1056
=head2 disconnect
1057

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1058
Disconnect database
1059

            
1060
    $self = $dbi->disconnect;
1061
    
1062
    # Sample
packaging one directory
yuki-kimoto authored on 2009-11-16
1063
    $dbi->disconnect;
1064

            
1065
If database is already disconnected, this method do noting.
1066

            
1067
=head2 reconnect
1068

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1069
Reconnect to database
1070

            
1071
    $self = $dbi->reconnect;
1072
    
1073
    # Sample
packaging one directory
yuki-kimoto authored on 2009-11-16
1074
    $dbi->reconnect;
1075

            
1076
=head2 connected
1077

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1078
Check connected
1079
    
1080
    $is_connected = $self->connected;
1081
    
1082
    # Sample
1083
    if ($dbi->connected) { # do something }
packaging one directory
yuki-kimoto authored on 2009-11-16
1084
    
1085
=head2 filter_off
1086

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1087
bind_filter and fitch_filter off
1088
    
1089
    $self = $self->filter_off
1090
    
1091
    # Sample
1092
    $dbi->filter_off;
packaging one directory
yuki-kimoto authored on 2009-11-16
1093
    
1094
This is equeal to
1095
    
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1096
    $dbi->bind_filter(undef);
1097
    $dbi->fetch_filter(undef);
packaging one directory
yuki-kimoto authored on 2009-11-16
1098

            
1099
=head2 add_filter
1100

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1101
Resist filter
packaging one directory
yuki-kimoto authored on 2009-11-16
1102
    
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1103
    $self = $self->add_filter({$name => $filter, ...});
1104
    # or
1105
    $self = $self->add_filter($name => $filter, ...);
1106
    
1107
    # Sample (For example DBIx::Custom::Basic)
packaging one directory
yuki-kimoto authored on 2009-11-16
1108
    $dbi->add_filter(
1109
        encode_utf8 => sub {
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1110
            my ($value, $key, $dbi, $infos) = @_;
1111
            utf8::upgrade($value) unless Encode::is_utf8($value);
1112
            return encode('UTF-8', $value);
packaging one directory
yuki-kimoto authored on 2009-11-16
1113
        },
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1114
        decode_utf8 => sub {
1115
            my ($value, $key, $dbi, $infos) = @_;
1116
            return decode('UTF-8', $value)
packaging one directory
yuki-kimoto authored on 2009-11-16
1117
        }
1118
    );
1119

            
1120
=head2 add_format
1121

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1122
Resist format
1123

            
1124
    $self = $self->add_format({$name => $format, ...});
1125
    # or
1126
    $self = $self->add_format($name => $format, ...);
1127
    
1128
    # Sample
1129
    $dbi->add_format(date => '%Y:%m:%d', datetime => '%Y-%m-%d %H:%M:%S');
1130

            
1131
=head2 prepare
1132

            
1133
Prepare statement handle
1134

            
1135
    $sth = $self->prepare($sql);
1136
    
1137
    # Sample
1138
    $sth = $dbi->prepare('select * from books;');
1139

            
1140
This method is same as DBI prepare method.
1141

            
1142
=head2 do
1143

            
1144
Execute SQL
1145

            
1146
    $ret_val = $self->do($sql, @bind_values);
1147
    
1148
    # Sample
1149
    $ret_val = $dbi->do('insert into books (title, author) values (?, ?)',
1150
                        'Perl', 'taro');
1151

            
1152
This method is same as DBI do method.
packaging one directory
yuki-kimoto authored on 2009-11-16
1153

            
1154
=head2 create_query
1155
    
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1156
Create Query object from SQL template
1157

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1158
    my $query = $dbi->create_query($template);
1159
    
1160
=head2 execute
1161

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1162
Parse SQL template and execute SQL
1163

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1164
    $result = $dbi->query($query, $params);
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1165
    $result = $dbi->query($template, $params); # Shortcut
packaging one directory
yuki-kimoto authored on 2009-11-16
1166
    
1167
    # Sample
1168
    $result = $dbi->query("select * from authors where {= name} and {= age}", 
1169
                          {author => 'taro', age => 19});
1170
    
1171
    while (my @row = $result->fetch) {
1172
        # do something
1173
    }
1174

            
1175
See also L<DBIx::Custom::SQL::Template>
1176

            
1177
=head2 run_transaction
1178

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1179
Run transaction
1180

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1181
    $dbi->run_transaction(sub {
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1182
        my $dbi = shift;
1183
        
packaging one directory
yuki-kimoto authored on 2009-11-16
1184
        # do something
1185
    });
1186

            
1187
If transaction is success, commit is execute. 
1188
If tranzation is died, rollback is execute.
1189

            
1190
=head2 insert
1191

            
update document
yuki-kimoto authored on 2009-11-19
1192
Insert row
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1193

            
update document
yuki-kimoto authored on 2009-11-19
1194
    $ret_val = $self->insert($table, \%$insert_params);
1195

            
1196
$ret_val is maybe affected rows count
packaging one directory
yuki-kimoto authored on 2009-11-16
1197
    
1198
    # Sample
1199
    $dbi->insert('books', {title => 'Perl', author => 'Taro'});
1200

            
1201
=head2 update
1202

            
update document
yuki-kimoto authored on 2009-11-19
1203
Update rows
1204

            
1205
    $self = $self->update($table, \%update_params, \%where);
1206

            
1207
$ret_val is maybe affected rows count
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1208

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1209
    # Sample
1210
    $dbi->update('books', {title => 'Perl', author => 'Taro'}, {id => 5});
1211

            
1212
=head2 update_all
1213

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1214
Update all rows
1215

            
update document
yuki-kimoto authored on 2009-11-19
1216
    $ret_val = $self->update_all($table, \%updat_params);
1217

            
1218
$ret_val is maybe affected rows count
1219

            
1220
    # Sample
1221
    $dbi->update_all('books', {author => 'taro'});
packaging one directory
yuki-kimoto authored on 2009-11-16
1222

            
1223
=head2 delete
1224

            
update document
yuki-kimoto authored on 2009-11-19
1225
Delete rows
1226

            
1227
    $ret_val = $self->delete($table, \%where);
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1228

            
update document
yuki-kimoto authored on 2009-11-19
1229
$ret_val is maybe affected rows count
packaging one directory
yuki-kimoto authored on 2009-11-16
1230
    
1231
    # Sample
update document
yuki-kimoto authored on 2009-11-19
1232
    $dbi->delete('books', {id => 5});
packaging one directory
yuki-kimoto authored on 2009-11-16
1233

            
1234
=head2 delete_all
1235

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1236
Delete all rows
1237

            
update document
yuki-kimoto authored on 2009-11-19
1238
    $ret_val = $self->delete_all($table);
packaging one directory
yuki-kimoto authored on 2009-11-16
1239

            
update document
yuki-kimoto authored on 2009-11-19
1240
$ret_val is maybe affected rows count
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1241

            
update document
yuki-kimoto authored on 2009-11-19
1242
    # Sample
1243
    $dib->delete_all('books');
packaging one directory
yuki-kimoto authored on 2009-11-16
1244

            
1245
=head2 select
1246
    
update document
yuki-kimoto authored on 2009-11-19
1247
Select rows
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1248

            
update document
yuki-kimoto authored on 2009-11-19
1249
    $resut = $self->select(
packaging one directory
yuki-kimoto authored on 2009-11-16
1250
        $table,                # must be string or array;
update document
yuki-kimoto authored on 2009-11-19
1251
        \@$columns,            # must be array reference. this is optional
1252
        \%$where_params,       # must be hash reference.  this is optional
packaging one directory
yuki-kimoto authored on 2009-11-16
1253
        $append_statement,     # must be string.          this is optional
1254
        $query_edit_callback   # must be code reference.  this is optional
1255
    );
update document
yuki-kimoto authored on 2009-11-19
1256

            
1257
$reslt is L<DBI::Custom::Result> object
1258

            
1259
The following is some select samples
1260

            
1261
    # select * from books;
1262
    $result = $dbi->select('books');
packaging one directory
yuki-kimoto authored on 2009-11-16
1263
    
update document
yuki-kimoto authored on 2009-11-19
1264
    # select * from books where title = 'Perl';
1265
    $result = $dbi->select('books', {title => 1});
1266
    
1267
    # select title, author from books where id = 1 for update;
1268
    $result = $dbi->select(
1269
        'books',              # table
1270
        ['title', 'author'],  # columns
1271
        {id => 1},            # where clause
1272
        'for update',         # append statement
1273
    );
1274

            
1275
You can join multi tables
1276
    
1277
    $result = $dbi->select(
1278
        ['table1', 'table2'],                # tables
1279
        ['table1.id as table1_id', 'title'], # columns (alias is ok)
1280
        {table1.id => 1},                    # where clase
1281
        "where table1.id = table2.id",       # join clause (must start 'where')
1282
    );
1283

            
1284
You can also edit query
1285
        
packaging one directory
yuki-kimoto authored on 2009-11-16
1286
    $dbi->select(
update document
yuki-kimoto authored on 2009-11-19
1287
        'books',
1288
        # column, where clause, append statement,
packaging one directory
yuki-kimoto authored on 2009-11-16
1289
        sub {
1290
            my $query = shift;
1291
            $query->bind_filter(sub {
1292
                # ...
1293
            });
1294
        }
update document
yuki-kimoto authored on 2009-11-19
1295
    }
1296

            
1297

            
1298
=head2 last_insert_id
1299

            
1300
Get last insert id
packaging one directory
yuki-kimoto authored on 2009-11-16
1301

            
update document
yuki-kimoto authored on 2009-11-19
1302
    $last_insert_id = $dbi->last_insert_id;
packaging one directory
yuki-kimoto authored on 2009-11-16
1303

            
update document
yuki-kimoto authored on 2009-11-19
1304
This method is implemented by subclass.
1305

            
1306
=head1 Caution
packaging one directory
yuki-kimoto authored on 2009-11-16
1307

            
update document
yuki-kimoto authored on 2009-11-19
1308
DBIx::Custom have DBI object.
packaging one directory
yuki-kimoto authored on 2009-11-16
1309
This module is work well in the following DBI condition.
1310

            
1311
    1. AutoCommit is true
1312
    2. RaiseError is true
1313

            
1314
By default, Both AutoCommit and RaiseError is true.
1315
You must not change these mode not to damage your data.
1316

            
1317
If you change these mode, 
1318
you cannot get correct error message, 
1319
or run_transaction may fail.
1320

            
1321
=head1 AUTHOR
1322

            
1323
Yuki Kimoto, C<< <kimoto.yuki at gmail.com> >>
1324

            
1325
Github L<http://github.com/yuki-kimoto>
1326

            
1327
=head1 COPYRIGHT & LICENSE
1328

            
1329
Copyright 2009 Yuki Kimoto, all rights reserved.
1330

            
1331
This program is free software; you can redistribute it and/or modify it
1332
under the same terms as Perl itself.
1333

            
1334
=cut