DBIx-Custom / lib / DBIx / Custom.pm /
Newer Older
1156 lines | 29.963kb
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'} }
add port and host method
yuki-kimoto authored on 2009-11-16
22
sub host        : ClassObjectAttr { initialize => {clone => 'scalar'} }
23
sub port        : ClassObjectAttr { initialize => {clone => 'scalar'} }
packaging one directory
yuki-kimoto authored on 2009-11-16
24

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

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

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

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

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

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

            
63
### Object Accessor
64
sub dbh          : Attr {}
65

            
66

            
67
### Methods
68

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
750
Object::Simple->build_class;
751

            
752
=head1 NAME
753

            
754
DBIx::Custom - Customizable simple DBI
755

            
756
=head1 VERSION
757

            
758
Version 0.0501
759

            
760
=head1 CAUTION
761

            
762
This module is now experimental stage.
763

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

            
767
Please tell me bug if you find
768

            
769
=head1 SYNOPSIS
770

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

            
776
=head1 CLASS-OBJECT ACCESSORS
777

            
778
=head2 user
779

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

            
787
=head2 password
788

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

            
796
=head2 data_source
797

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

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

            
add port and host method
yuki-kimoto authored on 2009-11-16
817
=head2 host
818

            
819
    # Set and get host name
820
    $self = $dbi->host($host);
821
    $host = $dbi->host;
822

            
823
=head2 port
824

            
825
    # Set and get port
826
    $self = $dbi->port($port);
827
    $port = $dbi->port;
828

            
packaging one directory
yuki-kimoto authored on 2009-11-16
829
This method will be used in subclass connect method.
830

            
831
=head2 dbi_options
832

            
833
    # Set and get DBI option
834
    $self       = $dbi->dbi_options({$options => $value, ...});
835
    $dbi_options = $dbi->dbi_options;
836

            
837
    # Sample
838
    $dbi->dbi_options({PrintError => 0, RaiseError => 1});
839

            
840
dbi_options is used when you connect database by using connect.
841

            
842
=head2 prepare
843

            
844
    $sth = $dbi->prepare($sql);
845

            
846
This method is same as DBI::prepare
847

            
848
=head2 do
849

            
850
    $dbi->do($sql, @bind_values);
851

            
852
This method is same as DBI::do
853

            
854
=head2 sql_template
855

            
856
    # Set and get SQL::Template object
857
    $self         = $dbi->sql_template($sql_template);
858
    $sql_template = $dbi->sql_template;
859
    
860
    # Sample
861
    $dbi->sql_template(DBI::Cutom::SQL::Template->new);
862

            
863
=head2 filters
864

            
865
    # Set and get filters
866
    $self    = $dbi->filters($filters);
867
    $filters = $dbi->filters;
868

            
869
=head2 formats
870

            
871
    # Set and get formats
872
    $self    = $dbi->formats($formats);
873
    $formats = $dbi->formats;
874
    
875
=head2 bind_filter
876

            
877
    # Set and get binding filter
878
    $self        = $dbi->bind_filter($bind_filter);
879
    $bind_filter = $dbi->bind_filter
880

            
881
    # Sample
882
    $dbi->bind_filter($self->filters->{default_bind_filter});
883
    
884

            
885
you can get DBI database handle if you need.
886

            
887
=head2 fetch_filter
888

            
889
    # Set and get Fetch filter
890
    $self         = $dbi->fetch_filter($fetch_filter);
891
    $fetch_filter = $dbi->fetch_filter;
892

            
893
    # Sample
894
    $dbi->fetch_filter($self->filters->{default_fetch_filter});
895

            
896
=head2 no_bind_filters
897

            
898
    # Set and get no filter keys when binding
899
    $self            = $dbi->no_bind_filters($no_bind_filters);
900
    $no_bind_filters = $dbi->no_bind_filters;
901

            
902
=head2 no_fetch_filters
903

            
904
    # Set and get no filter keys when fetching
905
    $self             = $dbi->no_fetch_filters($no_fetch_filters);
906
    $no_fetch_filters = $dbi->no_fetch_filters;
907

            
908
=head2 result_class
909

            
910
    # Set and get resultset class
911
    $self         = $dbi->result_class($result_class);
912
    $result_class = $dbi->result_class;
913
    
914
    # Sample
915
    $dbi->result_class('DBIx::Custom::Result');
916

            
917
=head2 dbh
918

            
919
    # Get database handle
920
    $dbh = $self->dbh;
921

            
922
=head1 METHODS
923

            
924
=head2 connect
925

            
926
    # Connect to database
927
    $self = $dbi->connect;
928
    
929
    # Sample
930
    $dbi = DBIx::Custom->new(user => 'taro', password => 'lji8(', 
931
                            data_soruce => "dbi:mysql:dbname=$database");
932
    $dbi->connect;
933

            
934
=head2 disconnect
935

            
936
    # Disconnect database
937
    $dbi->disconnect;
938

            
939
If database is already disconnected, this method do noting.
940

            
941
=head2 reconnect
942

            
943
    # Reconnect
944
    $dbi->reconnect;
945

            
946
=head2 connected
947

            
948
    # Check connected
949
    $dbi->connected
950
    
951
=head2 filter_off
952

            
953
    # bind_filter and fitch_filter off
954
    $self->filter_off;
955
    
956
This is equeal to
957
    
958
    $self->bind_filter(undef);
959
    $self->fetch_filter(undef);
960

            
961
=head2 add_filter
962

            
963
    # Add filter (hash ref or hash can be recieve)
964
    $self = $dbi->add_filter({$filter_name => $filter, ...});
965
    $self = $dbi->add_filter($filetr_name => $filter, ...);
966
    
967
    # Sample
968
    $dbi->add_filter(
969
        decode_utf8 => sub {
970
            my ($key, $value, $table, $column) = @_;
971
            return Encode::decode('UTF-8', $value);
972
        },
973
        datetime_to_string => sub {
974
            my ($key, $value, $table, $column) = @_;
975
            return $value->strftime('%Y-%m-%d %H:%M:%S')
976
        },
977
        default_bind_filter => sub {
978
            my ($key, $value, $table, $column) = @_;
979
            if (ref $value eq 'Time::Piece') {
980
                return $dbi->filters->{datetime_to_string}->($value);
981
            }
982
            else {
983
                return $dbi->filters->{decode_utf8}->($value);
984
            }
985
        },
986
        
987
        encode_utf8 => sub {
988
            my ($key, $value) = @_;
989
            return Encode::encode('UTF-8', $value);
990
        },
991
        string_to_datetime => sub {
992
            my ($key, $value) = @_;
993
            return DateTime::Format::MySQL->parse_datetime($value);
994
        },
995
        default_fetch_filter => sub {
996
            my ($key, $value, $type, $sth, $i) = @_;
997
            if ($type eq 'DATETIME') {
998
                return $dbi->filters->{string_to_datetime}->($value);
999
            }
1000
            else {
1001
                return $dbi->filters->{encode_utf8}->($value);
1002
            }
1003
        }
1004
    );
1005

            
1006
add_filter add filter to filters
1007

            
1008
=head2 add_format
1009

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

            
1012
=head2 create_query
1013
    
1014
    # Create Query object from SQL template
1015
    my $query = $dbi->create_query($template);
1016
    
1017
=head2 execute
1018

            
1019
    # Parse SQL template and execute SQL
1020
    $result = $dbi->query($query, $params);
1021
    $result = $dbi->query($template, $params); # Shorcut
1022
    
1023
    # Sample
1024
    $result = $dbi->query("select * from authors where {= name} and {= age}", 
1025
                          {author => 'taro', age => 19});
1026
    
1027
    while (my @row = $result->fetch) {
1028
        # do something
1029
    }
1030

            
1031
See also L<DBIx::Custom::SQL::Template>
1032

            
1033
=head2 run_transaction
1034

            
1035
    # Run transaction
1036
    $dbi->run_transaction(sub {
1037
        # do something
1038
    });
1039

            
1040
If transaction is success, commit is execute. 
1041
If tranzation is died, rollback is execute.
1042

            
1043
=head2 insert
1044

            
1045
    # Insert
1046
    $dbi->insert($table, $insert_values);
1047
    
1048
    # Sample
1049
    $dbi->insert('books', {title => 'Perl', author => 'Taro'});
1050

            
1051
=head2 update
1052

            
1053
    # Update
1054
    $dbi->update($table, $update_values, $where);
1055
    
1056
    # Sample
1057
    $dbi->update('books', {title => 'Perl', author => 'Taro'}, {id => 5});
1058

            
1059
=head2 update_all
1060

            
1061
    # Update all rows
1062
    $dbi->update($table, $updat_values);
1063

            
1064
=head2 delete
1065

            
1066
    # Delete
1067
    $dbi->delete($table, $where);
1068
    
1069
    # Sample
1070
    $dbi->delete('Books', {id => 5});
1071

            
1072
=head2 delete_all
1073

            
1074
    # Delete all rows
1075
    $dbi->delete_all($table);
1076

            
1077
=head2 last_insert_id
1078

            
1079
    # Get last insert id
1080
    $last_insert_id = $dbi->last_insert_id;
1081
    
1082
This method is same as DBI last_insert_id;
1083

            
1084
=head2 select
1085
    
1086
    # Select
1087
    $dbi->select(
1088
        $table,                # must be string or array;
1089
        [@$columns],           # must be array reference. this is optional
1090
        {%$where_params},      # must be hash reference.  this is optional
1091
        $append_statement,     # must be string.          this is optional
1092
        $query_edit_callback   # must be code reference.  this is optional
1093
    );
1094
    
1095
    # Sample
1096
    $dbi->select(
1097
        'Books',
1098
        ['title', 'author'],
1099
        {id => 1},
1100
        "for update",
1101
        sub {
1102
            my $query = shift;
1103
            $query->bind_filter(sub {
1104
                # ...
1105
            });
1106
        }
1107
    );
1108
    
1109
    # The way to join multi tables
1110
    $dbi->select(
1111
        ['table1', 'table2'],
1112
        ['table1.id as table1_id', 'title'],
1113
        {table1.id => 1},
1114
        "where table1.id = table2.id",
1115
    );
1116

            
1117
=head1 Class Accessors
1118

            
1119
=head2 query_cache_max
1120

            
1121
    # Max query cache count
1122
    $class           = $class->query_cache_max($query_cache_max);
1123
    $query_cache_max = $class->query_cache_max;
1124
    
1125
    # Sample
1126
    DBIx::Custom->query_cache_max(50);
1127

            
1128
=head1 CAUTION
1129

            
1130
DBIx::Custom have DIB object internal.
1131
This module is work well in the following DBI condition.
1132

            
1133
    1. AutoCommit is true
1134
    2. RaiseError is true
1135

            
1136
By default, Both AutoCommit and RaiseError is true.
1137
You must not change these mode not to damage your data.
1138

            
1139
If you change these mode, 
1140
you cannot get correct error message, 
1141
or run_transaction may fail.
1142

            
1143
=head1 AUTHOR
1144

            
1145
Yuki Kimoto, C<< <kimoto.yuki at gmail.com> >>
1146

            
1147
Github L<http://github.com/yuki-kimoto>
1148

            
1149
=head1 COPYRIGHT & LICENSE
1150

            
1151
Copyright 2009 Yuki Kimoto, all rights reserved.
1152

            
1153
This program is free software; you can redistribute it and/or modify it
1154
under the same terms as Perl itself.
1155

            
1156
=cut