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

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

            
6
our $VERSION = '0.0501';
7

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

            
14

            
15
### Class-Object Accessors
16
sub user        : ClassObjectAttr { initialize => {clone => 'scalar'} }
17
sub password    : ClassObjectAttr { initialize => {clone => 'scalar'} }
18
sub data_source : ClassObjectAttr { initialize => {clone => 'scalar'} }
19
sub dbi_options : ClassObjectAttr { initialize => {clone => 'hash', 
20
                                                   default => sub { {} } } }
21
sub database    : ClassObjectAttr { initialize => {clone => 'scalar'} }
22

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

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

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

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

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

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

            
61
### Object Accessor
62
sub dbh          : Attr {}
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
        $query = DBIx::Custom::Query->new($query);
209
        
210
        $class->_add_query_cache($template, $query);
211
    }
212
    
213
    # Connect if not
214
    $self->connect unless $self->connected;
215
    
216
    # Prepare statement handle
217
    my $sth = $self->prepare($query->{sql});
218
    
219
    # Set statement handle
220
    $query->sth($sth);
221
    
222
    # Set bind filter
223
    $query->bind_filter($self->bind_filter);
224
    
225
    # Set no filter keys when binding
226
    $query->no_bind_filters($self->no_bind_filters);
227
    
228
    # Set fetch filter
229
    $query->fetch_filter($self->fetch_filter);
230
    
231
    # Set no filter keys when fetching
232
    $query->no_fetch_filters($self->no_fetch_filters);
233
    
234
    return $query;
235
}
236

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

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

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

            
448
# Get last insert id
449
sub last_insert_id {
450
    my $self = shift;
451
    
452
    # Not connected
453
    croak("Not yet connect to database")
454
      unless $self->connected;
455
    
456
    return $self->dbh->last_insert_id(@_);
457
}
458

            
459
# Insert
460
sub insert {
461
    my ($self, $table, $insert_params, $query_edit_cb) = @_;
462
    $table         ||= '';
463
    $insert_params ||= {};
464
    
465
    # Insert keys
466
    my @insert_keys = keys %$insert_params;
467
    
468
    # Not exists insert keys
469
    croak("Key-value pairs for insert must be specified to 'insert' second argument")
470
      unless @insert_keys;
471
    
472
    # Templte for insert
473
    my $template = "insert into $table {insert " . join(' ', @insert_keys) . '}';
474
    
475
    # Create query
476
    my $query = $self->create_query($template);
477
    
478
    # Query edit callback must be code reference
479
    croak("Query edit callback must be code reference")
480
      if $query_edit_cb && ref $query_edit_cb ne 'CODE';
481
    
482
    # Query edit if need
483
    $query_edit_cb->($query) if $query_edit_cb;
484
    
485
    # Execute query
486
    my $ret_val = $self->execute($query, $insert_params);
487
    
488
    return $ret_val;
489
}
490

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

            
549
# Update all rows
550
sub update_all {
551
    my ($self, $table, $update_params, $query_edit_cb) = @_;
552
    
553
    return $self->update($table, $update_params, {}, $query_edit_cb,
554
                         {allow_update_all => 1});
555
}
556

            
557
# Delete
558
sub delete {
559
    my ($self, $table, $where_params, $query_edit_cb, $options) = @_;
560
    $table        ||= '';
561
    $where_params ||= {};
562
    
563
    # Where keys
564
    my @where_keys = keys %$where_params;
565
    
566
    # Not exists where keys
567
    croak("Key-value pairs for where clause must be specified to 'delete' second argument")
568
      if !@where_keys && !$options->{allow_delete_all};
569
    
570
    # Where clause
571
    my $where_clause = '';
572
    if (@where_keys) {
573
        $where_clause = 'where ';
574
        foreach my $where_key (@where_keys) {
575
            $where_clause .= "{= $where_key} and ";
576
        }
577
        $where_clause =~ s/ and $//;
578
    }
579
    
580
    # Template for delete
581
    my $template = "delete from $table $where_clause";
582
    
583
    # Create query
584
    my $query = $self->create_query($template);
585
    
586
    # Query edit callback must be code reference
587
    croak("Query edit callback must be code reference")
588
      if $query_edit_cb && ref $query_edit_cb ne 'CODE';
589
    
590
    # Query edit if need
591
    $query_edit_cb->($query) if $query_edit_cb;
592
    
593
    # Execute query
594
    my $ret_val = $self->execute($query, $where_params);
595
    
596
    return $ret_val;
597
}
598

            
599
# Delete all rows
600
sub delete_all {
601
    my ($self, $table) = @_;
602
    return $self->delete($table, {}, undef, {allow_delete_all => 1});
603
}
604

            
605
sub _select_usage { return << 'EOS' }
606
Your select arguments is wrong.
607
select usage:
608
$dbi->select(
609
    $table,                # must be string or array ref
610
    [@$columns],           # must be array reference. this is optional
611
    {%$where_params},      # must be hash reference.  this is optional
612
    $append_statement,     # must be string.          this is optional
613
    $query_edit_callback   # must be code reference.  this is optional
614
);
615
EOS
616

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

            
693
sub _query_caches     : ClassAttr { type => 'hash',
694
                                    auto_build => sub {shift->_query_caches({}) } }
695
                                    
696
sub _query_cache_keys : ClassAttr { type => 'array',
697
                                    auto_build => sub {shift->_query_cache_keys([])} }
698
                                    
699
sub query_cache_max   : ClassAttr { auto_build => sub {shift->query_cache_max(50)} }
700

            
701
# Add query cahce
702
sub _add_query_cache {
703
    my ($class, $template, $query) = @_;
704
    my $query_cache_keys = $class->_query_cache_keys;
705
    my $query_caches     = $class->_query_caches;
706
    
707
    return $class if $query_caches->{$template};
708
    
709
    $query_caches->{$template} = $query;
710
    push @$query_cache_keys, $template;
711
    
712
    my $overflow = @$query_cache_keys - $class->query_cache_max;
713
    
714
    for (my $i = 0; $i < $overflow; $i++) {
715
        my $template = shift @$query_cache_keys;
716
        delete $query_caches->{$template};
717
    }
718
    
719
    return $class;
720
}
721

            
722
# Both bind_filter and fetch_filter off
723
sub filter_off {
724
    my $self = shift;
725
    
726
    # filter off
727
    $self->bind_filter(undef);
728
    $self->fetch_filter(undef);
729
    
730
    return $self;
731
}
732

            
733
Object::Simple->build_class;
734

            
735
=head1 NAME
736

            
737
DBIx::Custom - Customizable simple DBI
738

            
739
=head1 VERSION
740

            
741
Version 0.0501
742

            
743
=head1 CAUTION
744

            
745
This module is now experimental stage.
746

            
747
I want you to try this module
748
because I want this module stable, and not to damage your DB data by this module bug.
749

            
750
Please tell me bug if you find
751

            
752
=head1 SYNOPSIS
753

            
754
  my $dbi = DBIx::Custom->new;
755
  
756
  my $query = $dbi->create_query($template);
757
  $dbi->execute($query);
758

            
759
=head1 CLASS-OBJECT ACCESSORS
760

            
761
=head2 user
762

            
763
    # Set and get database user name
764
    $self = $dbi->user($user);
765
    $user = $dbi->user;
766
    
767
    # Sample
768
    $dbi->user('taro');
769

            
770
=head2 password
771

            
772
    # Set and get database password
773
    $self     = $dbi->password($password);
774
    $password = $dbi->password;
775
    
776
    # Sample
777
    $dbi->password('lkj&le`@s');
778

            
779
=head2 data_source
780

            
781
    # Set and get database data source
782
    $self        = $dbi->data_source($data_soruce);
783
    $data_source = $dbi->data_source;
784
    
785
    # Sample(SQLite)
786
    $dbi->data_source(dbi:SQLite:dbname=$database);
787
    
788
    # Sample(MySQL);
789
    $dbi->data_source("dbi:mysql:dbname=$database");
790
    
791
    # Sample(PostgreSQL)
792
    $dbi->data_source("dbi:Pg:dbname=$database");
793
    
794
=head2 database
795

            
796
    # Set and get database name
797
    $self     = $dbi->database($database);
798
    $database = $dbi->database;
799

            
800
This method will be used in subclass connect method.
801

            
802
=head2 dbi_options
803

            
804
    # Set and get DBI option
805
    $self       = $dbi->dbi_options({$options => $value, ...});
806
    $dbi_options = $dbi->dbi_options;
807

            
808
    # Sample
809
    $dbi->dbi_options({PrintError => 0, RaiseError => 1});
810

            
811
dbi_options is used when you connect database by using connect.
812

            
813
=head2 prepare
814

            
815
    $sth = $dbi->prepare($sql);
816

            
817
This method is same as DBI::prepare
818

            
819
=head2 do
820

            
821
    $dbi->do($sql, @bind_values);
822

            
823
This method is same as DBI::do
824

            
825
=head2 sql_template
826

            
827
    # Set and get SQL::Template object
828
    $self         = $dbi->sql_template($sql_template);
829
    $sql_template = $dbi->sql_template;
830
    
831
    # Sample
832
    $dbi->sql_template(DBI::Cutom::SQL::Template->new);
833

            
834
=head2 filters
835

            
836
    # Set and get filters
837
    $self    = $dbi->filters($filters);
838
    $filters = $dbi->filters;
839

            
840
=head2 formats
841

            
842
    # Set and get formats
843
    $self    = $dbi->formats($formats);
844
    $formats = $dbi->formats;
845
    
846
=head2 bind_filter
847

            
848
    # Set and get binding filter
849
    $self        = $dbi->bind_filter($bind_filter);
850
    $bind_filter = $dbi->bind_filter
851

            
852
    # Sample
853
    $dbi->bind_filter($self->filters->{default_bind_filter});
854
    
855

            
856
you can get DBI database handle if you need.
857

            
858
=head2 fetch_filter
859

            
860
    # Set and get Fetch filter
861
    $self         = $dbi->fetch_filter($fetch_filter);
862
    $fetch_filter = $dbi->fetch_filter;
863

            
864
    # Sample
865
    $dbi->fetch_filter($self->filters->{default_fetch_filter});
866

            
867
=head2 no_bind_filters
868

            
869
    # Set and get no filter keys when binding
870
    $self            = $dbi->no_bind_filters($no_bind_filters);
871
    $no_bind_filters = $dbi->no_bind_filters;
872

            
873
=head2 no_fetch_filters
874

            
875
    # Set and get no filter keys when fetching
876
    $self             = $dbi->no_fetch_filters($no_fetch_filters);
877
    $no_fetch_filters = $dbi->no_fetch_filters;
878

            
879
=head2 result_class
880

            
881
    # Set and get resultset class
882
    $self         = $dbi->result_class($result_class);
883
    $result_class = $dbi->result_class;
884
    
885
    # Sample
886
    $dbi->result_class('DBIx::Custom::Result');
887

            
888
=head2 dbh
889

            
890
    # Get database handle
891
    $dbh = $self->dbh;
892

            
893
=head1 METHODS
894

            
895
=head2 connect
896

            
897
    # Connect to database
898
    $self = $dbi->connect;
899
    
900
    # Sample
901
    $dbi = DBIx::Custom->new(user => 'taro', password => 'lji8(', 
902
                            data_soruce => "dbi:mysql:dbname=$database");
903
    $dbi->connect;
904

            
905
=head2 disconnect
906

            
907
    # Disconnect database
908
    $dbi->disconnect;
909

            
910
If database is already disconnected, this method do noting.
911

            
912
=head2 reconnect
913

            
914
    # Reconnect
915
    $dbi->reconnect;
916

            
917
=head2 connected
918

            
919
    # Check connected
920
    $dbi->connected
921
    
922
=head2 filter_off
923

            
924
    # bind_filter and fitch_filter off
925
    $self->filter_off;
926
    
927
This is equeal to
928
    
929
    $self->bind_filter(undef);
930
    $self->fetch_filter(undef);
931

            
932
=head2 add_filter
933

            
934
    # Add filter (hash ref or hash can be recieve)
935
    $self = $dbi->add_filter({$filter_name => $filter, ...});
936
    $self = $dbi->add_filter($filetr_name => $filter, ...);
937
    
938
    # Sample
939
    $dbi->add_filter(
940
        decode_utf8 => sub {
941
            my ($key, $value, $table, $column) = @_;
942
            return Encode::decode('UTF-8', $value);
943
        },
944
        datetime_to_string => sub {
945
            my ($key, $value, $table, $column) = @_;
946
            return $value->strftime('%Y-%m-%d %H:%M:%S')
947
        },
948
        default_bind_filter => sub {
949
            my ($key, $value, $table, $column) = @_;
950
            if (ref $value eq 'Time::Piece') {
951
                return $dbi->filters->{datetime_to_string}->($value);
952
            }
953
            else {
954
                return $dbi->filters->{decode_utf8}->($value);
955
            }
956
        },
957
        
958
        encode_utf8 => sub {
959
            my ($key, $value) = @_;
960
            return Encode::encode('UTF-8', $value);
961
        },
962
        string_to_datetime => sub {
963
            my ($key, $value) = @_;
964
            return DateTime::Format::MySQL->parse_datetime($value);
965
        },
966
        default_fetch_filter => sub {
967
            my ($key, $value, $type, $sth, $i) = @_;
968
            if ($type eq 'DATETIME') {
969
                return $dbi->filters->{string_to_datetime}->($value);
970
            }
971
            else {
972
                return $dbi->filters->{encode_utf8}->($value);
973
            }
974
        }
975
    );
976

            
977
add_filter add filter to filters
978

            
979
=head2 add_format
980

            
981
    $dbi->add_format(date => '%Y:%m:%d');
982

            
983
=head2 create_query
984
    
985
    # Create Query object from SQL template
986
    my $query = $dbi->create_query($template);
987
    
988
=head2 execute
989

            
990
    # Parse SQL template and execute SQL
991
    $result = $dbi->query($query, $params);
992
    $result = $dbi->query($template, $params); # Shorcut
993
    
994
    # Sample
995
    $result = $dbi->query("select * from authors where {= name} and {= age}", 
996
                          {author => 'taro', age => 19});
997
    
998
    while (my @row = $result->fetch) {
999
        # do something
1000
    }
1001

            
1002
See also L<DBIx::Custom::SQL::Template>
1003

            
1004
=head2 run_transaction
1005

            
1006
    # Run transaction
1007
    $dbi->run_transaction(sub {
1008
        # do something
1009
    });
1010

            
1011
If transaction is success, commit is execute. 
1012
If tranzation is died, rollback is execute.
1013

            
1014
=head2 insert
1015

            
1016
    # Insert
1017
    $dbi->insert($table, $insert_values);
1018
    
1019
    # Sample
1020
    $dbi->insert('books', {title => 'Perl', author => 'Taro'});
1021

            
1022
=head2 update
1023

            
1024
    # Update
1025
    $dbi->update($table, $update_values, $where);
1026
    
1027
    # Sample
1028
    $dbi->update('books', {title => 'Perl', author => 'Taro'}, {id => 5});
1029

            
1030
=head2 update_all
1031

            
1032
    # Update all rows
1033
    $dbi->update($table, $updat_values);
1034

            
1035
=head2 delete
1036

            
1037
    # Delete
1038
    $dbi->delete($table, $where);
1039
    
1040
    # Sample
1041
    $dbi->delete('Books', {id => 5});
1042

            
1043
=head2 delete_all
1044

            
1045
    # Delete all rows
1046
    $dbi->delete_all($table);
1047

            
1048
=head2 last_insert_id
1049

            
1050
    # Get last insert id
1051
    $last_insert_id = $dbi->last_insert_id;
1052
    
1053
This method is same as DBI last_insert_id;
1054

            
1055
=head2 select
1056
    
1057
    # Select
1058
    $dbi->select(
1059
        $table,                # must be string or array;
1060
        [@$columns],           # must be array reference. this is optional
1061
        {%$where_params},      # must be hash reference.  this is optional
1062
        $append_statement,     # must be string.          this is optional
1063
        $query_edit_callback   # must be code reference.  this is optional
1064
    );
1065
    
1066
    # Sample
1067
    $dbi->select(
1068
        'Books',
1069
        ['title', 'author'],
1070
        {id => 1},
1071
        "for update",
1072
        sub {
1073
            my $query = shift;
1074
            $query->bind_filter(sub {
1075
                # ...
1076
            });
1077
        }
1078
    );
1079
    
1080
    # The way to join multi tables
1081
    $dbi->select(
1082
        ['table1', 'table2'],
1083
        ['table1.id as table1_id', 'title'],
1084
        {table1.id => 1},
1085
        "where table1.id = table2.id",
1086
    );
1087

            
1088
=head1 Class Accessors
1089

            
1090
=head2 query_cache_max
1091

            
1092
    # Max query cache count
1093
    $class           = $class->query_cache_max($query_cache_max);
1094
    $query_cache_max = $class->query_cache_max;
1095
    
1096
    # Sample
1097
    DBIx::Custom->query_cache_max(50);
1098

            
1099
=head1 CAUTION
1100

            
1101
DBIx::Custom have DIB object internal.
1102
This module is work well in the following DBI condition.
1103

            
1104
    1. AutoCommit is true
1105
    2. RaiseError is true
1106

            
1107
By default, Both AutoCommit and RaiseError is true.
1108
You must not change these mode not to damage your data.
1109

            
1110
If you change these mode, 
1111
you cannot get correct error message, 
1112
or run_transaction may fail.
1113

            
1114
=head1 AUTHOR
1115

            
1116
Yuki Kimoto, C<< <kimoto.yuki at gmail.com> >>
1117

            
1118
Github L<http://github.com/yuki-kimoto>
1119

            
1120
=head1 COPYRIGHT & LICENSE
1121

            
1122
Copyright 2009 Yuki Kimoto, all rights reserved.
1123

            
1124
This program is free software; you can redistribute it and/or modify it
1125
under the same terms as Perl itself.
1126

            
1127
=cut