DBIx-Custom / lib / DBIx / Custom.pm /
Newer Older
1123 lines | 28.748kb
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;
add Oracle, DB2, Pg,
yuki-kimoto authored on 2009-11-16
451
    my $class = ref $self;
452
    croak "'$class' do not suppert 'last_insert_id'";
packaging one directory
yuki-kimoto authored on 2009-11-16
453
}
454

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

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

            
545
# Update all rows
546
sub update_all {
547
    my ($self, $table, $update_params, $query_edit_cb) = @_;
548
    
549
    return $self->update($table, $update_params, {}, $query_edit_cb,
550
                         {allow_update_all => 1});
551
}
552

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

            
595
# Delete all rows
596
sub delete_all {
597
    my ($self, $table) = @_;
598
    return $self->delete($table, {}, undef, {allow_delete_all => 1});
599
}
600

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

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

            
689
sub _query_caches     : ClassAttr { type => 'hash',
690
                                    auto_build => sub {shift->_query_caches({}) } }
691
                                    
692
sub _query_cache_keys : ClassAttr { type => 'array',
693
                                    auto_build => sub {shift->_query_cache_keys([])} }
694
                                    
695
sub query_cache_max   : ClassAttr { auto_build => sub {shift->query_cache_max(50)} }
696

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

            
718
# Both bind_filter and fetch_filter off
719
sub filter_off {
720
    my $self = shift;
721
    
722
    # filter off
723
    $self->bind_filter(undef);
724
    $self->fetch_filter(undef);
725
    
726
    return $self;
727
}
728

            
729
Object::Simple->build_class;
730

            
731
=head1 NAME
732

            
733
DBIx::Custom - Customizable simple DBI
734

            
735
=head1 VERSION
736

            
737
Version 0.0501
738

            
739
=head1 CAUTION
740

            
741
This module is now experimental stage.
742

            
743
I want you to try this module
744
because I want this module stable, and not to damage your DB data by this module bug.
745

            
746
Please tell me bug if you find
747

            
748
=head1 SYNOPSIS
749

            
750
  my $dbi = DBIx::Custom->new;
751
  
752
  my $query = $dbi->create_query($template);
753
  $dbi->execute($query);
754

            
755
=head1 CLASS-OBJECT ACCESSORS
756

            
757
=head2 user
758

            
759
    # Set and get database user name
760
    $self = $dbi->user($user);
761
    $user = $dbi->user;
762
    
763
    # Sample
764
    $dbi->user('taro');
765

            
766
=head2 password
767

            
768
    # Set and get database password
769
    $self     = $dbi->password($password);
770
    $password = $dbi->password;
771
    
772
    # Sample
773
    $dbi->password('lkj&le`@s');
774

            
775
=head2 data_source
776

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

            
792
    # Set and get database name
793
    $self     = $dbi->database($database);
794
    $database = $dbi->database;
795

            
796
This method will be used in subclass connect method.
797

            
798
=head2 dbi_options
799

            
800
    # Set and get DBI option
801
    $self       = $dbi->dbi_options({$options => $value, ...});
802
    $dbi_options = $dbi->dbi_options;
803

            
804
    # Sample
805
    $dbi->dbi_options({PrintError => 0, RaiseError => 1});
806

            
807
dbi_options is used when you connect database by using connect.
808

            
809
=head2 prepare
810

            
811
    $sth = $dbi->prepare($sql);
812

            
813
This method is same as DBI::prepare
814

            
815
=head2 do
816

            
817
    $dbi->do($sql, @bind_values);
818

            
819
This method is same as DBI::do
820

            
821
=head2 sql_template
822

            
823
    # Set and get SQL::Template object
824
    $self         = $dbi->sql_template($sql_template);
825
    $sql_template = $dbi->sql_template;
826
    
827
    # Sample
828
    $dbi->sql_template(DBI::Cutom::SQL::Template->new);
829

            
830
=head2 filters
831

            
832
    # Set and get filters
833
    $self    = $dbi->filters($filters);
834
    $filters = $dbi->filters;
835

            
836
=head2 formats
837

            
838
    # Set and get formats
839
    $self    = $dbi->formats($formats);
840
    $formats = $dbi->formats;
841
    
842
=head2 bind_filter
843

            
844
    # Set and get binding filter
845
    $self        = $dbi->bind_filter($bind_filter);
846
    $bind_filter = $dbi->bind_filter
847

            
848
    # Sample
849
    $dbi->bind_filter($self->filters->{default_bind_filter});
850
    
851

            
852
you can get DBI database handle if you need.
853

            
854
=head2 fetch_filter
855

            
856
    # Set and get Fetch filter
857
    $self         = $dbi->fetch_filter($fetch_filter);
858
    $fetch_filter = $dbi->fetch_filter;
859

            
860
    # Sample
861
    $dbi->fetch_filter($self->filters->{default_fetch_filter});
862

            
863
=head2 no_bind_filters
864

            
865
    # Set and get no filter keys when binding
866
    $self            = $dbi->no_bind_filters($no_bind_filters);
867
    $no_bind_filters = $dbi->no_bind_filters;
868

            
869
=head2 no_fetch_filters
870

            
871
    # Set and get no filter keys when fetching
872
    $self             = $dbi->no_fetch_filters($no_fetch_filters);
873
    $no_fetch_filters = $dbi->no_fetch_filters;
874

            
875
=head2 result_class
876

            
877
    # Set and get resultset class
878
    $self         = $dbi->result_class($result_class);
879
    $result_class = $dbi->result_class;
880
    
881
    # Sample
882
    $dbi->result_class('DBIx::Custom::Result');
883

            
884
=head2 dbh
885

            
886
    # Get database handle
887
    $dbh = $self->dbh;
888

            
889
=head1 METHODS
890

            
891
=head2 connect
892

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

            
901
=head2 disconnect
902

            
903
    # Disconnect database
904
    $dbi->disconnect;
905

            
906
If database is already disconnected, this method do noting.
907

            
908
=head2 reconnect
909

            
910
    # Reconnect
911
    $dbi->reconnect;
912

            
913
=head2 connected
914

            
915
    # Check connected
916
    $dbi->connected
917
    
918
=head2 filter_off
919

            
920
    # bind_filter and fitch_filter off
921
    $self->filter_off;
922
    
923
This is equeal to
924
    
925
    $self->bind_filter(undef);
926
    $self->fetch_filter(undef);
927

            
928
=head2 add_filter
929

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

            
973
add_filter add filter to filters
974

            
975
=head2 add_format
976

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

            
979
=head2 create_query
980
    
981
    # Create Query object from SQL template
982
    my $query = $dbi->create_query($template);
983
    
984
=head2 execute
985

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

            
998
See also L<DBIx::Custom::SQL::Template>
999

            
1000
=head2 run_transaction
1001

            
1002
    # Run transaction
1003
    $dbi->run_transaction(sub {
1004
        # do something
1005
    });
1006

            
1007
If transaction is success, commit is execute. 
1008
If tranzation is died, rollback is execute.
1009

            
1010
=head2 insert
1011

            
1012
    # Insert
1013
    $dbi->insert($table, $insert_values);
1014
    
1015
    # Sample
1016
    $dbi->insert('books', {title => 'Perl', author => 'Taro'});
1017

            
1018
=head2 update
1019

            
1020
    # Update
1021
    $dbi->update($table, $update_values, $where);
1022
    
1023
    # Sample
1024
    $dbi->update('books', {title => 'Perl', author => 'Taro'}, {id => 5});
1025

            
1026
=head2 update_all
1027

            
1028
    # Update all rows
1029
    $dbi->update($table, $updat_values);
1030

            
1031
=head2 delete
1032

            
1033
    # Delete
1034
    $dbi->delete($table, $where);
1035
    
1036
    # Sample
1037
    $dbi->delete('Books', {id => 5});
1038

            
1039
=head2 delete_all
1040

            
1041
    # Delete all rows
1042
    $dbi->delete_all($table);
1043

            
1044
=head2 last_insert_id
1045

            
1046
    # Get last insert id
1047
    $last_insert_id = $dbi->last_insert_id;
1048
    
1049
This method is same as DBI last_insert_id;
1050

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

            
1084
=head1 Class Accessors
1085

            
1086
=head2 query_cache_max
1087

            
1088
    # Max query cache count
1089
    $class           = $class->query_cache_max($query_cache_max);
1090
    $query_cache_max = $class->query_cache_max;
1091
    
1092
    # Sample
1093
    DBIx::Custom->query_cache_max(50);
1094

            
1095
=head1 CAUTION
1096

            
1097
DBIx::Custom have DIB object internal.
1098
This module is work well in the following DBI condition.
1099

            
1100
    1. AutoCommit is true
1101
    2. RaiseError is true
1102

            
1103
By default, Both AutoCommit and RaiseError is true.
1104
You must not change these mode not to damage your data.
1105

            
1106
If you change these mode, 
1107
you cannot get correct error message, 
1108
or run_transaction may fail.
1109

            
1110
=head1 AUTHOR
1111

            
1112
Yuki Kimoto, C<< <kimoto.yuki at gmail.com> >>
1113

            
1114
Github L<http://github.com/yuki-kimoto>
1115

            
1116
=head1 COPYRIGHT & LICENSE
1117

            
1118
Copyright 2009 Yuki Kimoto, all rights reserved.
1119

            
1120
This program is free software; you can redistribute it and/or modify it
1121
under the same terms as Perl itself.
1122

            
1123
=cut