DBIx-Custom / lib / DBIx / Custom.pm /
Newer Older
1306 lines | 33.048kb
cleanup
yuki-kimoto authored on 2009-12-22
1
package DBIx::Custom;
2
use base 'Object::Simple::Base';
3

            
4
use strict;
5
use warnings;
6

            
packaging one directory
yuki-kimoto authored on 2009-11-16
7
use 5.008001;
8

            
9

            
version 0.0901
yuki-kimoto authored on 2009-12-17
10
our $VERSION = '0.0901';
packaging one directory
yuki-kimoto authored on 2009-11-16
11

            
12
use Carp 'croak';
13
use DBI;
14
use DBIx::Custom::Result;
15
use DBIx::Custom::SQL::Template;
16

            
cleanup
yuki-kimoto authored on 2009-12-22
17
my $p = __PACKAGE__;
packaging one directory
yuki-kimoto authored on 2009-11-16
18

            
cleanup
yuki-kimoto authored on 2009-12-22
19
$p->attr('dbh');
packaging one directory
yuki-kimoto authored on 2009-11-16
20

            
cleanup
yuki-kimoto authored on 2009-12-22
21
$p->class_attr(_query_caches     => (type => 'hash',  default => sub { {} }))
22
  ->class_attr(_query_cache_keys => (type => 'array', default => sub { [] }))
23
  ->class_attr(query_cache_max   => 50);
packaging one directory
yuki-kimoto authored on 2009-11-16
24

            
cleanup
yuki-kimoto authored on 2009-12-22
25
$p->hybrid_attr([qw/user password data_source
26
                   database host port 
27
                   bind_filter fetch_filter/] => (clone => 'scalar'));
version 0.0901
yuki-kimoto authored on 2009-12-17
28

            
cleanup
yuki-kimoto authored on 2009-12-22
29
$p->hybrid_attr([qw/no_bind_filters no_fetch_filters/]
30
            => (type => 'array', default => sub { [] }, clone => 'array'));
packaging one directory
yuki-kimoto authored on 2009-11-16
31

            
cleanup
yuki-kimoto authored on 2009-12-22
32
$p->hybrid_attr(options => (type  => 'hash', default => sub { {} },
33
                            clone => 'hash'));
packaging one directory
yuki-kimoto authored on 2009-11-16
34

            
cleanup
yuki-kimoto authored on 2009-12-22
35
$p->hybrid_attr([qw/filters formats/]
36
            => (type => 'hash', default => sub { {} },
37
                deref => 1,     clone   => 'hash'));
packaging one directory
yuki-kimoto authored on 2009-11-16
38

            
cleanup
yuki-kimoto authored on 2009-12-22
39
$p->hybrid_attr(result_class => (default => 'DBIx::Custom::Result',
40
                                 clone   => 'scalar'));
packaging one directory
yuki-kimoto authored on 2009-11-16
41

            
cleanup
yuki-kimoto authored on 2009-12-22
42
$p->hybrid_attr(sql_tmpl => (default => sub {DBIx::Custom::SQL::Template->new},
43
                             clone => sub {$_[0] ? $_[0]->clone : undef}));
packaging one directory
yuki-kimoto authored on 2009-11-16
44

            
45
### Methods
46

            
47
sub add_filter {
48
    my $invocant = shift;
49
    
50
    my %old_filters = $invocant->filters;
51
    my %new_filters = ref $_[0] eq 'HASH' ? %{$_[0]} : @_;
52
    $invocant->filters(%old_filters, %new_filters);
53
    return $invocant;
54
}
55

            
56
sub add_format{
57
    my $invocant = shift;
58
    
59
    my %old_formats = $invocant->formats;
60
    my %new_formats = ref $_[0] eq 'HASH' ? %{$_[0]} : @_;
61
    $invocant->formats(%old_formats, %new_formats);
62
    return $invocant;
63
}
64

            
65
sub _auto_commit {
66
    my $self = shift;
67
    
68
    croak("Not yet connect to database") unless $self->dbh;
69
    
70
    if (@_) {
71
        $self->dbh->{AutoCommit} = $_[0];
72
        return $self;
73
    }
74
    return $self->dbh->{AutoCommit};
75
}
76

            
77
sub connect {
78
    my $self = shift;
79
    my $data_source = $self->data_source;
80
    my $user        = $self->user;
81
    my $password    = $self->password;
version 0.0901
yuki-kimoto authored on 2009-12-17
82
    my $options     = $self->options;
packaging one directory
yuki-kimoto authored on 2009-11-16
83
    
84
    my $dbh = eval{DBI->connect(
85
        $data_source,
86
        $user,
87
        $password,
88
        {
89
            RaiseError => 1,
90
            PrintError => 0,
91
            AutoCommit => 1,
version 0.0901
yuki-kimoto authored on 2009-12-17
92
            %{$options || {} }
packaging one directory
yuki-kimoto authored on 2009-11-16
93
        }
94
    )};
95
    
96
    croak $@ if $@;
97
    
98
    $self->dbh($dbh);
99
    return $self;
100
}
101

            
102
sub DESTROY {
103
    my $self = shift;
104
    $self->disconnect if $self->connected;
105
}
106

            
107
sub connected {
108
    my $self = shift;
109
    return ref $self->{dbh} eq 'DBI::db';
110
}
111

            
112
sub disconnect {
113
    my $self = shift;
114
    if ($self->connected) {
115
        $self->dbh->disconnect;
116
        delete $self->{dbh};
117
    }
118
}
119

            
120
sub reconnect {
121
    my $self = shift;
122
    $self->disconnect if $self->connected;
123
    $self->connect;
124
}
125

            
126
sub prepare {
127
    my ($self, $sql) = @_;
128
    
129
    # Connect if not
130
    $self->connect unless $self->connected;
131
    
132
    # Prepare
133
    my $sth = eval{$self->dbh->prepare($sql)};
134
    
135
    # Error
136
    croak("$@<Your SQL>\n$sql") if $@;
137
    
138
    return $sth;
139
}
140

            
141
sub do{
142
    my ($self, $sql, @bind_values) = @_;
143
    
144
    # Connect if not
145
    $self->connect unless $self->connected;
146
    
147
    # Do
version 0.0901
yuki-kimoto authored on 2009-12-17
148
    my $affected = eval{$self->dbh->do($sql, @bind_values)};
packaging one directory
yuki-kimoto authored on 2009-11-16
149
    
150
    # Error
151
    if ($@) {
152
        my $error = $@;
153
        require Data::Dumper;
154
        
155
        my $bind_value_dump
156
          = Data::Dumper->Dump([\@bind_values], ['*bind_valuds']);
157
        
158
        croak("$error<Your SQL>\n$sql\n<Your bind values>\n$bind_value_dump\n");
159
    }
version 0.0901
yuki-kimoto authored on 2009-12-17
160
    
161
    return $affected;
packaging one directory
yuki-kimoto authored on 2009-11-16
162
}
163

            
164
sub create_query {
165
    my ($self, $template) = @_;
166
    my $class = ref $self;
167
    
168
    # Create query from SQL template
version 0.0901
yuki-kimoto authored on 2009-12-17
169
    my $sql_tmpl = $self->sql_tmpl;
packaging one directory
yuki-kimoto authored on 2009-11-16
170
    
171
    # Try to get cached query
fix timeformat tests
yuki-kimoto authored on 2009-11-23
172
    my $cached_query = $class->_query_caches->{$template};
packaging one directory
yuki-kimoto authored on 2009-11-16
173
    
174
    # Create query
fix timeformat tests
yuki-kimoto authored on 2009-11-23
175
    my $query;
176
    if ($query) {
177
        $query = $self->new(sql       => $cached_query->sql, 
178
                            key_infos => $cached_query->key_infos);
179
    }
180
    else {
version 0.0901
yuki-kimoto authored on 2009-12-17
181
        $query = eval{$sql_tmpl->create_query($template)};
packaging one directory
yuki-kimoto authored on 2009-11-16
182
        croak($@) if $@;
183
        
184
        $class->_add_query_cache($template, $query);
185
    }
186
    
187
    # Connect if not
188
    $self->connect unless $self->connected;
189
    
190
    # Prepare statement handle
191
    my $sth = $self->prepare($query->{sql});
192
    
193
    # Set statement handle
194
    $query->sth($sth);
195
    
196
    # Set bind filter
197
    $query->bind_filter($self->bind_filter);
198
    
199
    # Set no filter keys when binding
200
    $query->no_bind_filters($self->no_bind_filters);
201
    
202
    # Set fetch filter
203
    $query->fetch_filter($self->fetch_filter);
204
    
205
    # Set no filter keys when fetching
206
    $query->no_fetch_filters($self->no_fetch_filters);
207
    
208
    return $query;
209
}
210

            
version 0.0901
yuki-kimoto authored on 2009-12-17
211
sub query{
packaging one directory
yuki-kimoto authored on 2009-11-16
212
    my ($self, $query, $params)  = @_;
213
    $params ||= {};
214
    
215
    # First argument is SQL template
216
    if (!ref $query) {
217
        my $template = $query;
218
        $query = $self->create_query($template);
219
        my $query_edit_cb = $_[3];
220
        $query_edit_cb->($query) if ref $query_edit_cb eq 'CODE';
221
    }
222
    
223
    # Create bind value
224
    my $bind_values = $self->_build_bind_values($query, $params);
225
    
226
    # Execute
version 0.0901
yuki-kimoto authored on 2009-12-17
227
    my $sth      = $query->sth;
228
    my $affected = eval{$sth->execute(@$bind_values)};
packaging one directory
yuki-kimoto authored on 2009-11-16
229
    
230
    # Execute error
231
    if (my $execute_error = $@) {
232
        require Data::Dumper;
233
        my $sql              = $query->{sql} || '';
234
        my $key_infos_dump   = Data::Dumper->Dump([$query->key_infos], ['*key_infos']);
235
        my $params_dump      = Data::Dumper->Dump([$params], ['*params']);
236
        
237
        croak("$execute_error" . 
238
              "<Your SQL>\n$sql\n" . 
239
              "<Your parameters>\n$params_dump");
240
    }
241
    
242
    # Return resultset if select statement is executed
243
    if ($sth->{NUM_OF_FIELDS}) {
244
        
245
        # Get result class
246
        my $result_class = $self->result_class;
247
        
248
        # Create result
249
        my $result = $result_class->new({
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
250
            _dbi             => $self,
packaging one directory
yuki-kimoto authored on 2009-11-16
251
            sth              => $sth,
252
            fetch_filter     => $query->fetch_filter,
253
            no_fetch_filters => $query->no_fetch_filters
254
        });
255
        return $result;
256
    }
version 0.0901
yuki-kimoto authored on 2009-12-17
257
    return $affected;
packaging one directory
yuki-kimoto authored on 2009-11-16
258
}
259

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

            
370
sub run_transaction {
371
    my ($self, $transaction) = @_;
372
    
373
    # Check auto commit
374
    croak("AutoCommit must be true before transaction start")
375
      unless $self->_auto_commit;
376
    
377
    # Auto commit off
378
    $self->_auto_commit(0);
379
    
380
    # Run transaction
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
381
    eval {$transaction->($self)};
packaging one directory
yuki-kimoto authored on 2009-11-16
382
    
383
    # Tranzaction error
384
    my $transaction_error = $@;
385
    
386
    # Tranzaction is failed.
387
    if ($transaction_error) {
388
        # Rollback
389
        eval{$self->dbh->rollback};
390
        
391
        # Rollback error
392
        my $rollback_error = $@;
393
        
394
        # Auto commit on
395
        $self->_auto_commit(1);
396
        
397
        if ($rollback_error) {
398
            # Rollback is failed
399
            croak("${transaction_error}Rollback is failed : $rollback_error");
400
        }
401
        else {
402
            # Rollback is success
403
            croak("${transaction_error}Rollback is success");
404
        }
405
    }
406
    # Tranzaction is success
407
    else {
408
        # Commit
409
        eval{$self->dbh->commit};
410
        my $commit_error = $@;
411
        
412
        # Auto commit on
413
        $self->_auto_commit(1);
414
        
415
        # Commit is failed
416
        croak($commit_error) if $commit_error;
417
    }
418
}
419

            
420
sub last_insert_id {
421
    my $self = shift;
add Oracle, DB2, Pg,
yuki-kimoto authored on 2009-11-16
422
    my $class = ref $self;
423
    croak "'$class' do not suppert 'last_insert_id'";
packaging one directory
yuki-kimoto authored on 2009-11-16
424
}
425

            
version 0.0901
yuki-kimoto authored on 2009-12-17
426

            
427
sub create_table {
428
    my ($self, $table, @column_definitions) = @_;
429
    
430
    # Create table
431
    my $sql = "create table $table (\n";
432
    
433
    # Column definitions
434
    foreach my $column_definition (@column_definitions) {
435
        $sql .= "\t$column_definition,\n";
436
    }
437
    $sql =~ s/,\n$//;
438
    
439
    # End
440
    $sql .= "\n);";
441
    
442
    # Do query
443
    return $self->do($sql);
444
}
445

            
446
sub drop_table {
447
    my ($self, $table) = @_;
448
    
449
    # Drop table
450
    my $sql = "drop table $table;";
451

            
452
    # Do query
453
    return $self->do($sql);
454
}
455

            
packaging one directory
yuki-kimoto authored on 2009-11-16
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
version 0.0901
yuki-kimoto authored on 2009-12-17
484
    my $ret_val = $self->query($query, $insert_params);
packaging one directory
yuki-kimoto authored on 2009-11-16
485
    
486
    return $ret_val;
487
}
488

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

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

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

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

            
616
sub _select_usage { return << 'EOS' }
617
Your select arguments is wrong.
618
select usage:
619
$dbi->select(
620
    $table,                # must be string or array ref
version 0.0901
yuki-kimoto authored on 2009-12-17
621
    [@$columns],           # must be array reference. this can be ommited
622
    {%$where_params},      # must be hash reference.  this can be ommited
623
    $append_statement,     # must be string.          this can be ommited
624
    $query_edit_callback   # must be code reference.  this can be ommited
packaging one directory
yuki-kimoto authored on 2009-11-16
625
);
626
EOS
627

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

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

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

            
734
=head1 NAME
735

            
version 0.0901
yuki-kimoto authored on 2009-12-17
736
DBIx::Custom - Customizable DBI
packaging one directory
yuki-kimoto authored on 2009-11-16
737

            
version 0.0901
yuki-kimoto authored on 2009-12-17
738
=head1 VERSION
packaging one directory
yuki-kimoto authored on 2009-11-16
739

            
version 0.0901
yuki-kimoto authored on 2009-12-17
740
Version 0.0801
packaging one directory
yuki-kimoto authored on 2009-11-16
741

            
version 0.0901
yuki-kimoto authored on 2009-12-17
742
=head1 SYNOPSYS
743
    
744
    # New
745
    my $dbi = DBIx::Custom->new(data_source => "dbi:mysql:database=books"
746
                                user => 'ken', password => '!LFKD%$&');
747
    
748
    # Query
749
    $dbi->query("select title from books");
750
    
751
    # Query with parameters
752
    $dbi->query("select id from books where {= author} && {like title}",
753
                {author => 'ken', title => '%Perl%'});
754
    
755
    # Insert 
756
    $dbi->insert('books', {title => 'perl', author => 'Ken'});
757
    
758
    # Update 
759
    $dbi->update('books', {title => 'aaa', author => 'Ken'}, {id => 5});
760
    
761
    # Delete
762
    $dbi->delete('books', {author => 'Ken'});
763
    
764
    # Select
765
    $dbi->select('books');
766
    $dbi->select('books', {author => 'taro'}); 
767
    $dbi->select('books', [qw/author title/], {author => 'Ken'});
768
    $dbi->select('books', [qw/author title/], {author => 'Ken'},
769
                 'order by id limit 1');
packaging one directory
yuki-kimoto authored on 2009-11-16
770

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

            
773
=head2 user
774

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
775
Set and get database user name
776
    
version 0.0901
yuki-kimoto authored on 2009-12-17
777
    $dbi  = $dbi->user('Ken');
778
    $user = $dbi->user;
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
779
    
packaging one directory
yuki-kimoto authored on 2009-11-16
780
=head2 password
781

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
782
Set and get database password
783
    
version 0.0901
yuki-kimoto authored on 2009-12-17
784
    $dbi      = $dbi->password('lkj&le`@s');
785
    $password = $dbi->password;
packaging one directory
yuki-kimoto authored on 2009-11-16
786

            
787
=head2 data_source
788

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
789
Set and get database data source
790
    
version 0.0901
yuki-kimoto authored on 2009-12-17
791
    $dbi         = $dbi->data_source("dbi:mysql:dbname=$database");
792
    $data_source = $dbi->data_source;
packaging one directory
yuki-kimoto authored on 2009-11-16
793
    
version 0.0901
yuki-kimoto authored on 2009-12-17
794
If you know data source more, See also L<DBI>.
795

            
packaging one directory
yuki-kimoto authored on 2009-11-16
796
=head2 database
797

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
800
    $dbi      = $dbi->database('books');
801
    $database = $dbi->database;
packaging one directory
yuki-kimoto authored on 2009-11-16
802

            
add port and host method
yuki-kimoto authored on 2009-11-16
803
=head2 host
804

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
807
    $dbi  = $dbi->host('somehost.com');
808
    $host = $dbi->host;
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
809

            
version 0.0901
yuki-kimoto authored on 2009-12-17
810
You can also set IP address like '127.03.45.12'.
add port and host method
yuki-kimoto authored on 2009-11-16
811

            
812
=head2 port
813

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
816
    $dbi  = $dbi->port(1198);
817
    $port = $dbi->port;
add port and host method
yuki-kimoto authored on 2009-11-16
818

            
version 0.0901
yuki-kimoto authored on 2009-12-17
819
=head2 options
packaging one directory
yuki-kimoto authored on 2009-11-16
820

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
823
    $dbi     = $dbi->options({PrintError => 0, RaiseError => 1});
824
    $options = $dbi->options;
packaging one directory
yuki-kimoto authored on 2009-11-16
825

            
version 0.0901
yuki-kimoto authored on 2009-12-17
826
=head2 sql_tmpl
packaging one directory
yuki-kimoto authored on 2009-11-16
827

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
830
    $dbi      = $dbi->sql_tmpl(DBIx::Cutom::SQL::Template->new);
831
    $sql_tmpl = $dbi->sql_tmpl;
packaging one directory
yuki-kimoto authored on 2009-11-16
832

            
version 0.0901
yuki-kimoto authored on 2009-12-17
833
See also L<DBIx::Custom::SQL::Template>.
packaging one directory
yuki-kimoto authored on 2009-11-16
834

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

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
839
    $dbi     = $dbi->filters({filter1 => sub { }, filter2 => sub {}});
840
    $filters = $dbi->filters;
packaging one directory
yuki-kimoto authored on 2009-11-16
841
    
version 0.0901
yuki-kimoto authored on 2009-12-17
842
This method is generally used to get a filter.
843

            
844
    $filter = $dbi->filters->{encode_utf8};
845

            
846
If you add filter, use add_filter method.
packaging one directory
yuki-kimoto authored on 2009-11-16
847

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

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
852
    $dbi     = $dbi->formats({format1 => sub { }, format2 => sub {}});
853
    $formats = $dbi->formats;
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
854

            
version 0.0901
yuki-kimoto authored on 2009-12-17
855
This method is generally used to get a format.
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
856

            
version 0.0901
yuki-kimoto authored on 2009-12-17
857
    $filter = $dbi->formats->{datetime};
858

            
859
If you add format, use add_format method.
packaging one directory
yuki-kimoto authored on 2009-11-16
860

            
861
=head2 bind_filter
862

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
865
    $dbi         = $dbi->bind_filter($bind_filter);
866
    $bind_filter = $dbi->bind_filter
packaging one directory
yuki-kimoto authored on 2009-11-16
867

            
version 0.0901
yuki-kimoto authored on 2009-12-17
868
The following is bind filter sample
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
869

            
870
    $dbi->bind_filter(sub {
871
        my ($value, $key, $dbi, $infos) = @_;
872
        
873
        # edit $value
874
        
875
        return $value;
876
    });
packaging one directory
yuki-kimoto authored on 2009-11-16
877

            
version 0.0901
yuki-kimoto authored on 2009-12-17
878
Bind filter arguemts is
879

            
880
    1. $value : Value
881
    2. $key   : Key
882
    3. $dbi   : DBIx::Custom object
883
    4. $infos : {table => $table, column => $column}
884

            
packaging one directory
yuki-kimoto authored on 2009-11-16
885
=head2 fetch_filter
886

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
889
    $dbi          = $dbi->fetch_filter($fetch_filter);
890
    $fetch_filter = $dbi->fetch_filter;
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
891

            
version 0.0901
yuki-kimoto authored on 2009-12-17
892
The following is fetch filter sample
packaging one directory
yuki-kimoto authored on 2009-11-16
893

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
894
    $dbi->fetch_filter(sub {
895
        my ($value, $key, $dbi, $infos) = @_;
896
        
897
        # edit $value
898
        
899
        return $value;
900
    });
packaging one directory
yuki-kimoto authored on 2009-11-16
901

            
version 0.0901
yuki-kimoto authored on 2009-12-17
902
Bind filter arguemts is
903

            
904
    1. $value : Value
905
    2. $key   : Key
906
    3. $dbi   : DBIx::Custom object
907
    4. $infos : {type => $table, sth => $sth, index => $index}
908

            
packaging one directory
yuki-kimoto authored on 2009-11-16
909
=head2 no_bind_filters
910

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
911
Set and get no filter keys when binding
912
    
version 0.0901
yuki-kimoto authored on 2009-12-17
913
    $dbi             = $dbi->no_bind_filters(qw/title author/);
914
    $no_bind_filters = $dbi->no_bind_filters;
packaging one directory
yuki-kimoto authored on 2009-11-16
915

            
916
=head2 no_fetch_filters
917

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
920
    $dbi              = $dbi->no_fetch_filters(qw/title author/);
921
    $no_fetch_filters = $dbi->no_fetch_filters;
packaging one directory
yuki-kimoto authored on 2009-11-16
922

            
923
=head2 result_class
924

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
927
    $dbi          = $dbi->result_class('DBIx::Custom::Result');
packaging one directory
yuki-kimoto authored on 2009-11-16
928
    $result_class = $dbi->result_class;
929

            
930
=head2 dbh
931

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
932
Get database handle
933
    
version 0.0901
yuki-kimoto authored on 2009-12-17
934
    $dbi = $dbi->dbh($dbh);
935
    $dbh = $dbi->dbh;
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
936
    
937
=head2 query_cache_max
938

            
939
Set and get query cache max
940

            
version 0.0901
yuki-kimoto authored on 2009-12-17
941
    $class           = DBIx::Custom->query_cache_max(50);
942
    $query_cache_max = DBIx::Custom->query_cache_max;
943

            
944
Default value is 50
945

            
946
=head2 Accessor summary
947

            
948
                       Accessor type       Variable type
949
    user               class and object    scalar(string)
950
    password           class and object    scalar(string)
951
    data_source        class and object    scalar(string)
952
    database           class and object    scalar(string)
953
    host               class and object    scalar(string)
954

            
955
    port               class and object    scalar(int)
956
    options            class and object    hash(string)
957
    sql_tmpl           class and object    scalar(DBIx::Custom::SQL::Template)
958
    filters            class and object    hash(code ref)
959
    formats            class and object    hash(string)
packaging one directory
yuki-kimoto authored on 2009-11-16
960

            
version 0.0901
yuki-kimoto authored on 2009-12-17
961
    bind_filter        class and object    scalar(code ref)
962
    fetch_filter       class and object    scalar(code ref)
963
    no_bind_filters    class and object    array(string)
964
    no_fetch_filters   class and object    array(string)
965
    result_class       class and object    scalar(string)
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
966

            
version 0.0901
yuki-kimoto authored on 2009-12-17
967
    dbh                object              scalar(DBI)
968
    query_cache_max    class               scalar(int)
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
969

            
970
=head1 Methods
packaging one directory
yuki-kimoto authored on 2009-11-16
971

            
972
=head2 connect
973

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

            
packaging one directory
yuki-kimoto authored on 2009-11-16
976
    $dbi->connect;
977

            
978
=head2 disconnect
979

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
980
Disconnect database
981

            
packaging one directory
yuki-kimoto authored on 2009-11-16
982
    $dbi->disconnect;
983

            
version 0.0901
yuki-kimoto authored on 2009-12-17
984
If database is already disconnected, this method do nothing.
packaging one directory
yuki-kimoto authored on 2009-11-16
985

            
986
=head2 reconnect
987

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

            
packaging one directory
yuki-kimoto authored on 2009-11-16
990
    $dbi->reconnect;
991

            
992
=head2 connected
993

            
version 0.0901
yuki-kimoto authored on 2009-12-17
994
Check if database is connected.
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
995
    
version 0.0901
yuki-kimoto authored on 2009-12-17
996
    $is_connected = $dbi->connected;
packaging one directory
yuki-kimoto authored on 2009-11-16
997
    
998
=head2 filter_off
999

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1000
bind_filter and fitch_filter off
1001
    
version 0.0901
yuki-kimoto authored on 2009-12-17
1002
    $dbi->filter_off
packaging one directory
yuki-kimoto authored on 2009-11-16
1003
    
version 0.0901
yuki-kimoto authored on 2009-12-17
1004
This method is equeal to
packaging one directory
yuki-kimoto authored on 2009-11-16
1005
    
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1006
    $dbi->bind_filter(undef);
1007
    $dbi->fetch_filter(undef);
packaging one directory
yuki-kimoto authored on 2009-11-16
1008

            
1009
=head2 add_filter
1010

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1011
Resist filter
packaging one directory
yuki-kimoto authored on 2009-11-16
1012
    
version 0.0901
yuki-kimoto authored on 2009-12-17
1013
    $dbi->add_filter($fname1 => $filter1, $fname => $filter2);
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1014
    
version 0.0901
yuki-kimoto authored on 2009-12-17
1015
The following is add_filter sample
1016

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1017
    $dbi->add_filter(
1018
        encode_utf8 => sub {
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1019
            my ($value, $key, $dbi, $infos) = @_;
1020
            utf8::upgrade($value) unless Encode::is_utf8($value);
1021
            return encode('UTF-8', $value);
packaging one directory
yuki-kimoto authored on 2009-11-16
1022
        },
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1023
        decode_utf8 => sub {
1024
            my ($value, $key, $dbi, $infos) = @_;
1025
            return decode('UTF-8', $value)
packaging one directory
yuki-kimoto authored on 2009-11-16
1026
        }
1027
    );
1028

            
1029
=head2 add_format
1030

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1031
Add format
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1032

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1033
    $dbi->add_format($fname1 => $format, $fname2 => $format2);
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1034
    
version 0.0901
yuki-kimoto authored on 2009-12-17
1035
The following is add_format sample.
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1036

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1037
    $dbi->add_format(date => '%Y:%m:%d', datetime => '%Y-%m-%d %H:%M:%S');
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1038

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1039
=head2 create_query
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1040
    
version 0.0901
yuki-kimoto authored on 2009-12-17
1041
Create Query object parsing SQL template
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1042

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1043
    my $query = $dbi->create_query("select * from authors where {= name} and {= age}");
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1044

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1045
$query is <DBIx::Query> object. This is executed by query method as the following
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1046

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1047
    $dbi->query($query, $params);
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1048

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1049
If you know SQL template, see also L<DBIx::Custom::SQL::Template>.
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1050

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1051
=head2 query
packaging one directory
yuki-kimoto authored on 2009-11-16
1052

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1053
Query
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1054

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1055
    $result = $dbi->query($template, $params);
packaging one directory
yuki-kimoto authored on 2009-11-16
1056

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1057
The following is query sample
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1058

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1059
    $result = $dbi->query("select * from authors where {= name} and {= age}", 
1060
                          {author => 'taro', age => 19});
1061
    
1062
    while (my @row = $result->fetch) {
1063
        # do something
1064
    }
1065

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1066
If you now syntax of template, See also L<DBIx::Custom::SQL::Template>
1067

            
1068
Return value of query method is L<DBIx::Custom::Result> object
1069

            
1070
See also L<DBIx::Custom::Result>.
packaging one directory
yuki-kimoto authored on 2009-11-16
1071

            
1072
=head2 run_transaction
1073

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1074
Run transaction
1075

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1076
    $dbi->run_transaction(sub {
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1077
        my $dbi = shift;
1078
        
packaging one directory
yuki-kimoto authored on 2009-11-16
1079
        # do something
1080
    });
1081

            
1082
If transaction is success, commit is execute. 
1083
If tranzation is died, rollback is execute.
1084

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1085
=head2 create_table
1086

            
1087
Create table
1088

            
1089
    $dbi->create_table(
1090
        'books',
1091
        'name char(255)',
1092
        'age  int'
1093
    );
1094

            
1095
First argument is table name. Rest arguments is column definition.
1096

            
1097
=head2 drop_table
1098

            
1099
Drop table
1100

            
1101
    $dbi->drop_table('books');
1102

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1103
=head2 insert
1104

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1107
    $affected = $dbi->insert($table, \%$insert_params);
1108
    $affected = $dbi->insert($table, \%$insert_params, $append);
update document
yuki-kimoto authored on 2009-11-19
1109

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1110
Retrun value is affected rows count
packaging one directory
yuki-kimoto authored on 2009-11-16
1111
    
version 0.0901
yuki-kimoto authored on 2009-12-17
1112
The following is insert sample.
1113

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1114
    $dbi->insert('books', {title => 'Perl', author => 'Taro'});
1115

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1116
You can add statement.
1117

            
1118
    $dbi->insert('books', {title => 'Perl', author => 'Taro'}, "some statement");
1119

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1120
=head2 update
1121

            
update document
yuki-kimoto authored on 2009-11-19
1122
Update rows
1123

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1124
    $affected = $dbi->update($table, \%update_params, \%where);
1125
    $affected = $dbi->update($table, \%update_params, \%where, $append);
1126

            
1127
Retrun value is affected rows count
update document
yuki-kimoto authored on 2009-11-19
1128

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1129
The following is update sample.
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1130

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1133
You can add statement.
1134

            
1135
    $dbi->update('books', {title => 'Perl', author => 'Taro'},
1136
                 {id => 5}, "some statement");
1137

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1138
=head2 update_all
1139

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1142
    $affected = $dbi->update_all($table, \%updat_params);
update document
yuki-kimoto authored on 2009-11-19
1143

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1144
Retrun value is affected rows count
1145

            
1146
The following is update_all sample.
update document
yuki-kimoto authored on 2009-11-19
1147

            
1148
    $dbi->update_all('books', {author => 'taro'});
packaging one directory
yuki-kimoto authored on 2009-11-16
1149

            
1150
=head2 delete
1151

            
update document
yuki-kimoto authored on 2009-11-19
1152
Delete rows
1153

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1154
    $affected = $dbi->delete($table, \%where);
1155
    $affected = $dbi->delete($table, \%where, $append);
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1156

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1157
Retrun value is affected rows count
packaging one directory
yuki-kimoto authored on 2009-11-16
1158
    
version 0.0901
yuki-kimoto authored on 2009-12-17
1159
The following is delete sample.
1160

            
update document
yuki-kimoto authored on 2009-11-19
1161
    $dbi->delete('books', {id => 5});
packaging one directory
yuki-kimoto authored on 2009-11-16
1162

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1163
You can add statement.
1164

            
1165
    $dbi->delete('books', {id => 5}, "some statement");
1166

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1167
=head2 delete_all
1168

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1171
    $affected = $dbi->delete_all($table);
packaging one directory
yuki-kimoto authored on 2009-11-16
1172

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1173
Retrun value is affected rows count
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1174

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1175
The following is delete_all sample.
1176

            
1177
    $dbi->delete_all('books');
packaging one directory
yuki-kimoto authored on 2009-11-16
1178

            
1179
=head2 select
1180
    
update document
yuki-kimoto authored on 2009-11-19
1181
Select rows
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1182

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1183
    $resut = $dbi->select(
packaging one directory
yuki-kimoto authored on 2009-11-16
1184
        $table,                # must be string or array;
version 0.0901
yuki-kimoto authored on 2009-12-17
1185
        \@$columns,            # must be array reference. this can be ommited
1186
        \%$where_params,       # must be hash reference.  this can be ommited
1187
        $append_statement,     # must be string.          this can be ommited
1188
        $query_edit_callback   # must be code reference.  this can be ommited
packaging one directory
yuki-kimoto authored on 2009-11-16
1189
    );
update document
yuki-kimoto authored on 2009-11-19
1190

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1191
$reslt is L<DBIx::Custom::Result> object
update document
yuki-kimoto authored on 2009-11-19
1192

            
1193
The following is some select samples
1194

            
1195
    # select * from books;
1196
    $result = $dbi->select('books');
packaging one directory
yuki-kimoto authored on 2009-11-16
1197
    
update document
yuki-kimoto authored on 2009-11-19
1198
    # select * from books where title = 'Perl';
1199
    $result = $dbi->select('books', {title => 1});
1200
    
1201
    # select title, author from books where id = 1 for update;
1202
    $result = $dbi->select(
1203
        'books',              # table
1204
        ['title', 'author'],  # columns
1205
        {id => 1},            # where clause
1206
        'for update',         # append statement
1207
    );
1208

            
1209
You can join multi tables
1210
    
1211
    $result = $dbi->select(
1212
        ['table1', 'table2'],                # tables
1213
        ['table1.id as table1_id', 'title'], # columns (alias is ok)
1214
        {table1.id => 1},                    # where clase
1215
        "where table1.id = table2.id",       # join clause (must start 'where')
1216
    );
1217

            
1218
You can also edit query
1219
        
packaging one directory
yuki-kimoto authored on 2009-11-16
1220
    $dbi->select(
update document
yuki-kimoto authored on 2009-11-19
1221
        'books',
1222
        # column, where clause, append statement,
packaging one directory
yuki-kimoto authored on 2009-11-16
1223
        sub {
1224
            my $query = shift;
1225
            $query->bind_filter(sub {
1226
                # ...
1227
            });
1228
        }
update document
yuki-kimoto authored on 2009-11-19
1229
    }
1230

            
1231

            
1232
=head2 last_insert_id
1233

            
1234
Get last insert id
packaging one directory
yuki-kimoto authored on 2009-11-16
1235

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

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1240
=head2 prepare
1241

            
1242
Prepare statement handle.
1243

            
1244
    $sth = $dbi->prepare('select * from books;');
1245

            
1246
This method is same as DBI prepare method.
1247

            
1248
See also L<DBI>.
1249

            
1250
=head2 do
1251

            
1252
Execute SQL
1253

            
1254
    $affected = $dbi->do('insert into books (title, author) values (?, ?)',
1255
                        'Perl', 'taro');
1256

            
1257
Retrun value is affected rows count.
1258

            
1259
This method is same as DBI do method.
1260

            
1261
See also L<DBI>
1262

            
1263
=head1 DBIx::Custom default configuration
packaging one directory
yuki-kimoto authored on 2009-11-16
1264

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

            
1268
    1. AutoCommit is true
1269
    2. RaiseError is true
1270

            
1271
By default, Both AutoCommit and RaiseError is true.
1272
You must not change these mode not to damage your data.
1273

            
1274
If you change these mode, 
1275
you cannot get correct error message, 
1276
or run_transaction may fail.
1277

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1278
=head1 Inheritance of DBIx::Custom
1279

            
1280
DBIx::Custom is customizable DBI.
1281
You can inherit DBIx::Custom and custumize attributes.
1282

            
1283
    package DBIx::Custom::Yours;
1284
    use base DBIx::Custom;
1285
    
1286
    my $class = __PACKAGE__;
1287
    
1288
    $class->user('your_name');
1289
    $class->password('your_password');
1290

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1291
=head1 AUTHOR
1292

            
1293
Yuki Kimoto, C<< <kimoto.yuki at gmail.com> >>
1294

            
1295
Github L<http://github.com/yuki-kimoto>
1296

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1297
I develope this module L<http://github.com/yuki-kimoto/DBIx-Custom>
1298

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1299
=head1 COPYRIGHT & LICENSE
1300

            
1301
Copyright 2009 Yuki Kimoto, all rights reserved.
1302

            
1303
This program is free software; you can redistribute it and/or modify it
1304
under the same terms as Perl itself.
1305

            
1306
=cut