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

            
489
# Update
490
sub update {
insert, update, delete appnd...
yuki-kimoto authored on 2009-11-16
491
    my $self             = shift;
492
    my $table            = shift || '';
493
    my $update_params    = shift || {};
494
    my $where_params     = shift || {};
495
    my $append_statement = shift unless ref $_[0];
496
    my $query_edit_cb    = shift;
497
    my $options          = shift;
packaging one directory
yuki-kimoto authored on 2009-11-16
498
    
499
    # Update keys
500
    my @update_keys = keys %$update_params;
501
    
502
    # Not exists update kyes
503
    croak("Key-value pairs for update must be specified to 'update' second argument")
504
      unless @update_keys;
505
    
506
    # Where keys
507
    my @where_keys = keys %$where_params;
508
    
509
    # Not exists where keys
510
    croak("Key-value pairs for where clause must be specified to 'update' third argument")
511
      if !@where_keys && !$options->{allow_update_all};
512
    
513
    # Update clause
514
    my $update_clause = '{update ' . join(' ', @update_keys) . '}';
515
    
516
    # Where clause
517
    my $where_clause = '';
518
    if (@where_keys) {
519
        $where_clause = 'where ';
520
        foreach my $where_key (@where_keys) {
521
            $where_clause .= "{= $where_key} and ";
522
        }
523
        $where_clause =~ s/ and $//;
524
    }
525
    
526
    # Template for update
527
    my $template = "update $table $update_clause $where_clause";
insert, update, delete appnd...
yuki-kimoto authored on 2009-11-16
528
    $template .= " $append_statement" if $append_statement;
packaging one directory
yuki-kimoto authored on 2009-11-16
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 {
insert, update, delete appnd...
yuki-kimoto authored on 2009-11-16
551
    my $self             = shift;
552
    my $table            = shift || '';
553
    my $update_params    = shift || {};
554
    my $append_statement = shift unless ref $_[0];
555
    my $query_edit_cb    = shift;
556
    my $options          = {allow_update_all => 1};
557
    
558
    return $self->update($table, $update_params, {}, $append_statement,
559
                         $query_edit_cb, $options);
packaging one directory
yuki-kimoto authored on 2009-11-16
560
}
561

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

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

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

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

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

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

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

            
748
Object::Simple->build_class;
749

            
750
=head1 NAME
751

            
752
DBIx::Custom - Customizable simple DBI
753

            
754
=head1 VERSION
755

            
756
Version 0.0501
757

            
758
=head1 CAUTION
759

            
760
This module is now experimental stage.
761

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

            
765
Please tell me bug if you find
766

            
767
=head1 SYNOPSIS
768

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

            
774
=head1 CLASS-OBJECT ACCESSORS
775

            
776
=head2 user
777

            
778
    # Set and get database user name
779
    $self = $dbi->user($user);
780
    $user = $dbi->user;
781
    
782
    # Sample
783
    $dbi->user('taro');
784

            
785
=head2 password
786

            
787
    # Set and get database password
788
    $self     = $dbi->password($password);
789
    $password = $dbi->password;
790
    
791
    # Sample
792
    $dbi->password('lkj&le`@s');
793

            
794
=head2 data_source
795

            
796
    # Set and get database data source
797
    $self        = $dbi->data_source($data_soruce);
798
    $data_source = $dbi->data_source;
799
    
800
    # Sample(SQLite)
801
    $dbi->data_source(dbi:SQLite:dbname=$database);
802
    
803
    # Sample(MySQL);
804
    $dbi->data_source("dbi:mysql:dbname=$database");
805
    
806
    # Sample(PostgreSQL)
807
    $dbi->data_source("dbi:Pg:dbname=$database");
808
    
809
=head2 database
810

            
811
    # Set and get database name
812
    $self     = $dbi->database($database);
813
    $database = $dbi->database;
814

            
815
This method will be used in subclass connect method.
816

            
817
=head2 dbi_options
818

            
819
    # Set and get DBI option
820
    $self       = $dbi->dbi_options({$options => $value, ...});
821
    $dbi_options = $dbi->dbi_options;
822

            
823
    # Sample
824
    $dbi->dbi_options({PrintError => 0, RaiseError => 1});
825

            
826
dbi_options is used when you connect database by using connect.
827

            
828
=head2 prepare
829

            
830
    $sth = $dbi->prepare($sql);
831

            
832
This method is same as DBI::prepare
833

            
834
=head2 do
835

            
836
    $dbi->do($sql, @bind_values);
837

            
838
This method is same as DBI::do
839

            
840
=head2 sql_template
841

            
842
    # Set and get SQL::Template object
843
    $self         = $dbi->sql_template($sql_template);
844
    $sql_template = $dbi->sql_template;
845
    
846
    # Sample
847
    $dbi->sql_template(DBI::Cutom::SQL::Template->new);
848

            
849
=head2 filters
850

            
851
    # Set and get filters
852
    $self    = $dbi->filters($filters);
853
    $filters = $dbi->filters;
854

            
855
=head2 formats
856

            
857
    # Set and get formats
858
    $self    = $dbi->formats($formats);
859
    $formats = $dbi->formats;
860
    
861
=head2 bind_filter
862

            
863
    # Set and get binding filter
864
    $self        = $dbi->bind_filter($bind_filter);
865
    $bind_filter = $dbi->bind_filter
866

            
867
    # Sample
868
    $dbi->bind_filter($self->filters->{default_bind_filter});
869
    
870

            
871
you can get DBI database handle if you need.
872

            
873
=head2 fetch_filter
874

            
875
    # Set and get Fetch filter
876
    $self         = $dbi->fetch_filter($fetch_filter);
877
    $fetch_filter = $dbi->fetch_filter;
878

            
879
    # Sample
880
    $dbi->fetch_filter($self->filters->{default_fetch_filter});
881

            
882
=head2 no_bind_filters
883

            
884
    # Set and get no filter keys when binding
885
    $self            = $dbi->no_bind_filters($no_bind_filters);
886
    $no_bind_filters = $dbi->no_bind_filters;
887

            
888
=head2 no_fetch_filters
889

            
890
    # Set and get no filter keys when fetching
891
    $self             = $dbi->no_fetch_filters($no_fetch_filters);
892
    $no_fetch_filters = $dbi->no_fetch_filters;
893

            
894
=head2 result_class
895

            
896
    # Set and get resultset class
897
    $self         = $dbi->result_class($result_class);
898
    $result_class = $dbi->result_class;
899
    
900
    # Sample
901
    $dbi->result_class('DBIx::Custom::Result');
902

            
903
=head2 dbh
904

            
905
    # Get database handle
906
    $dbh = $self->dbh;
907

            
908
=head1 METHODS
909

            
910
=head2 connect
911

            
912
    # Connect to database
913
    $self = $dbi->connect;
914
    
915
    # Sample
916
    $dbi = DBIx::Custom->new(user => 'taro', password => 'lji8(', 
917
                            data_soruce => "dbi:mysql:dbname=$database");
918
    $dbi->connect;
919

            
920
=head2 disconnect
921

            
922
    # Disconnect database
923
    $dbi->disconnect;
924

            
925
If database is already disconnected, this method do noting.
926

            
927
=head2 reconnect
928

            
929
    # Reconnect
930
    $dbi->reconnect;
931

            
932
=head2 connected
933

            
934
    # Check connected
935
    $dbi->connected
936
    
937
=head2 filter_off
938

            
939
    # bind_filter and fitch_filter off
940
    $self->filter_off;
941
    
942
This is equeal to
943
    
944
    $self->bind_filter(undef);
945
    $self->fetch_filter(undef);
946

            
947
=head2 add_filter
948

            
949
    # Add filter (hash ref or hash can be recieve)
950
    $self = $dbi->add_filter({$filter_name => $filter, ...});
951
    $self = $dbi->add_filter($filetr_name => $filter, ...);
952
    
953
    # Sample
954
    $dbi->add_filter(
955
        decode_utf8 => sub {
956
            my ($key, $value, $table, $column) = @_;
957
            return Encode::decode('UTF-8', $value);
958
        },
959
        datetime_to_string => sub {
960
            my ($key, $value, $table, $column) = @_;
961
            return $value->strftime('%Y-%m-%d %H:%M:%S')
962
        },
963
        default_bind_filter => sub {
964
            my ($key, $value, $table, $column) = @_;
965
            if (ref $value eq 'Time::Piece') {
966
                return $dbi->filters->{datetime_to_string}->($value);
967
            }
968
            else {
969
                return $dbi->filters->{decode_utf8}->($value);
970
            }
971
        },
972
        
973
        encode_utf8 => sub {
974
            my ($key, $value) = @_;
975
            return Encode::encode('UTF-8', $value);
976
        },
977
        string_to_datetime => sub {
978
            my ($key, $value) = @_;
979
            return DateTime::Format::MySQL->parse_datetime($value);
980
        },
981
        default_fetch_filter => sub {
982
            my ($key, $value, $type, $sth, $i) = @_;
983
            if ($type eq 'DATETIME') {
984
                return $dbi->filters->{string_to_datetime}->($value);
985
            }
986
            else {
987
                return $dbi->filters->{encode_utf8}->($value);
988
            }
989
        }
990
    );
991

            
992
add_filter add filter to filters
993

            
994
=head2 add_format
995

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

            
998
=head2 create_query
999
    
1000
    # Create Query object from SQL template
1001
    my $query = $dbi->create_query($template);
1002
    
1003
=head2 execute
1004

            
1005
    # Parse SQL template and execute SQL
1006
    $result = $dbi->query($query, $params);
1007
    $result = $dbi->query($template, $params); # Shorcut
1008
    
1009
    # Sample
1010
    $result = $dbi->query("select * from authors where {= name} and {= age}", 
1011
                          {author => 'taro', age => 19});
1012
    
1013
    while (my @row = $result->fetch) {
1014
        # do something
1015
    }
1016

            
1017
See also L<DBIx::Custom::SQL::Template>
1018

            
1019
=head2 run_transaction
1020

            
1021
    # Run transaction
1022
    $dbi->run_transaction(sub {
1023
        # do something
1024
    });
1025

            
1026
If transaction is success, commit is execute. 
1027
If tranzation is died, rollback is execute.
1028

            
1029
=head2 insert
1030

            
1031
    # Insert
1032
    $dbi->insert($table, $insert_values);
1033
    
1034
    # Sample
1035
    $dbi->insert('books', {title => 'Perl', author => 'Taro'});
1036

            
1037
=head2 update
1038

            
1039
    # Update
1040
    $dbi->update($table, $update_values, $where);
1041
    
1042
    # Sample
1043
    $dbi->update('books', {title => 'Perl', author => 'Taro'}, {id => 5});
1044

            
1045
=head2 update_all
1046

            
1047
    # Update all rows
1048
    $dbi->update($table, $updat_values);
1049

            
1050
=head2 delete
1051

            
1052
    # Delete
1053
    $dbi->delete($table, $where);
1054
    
1055
    # Sample
1056
    $dbi->delete('Books', {id => 5});
1057

            
1058
=head2 delete_all
1059

            
1060
    # Delete all rows
1061
    $dbi->delete_all($table);
1062

            
1063
=head2 last_insert_id
1064

            
1065
    # Get last insert id
1066
    $last_insert_id = $dbi->last_insert_id;
1067
    
1068
This method is same as DBI last_insert_id;
1069

            
1070
=head2 select
1071
    
1072
    # Select
1073
    $dbi->select(
1074
        $table,                # must be string or array;
1075
        [@$columns],           # must be array reference. this is optional
1076
        {%$where_params},      # must be hash reference.  this is optional
1077
        $append_statement,     # must be string.          this is optional
1078
        $query_edit_callback   # must be code reference.  this is optional
1079
    );
1080
    
1081
    # Sample
1082
    $dbi->select(
1083
        'Books',
1084
        ['title', 'author'],
1085
        {id => 1},
1086
        "for update",
1087
        sub {
1088
            my $query = shift;
1089
            $query->bind_filter(sub {
1090
                # ...
1091
            });
1092
        }
1093
    );
1094
    
1095
    # The way to join multi tables
1096
    $dbi->select(
1097
        ['table1', 'table2'],
1098
        ['table1.id as table1_id', 'title'],
1099
        {table1.id => 1},
1100
        "where table1.id = table2.id",
1101
    );
1102

            
1103
=head1 Class Accessors
1104

            
1105
=head2 query_cache_max
1106

            
1107
    # Max query cache count
1108
    $class           = $class->query_cache_max($query_cache_max);
1109
    $query_cache_max = $class->query_cache_max;
1110
    
1111
    # Sample
1112
    DBIx::Custom->query_cache_max(50);
1113

            
1114
=head1 CAUTION
1115

            
1116
DBIx::Custom have DIB object internal.
1117
This module is work well in the following DBI condition.
1118

            
1119
    1. AutoCommit is true
1120
    2. RaiseError is true
1121

            
1122
By default, Both AutoCommit and RaiseError is true.
1123
You must not change these mode not to damage your data.
1124

            
1125
If you change these mode, 
1126
you cannot get correct error message, 
1127
or run_transaction may fail.
1128

            
1129
=head1 AUTHOR
1130

            
1131
Yuki Kimoto, C<< <kimoto.yuki at gmail.com> >>
1132

            
1133
Github L<http://github.com/yuki-kimoto>
1134

            
1135
=head1 COPYRIGHT & LICENSE
1136

            
1137
Copyright 2009 Yuki Kimoto, all rights reserved.
1138

            
1139
This program is free software; you can redistribute it and/or modify it
1140
under the same terms as Perl itself.
1141

            
1142
=cut