DBIx-Custom / lib / DBIx / Custom.pm /
Newer Older
1297 lines | 32.89kb
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 Carp 'croak';
8
use DBI;
9
use DBIx::Custom::Result;
10
use DBIx::Custom::SQL::Template;
11

            
catch up with Object::Simple...
yuki-kimoto authored on 2010-01-18
12
__PACKAGE__->attr('dbh');
version 0.0901
yuki-kimoto authored on 2009-12-17
13

            
catch up with Object::Simple...
yuki-kimoto authored on 2010-01-18
14
__PACKAGE__->class_attr(_query_caches     => sub { {} });
15
__PACKAGE__->class_attr(_query_cache_keys => sub { [] });
cleanup
yuki-kimoto authored on 2010-01-21
16
__PACKAGE__->class_attr('query_cache_max', default => 50, inherit => 'scalar');
packaging one directory
yuki-kimoto authored on 2009-11-16
17

            
cleanup
yuki-kimoto authored on 2010-01-21
18
__PACKAGE__->dual_attr([qw/user password data_source/], inherit => 'scalar');
19
__PACKAGE__->dual_attr([qw/database host port/],        inherit => 'scalar');
20
__PACKAGE__->dual_attr([qw/bind_filter fetch_filter/],  inherit => 'scalar');
packaging one directory
yuki-kimoto authored on 2009-11-16
21

            
catch up with Object::Simple...
yuki-kimoto authored on 2010-01-18
22
__PACKAGE__->dual_attr([qw/no_bind_filters no_fetch_filters/],
cleanup
yuki-kimoto authored on 2010-01-21
23
                       default => sub { [] }, inherit => 'array');
packaging one directory
yuki-kimoto authored on 2009-11-16
24

            
catch up with Object::Simple...
yuki-kimoto authored on 2010-01-18
25
__PACKAGE__->dual_attr([qw/options filters formats/],
cleanup
yuki-kimoto authored on 2010-01-21
26
                       default => sub { {} }, inherit => 'hash');
packaging one directory
yuki-kimoto authored on 2009-11-16
27

            
catch up with Object::Simple...
yuki-kimoto authored on 2010-01-18
28
__PACKAGE__->dual_attr('result_class', default => 'DBIx::Custom::Result',
cleanup
yuki-kimoto authored on 2010-01-21
29
                                       inherit   => 'scalar');
packaging one directory
yuki-kimoto authored on 2009-11-16
30

            
catch up with Object::Simple...
yuki-kimoto authored on 2010-01-18
31
__PACKAGE__->dual_attr('sql_tmpl', default => sub {DBIx::Custom::SQL::Template->new},
cleanup
yuki-kimoto authored on 2010-01-21
32
                                   inherit   => sub {$_[0] ? $_[0]->clone : undef});
packaging one directory
yuki-kimoto authored on 2009-11-16
33

            
34
sub add_filter {
35
    my $invocant = shift;
36
    
catch up with Object::Simple...
yuki-kimoto authored on 2010-01-18
37
    my $filters = ref $_[0] eq 'HASH' ? $_[0] : {@_};
38
    $invocant->filters({%{$invocant->filters}, %$filters});
39
    
packaging one directory
yuki-kimoto authored on 2009-11-16
40
    return $invocant;
41
}
42

            
43
sub add_format{
44
    my $invocant = shift;
45
    
catch up with Object::Simple...
yuki-kimoto authored on 2010-01-18
46
    my $formats = ref $_[0] eq 'HASH' ? $_[0] : {@_};
47
    $invocant->formats({%{$invocant->formats}, %$formats});
48

            
packaging one directory
yuki-kimoto authored on 2009-11-16
49
    return $invocant;
50
}
51

            
52
sub _auto_commit {
53
    my $self = shift;
54
    
55
    croak("Not yet connect to database") unless $self->dbh;
56
    
57
    if (@_) {
58
        $self->dbh->{AutoCommit} = $_[0];
59
        return $self;
60
    }
61
    return $self->dbh->{AutoCommit};
62
}
63

            
64
sub connect {
65
    my $self = shift;
66
    my $data_source = $self->data_source;
67
    my $user        = $self->user;
68
    my $password    = $self->password;
version 0.0901
yuki-kimoto authored on 2009-12-17
69
    my $options     = $self->options;
packaging one directory
yuki-kimoto authored on 2009-11-16
70
    
71
    my $dbh = eval{DBI->connect(
72
        $data_source,
73
        $user,
74
        $password,
75
        {
76
            RaiseError => 1,
77
            PrintError => 0,
78
            AutoCommit => 1,
version 0.0901
yuki-kimoto authored on 2009-12-17
79
            %{$options || {} }
packaging one directory
yuki-kimoto authored on 2009-11-16
80
        }
81
    )};
82
    
83
    croak $@ if $@;
84
    
85
    $self->dbh($dbh);
86
    return $self;
87
}
88

            
89
sub DESTROY {
90
    my $self = shift;
91
    $self->disconnect if $self->connected;
92
}
93

            
94
sub connected {
95
    my $self = shift;
96
    return ref $self->{dbh} eq 'DBI::db';
97
}
98

            
99
sub disconnect {
100
    my $self = shift;
101
    if ($self->connected) {
102
        $self->dbh->disconnect;
103
        delete $self->{dbh};
104
    }
105
}
106

            
107
sub reconnect {
108
    my $self = shift;
109
    $self->disconnect if $self->connected;
110
    $self->connect;
111
}
112

            
113
sub prepare {
114
    my ($self, $sql) = @_;
115
    
116
    # Connect if not
117
    $self->connect unless $self->connected;
118
    
119
    # Prepare
120
    my $sth = eval{$self->dbh->prepare($sql)};
121
    
122
    # Error
123
    croak("$@<Your SQL>\n$sql") if $@;
124
    
125
    return $sth;
126
}
127

            
128
sub do{
129
    my ($self, $sql, @bind_values) = @_;
130
    
131
    # Connect if not
132
    $self->connect unless $self->connected;
133
    
134
    # Do
version 0.0901
yuki-kimoto authored on 2009-12-17
135
    my $affected = eval{$self->dbh->do($sql, @bind_values)};
packaging one directory
yuki-kimoto authored on 2009-11-16
136
    
137
    # Error
138
    if ($@) {
139
        my $error = $@;
140
        require Data::Dumper;
141
        
142
        my $bind_value_dump
143
          = Data::Dumper->Dump([\@bind_values], ['*bind_valuds']);
144
        
145
        croak("$error<Your SQL>\n$sql\n<Your bind values>\n$bind_value_dump\n");
146
    }
version 0.0901
yuki-kimoto authored on 2009-12-17
147
    
148
    return $affected;
packaging one directory
yuki-kimoto authored on 2009-11-16
149
}
150

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

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

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

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

            
407
sub last_insert_id {
408
    my $self = shift;
add Oracle, DB2, Pg,
yuki-kimoto authored on 2009-11-16
409
    my $class = ref $self;
410
    croak "'$class' do not suppert 'last_insert_id'";
packaging one directory
yuki-kimoto authored on 2009-11-16
411
}
412

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

            
414
sub create_table {
415
    my ($self, $table, @column_definitions) = @_;
416
    
417
    # Create table
418
    my $sql = "create table $table (\n";
419
    
420
    # Column definitions
421
    foreach my $column_definition (@column_definitions) {
422
        $sql .= "\t$column_definition,\n";
423
    }
424
    $sql =~ s/,\n$//;
425
    
426
    # End
427
    $sql .= "\n);";
428
    
429
    # Do query
430
    return $self->do($sql);
431
}
432

            
433
sub drop_table {
434
    my ($self, $table) = @_;
435
    
436
    # Drop table
437
    my $sql = "drop table $table;";
438

            
439
    # Do query
440
    return $self->do($sql);
441
}
442

            
packaging one directory
yuki-kimoto authored on 2009-11-16
443
sub insert {
insert, update, delete appnd...
yuki-kimoto authored on 2009-11-16
444
    my $self             = shift;
445
    my $table            = shift || '';
446
    my $insert_params    = shift || {};
447
    my $append_statement = shift unless ref $_[0];
448
    my $query_edit_cb    = shift;
packaging one directory
yuki-kimoto authored on 2009-11-16
449
    
450
    # Insert keys
451
    my @insert_keys = keys %$insert_params;
452
    
453
    # Not exists insert keys
454
    croak("Key-value pairs for insert must be specified to 'insert' second argument")
455
      unless @insert_keys;
456
    
457
    # Templte for insert
458
    my $template = "insert into $table {insert " . join(' ', @insert_keys) . '}';
insert, update, delete appnd...
yuki-kimoto authored on 2009-11-16
459
    $template .= " $append_statement" if $append_statement;
packaging one directory
yuki-kimoto authored on 2009-11-16
460
    # Create query
461
    my $query = $self->create_query($template);
462
    
463
    # Query edit callback must be code reference
464
    croak("Query edit callback must be code reference")
465
      if $query_edit_cb && ref $query_edit_cb ne 'CODE';
466
    
467
    # Query edit if need
468
    $query_edit_cb->($query) if $query_edit_cb;
469
    
470
    # Execute query
version 0.0901
yuki-kimoto authored on 2009-12-17
471
    my $ret_val = $self->query($query, $insert_params);
packaging one directory
yuki-kimoto authored on 2009-11-16
472
    
473
    return $ret_val;
474
}
475

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

            
535
sub update_all {
insert, update, delete appnd...
yuki-kimoto authored on 2009-11-16
536
    my $self             = shift;
537
    my $table            = shift || '';
538
    my $update_params    = shift || {};
539
    my $append_statement = shift unless ref $_[0];
540
    my $query_edit_cb    = shift;
541
    my $options          = {allow_update_all => 1};
542
    
543
    return $self->update($table, $update_params, {}, $append_statement,
544
                         $query_edit_cb, $options);
packaging one directory
yuki-kimoto authored on 2009-11-16
545
}
546

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

            
592
sub delete_all {
insert, update, delete appnd...
yuki-kimoto authored on 2009-11-16
593
    my $self             = shift;
594
    my $table            = shift || '';
595
    my $append_statement = shift unless ref $_[0];
596
    my $query_edit_cb    = shift;
597
    my $options          = {allow_delete_all => 1};
598
    
599
    return $self->delete($table, {}, $append_statement, $query_edit_cb,
600
                         $options);
packaging one directory
yuki-kimoto authored on 2009-11-16
601
}
602

            
603
sub _select_usage { return << 'EOS' }
604
Your select arguments is wrong.
605
select usage:
606
$dbi->select(
607
    $table,                # must be string or array ref
version 0.0901
yuki-kimoto authored on 2009-12-17
608
    [@$columns],           # must be array reference. this can be ommited
609
    {%$where_params},      # must be hash reference.  this can be ommited
610
    $append_statement,     # must be string.          this can be ommited
611
    $query_edit_callback   # must be code reference.  this can be ommited
packaging one directory
yuki-kimoto authored on 2009-11-16
612
);
613
EOS
614

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

            
691
sub _add_query_cache {
692
    my ($class, $template, $query) = @_;
693
    my $query_cache_keys = $class->_query_cache_keys;
694
    my $query_caches     = $class->_query_caches;
695
    
696
    return $class if $query_caches->{$template};
697
    
698
    $query_caches->{$template} = $query;
699
    push @$query_cache_keys, $template;
700
    
701
    my $overflow = @$query_cache_keys - $class->query_cache_max;
702
    
703
    for (my $i = 0; $i < $overflow; $i++) {
704
        my $template = shift @$query_cache_keys;
705
        delete $query_caches->{$template};
706
    }
707
    
708
    return $class;
709
}
710

            
711
sub filter_off {
712
    my $self = shift;
713
    
714
    # filter off
715
    $self->bind_filter(undef);
716
    $self->fetch_filter(undef);
717
    
718
    return $self;
719
}
720

            
721
=head1 NAME
722

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

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

            
cleanup
yuki-kimoto authored on 2010-01-21
727
Version 0.0904
catch up with Object::Simple...
yuki-kimoto authored on 2010-01-18
728

            
729
=cut
730

            
cleanup
yuki-kimoto authored on 2010-01-21
731
our $VERSION = '0.0904';
packaging one directory
yuki-kimoto authored on 2009-11-16
732

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

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

            
764
=head2 user
765

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
766
Set and get database user name
767
    
version 0.0901
yuki-kimoto authored on 2009-12-17
768
    $dbi  = $dbi->user('Ken');
769
    $user = $dbi->user;
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
770
    
packaging one directory
yuki-kimoto authored on 2009-11-16
771
=head2 password
772

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

            
778
=head2 data_source
779

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
780
Set and get database data source
781
    
version 0.0901
yuki-kimoto authored on 2009-12-17
782
    $dbi         = $dbi->data_source("dbi:mysql:dbname=$database");
783
    $data_source = $dbi->data_source;
packaging one directory
yuki-kimoto authored on 2009-11-16
784
    
version 0.0901
yuki-kimoto authored on 2009-12-17
785
If you know data source more, See also L<DBI>.
786

            
packaging one directory
yuki-kimoto authored on 2009-11-16
787
=head2 database
788

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

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

            
add port and host method
yuki-kimoto authored on 2009-11-16
794
=head2 host
795

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

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

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

            
803
=head2 port
804

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

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

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

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

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

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

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

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

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

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
826
=head2 filters
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 filters
packaging one directory
yuki-kimoto authored on 2009-11-16
829

            
version 0.0901
yuki-kimoto authored on 2009-12-17
830
    $dbi     = $dbi->filters({filter1 => sub { }, filter2 => sub {}});
831
    $filters = $dbi->filters;
packaging one directory
yuki-kimoto authored on 2009-11-16
832
    
version 0.0901
yuki-kimoto authored on 2009-12-17
833
This method is generally used to get a filter.
834

            
835
    $filter = $dbi->filters->{encode_utf8};
836

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

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

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

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

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

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

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

            
852
=head2 bind_filter
853

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
856
    $dbi         = $dbi->bind_filter($bind_filter);
857
    $bind_filter = $dbi->bind_filter
packaging one directory
yuki-kimoto authored on 2009-11-16
858

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

            
861
    $dbi->bind_filter(sub {
862
        my ($value, $key, $dbi, $infos) = @_;
863
        
864
        # edit $value
865
        
866
        return $value;
867
    });
packaging one directory
yuki-kimoto authored on 2009-11-16
868

            
version 0.0901
yuki-kimoto authored on 2009-12-17
869
Bind filter arguemts is
870

            
871
    1. $value : Value
872
    2. $key   : Key
873
    3. $dbi   : DBIx::Custom object
874
    4. $infos : {table => $table, column => $column}
875

            
packaging one directory
yuki-kimoto authored on 2009-11-16
876
=head2 fetch_filter
877

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

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

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

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
885
    $dbi->fetch_filter(sub {
886
        my ($value, $key, $dbi, $infos) = @_;
887
        
888
        # edit $value
889
        
890
        return $value;
891
    });
packaging one directory
yuki-kimoto authored on 2009-11-16
892

            
version 0.0901
yuki-kimoto authored on 2009-12-17
893
Bind filter arguemts is
894

            
895
    1. $value : Value
896
    2. $key   : Key
897
    3. $dbi   : DBIx::Custom object
898
    4. $infos : {type => $table, sth => $sth, index => $index}
899

            
packaging one directory
yuki-kimoto authored on 2009-11-16
900
=head2 no_bind_filters
901

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

            
907
=head2 no_fetch_filters
908

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

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

            
914
=head2 result_class
915

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

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

            
921
=head2 dbh
922

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
923
Get database handle
924
    
version 0.0901
yuki-kimoto authored on 2009-12-17
925
    $dbi = $dbi->dbh($dbh);
926
    $dbh = $dbi->dbh;
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
927
    
928
=head2 query_cache_max
929

            
930
Set and get query cache max
931

            
version 0.0901
yuki-kimoto authored on 2009-12-17
932
    $class           = DBIx::Custom->query_cache_max(50);
933
    $query_cache_max = DBIx::Custom->query_cache_max;
934

            
935
Default value is 50
936

            
937
=head2 Accessor summary
938

            
939
                       Accessor type       Variable type
940
    user               class and object    scalar(string)
941
    password           class and object    scalar(string)
942
    data_source        class and object    scalar(string)
943
    database           class and object    scalar(string)
944
    host               class and object    scalar(string)
945

            
946
    port               class and object    scalar(int)
947
    options            class and object    hash(string)
948
    sql_tmpl           class and object    scalar(DBIx::Custom::SQL::Template)
949
    filters            class and object    hash(code ref)
950
    formats            class and object    hash(string)
packaging one directory
yuki-kimoto authored on 2009-11-16
951

            
version 0.0901
yuki-kimoto authored on 2009-12-17
952
    bind_filter        class and object    scalar(code ref)
953
    fetch_filter       class and object    scalar(code ref)
954
    no_bind_filters    class and object    array(string)
955
    no_fetch_filters   class and object    array(string)
956
    result_class       class and object    scalar(string)
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
957

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

            
961
=head1 Methods
packaging one directory
yuki-kimoto authored on 2009-11-16
962

            
963
=head2 connect
964

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

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

            
969
=head2 disconnect
970

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
971
Disconnect database
972

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

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

            
977
=head2 reconnect
978

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

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

            
983
=head2 connected
984

            
version 0.0901
yuki-kimoto authored on 2009-12-17
985
Check if database is connected.
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
986
    
version 0.0901
yuki-kimoto authored on 2009-12-17
987
    $is_connected = $dbi->connected;
packaging one directory
yuki-kimoto authored on 2009-11-16
988
    
989
=head2 filter_off
990

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
991
bind_filter and fitch_filter off
992
    
version 0.0901
yuki-kimoto authored on 2009-12-17
993
    $dbi->filter_off
packaging one directory
yuki-kimoto authored on 2009-11-16
994
    
version 0.0901
yuki-kimoto authored on 2009-12-17
995
This method is equeal to
packaging one directory
yuki-kimoto authored on 2009-11-16
996
    
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
997
    $dbi->bind_filter(undef);
998
    $dbi->fetch_filter(undef);
packaging one directory
yuki-kimoto authored on 2009-11-16
999

            
1000
=head2 add_filter
1001

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1002
Resist filter
packaging one directory
yuki-kimoto authored on 2009-11-16
1003
    
version 0.0901
yuki-kimoto authored on 2009-12-17
1004
    $dbi->add_filter($fname1 => $filter1, $fname => $filter2);
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1005
    
version 0.0901
yuki-kimoto authored on 2009-12-17
1006
The following is add_filter sample
1007

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1008
    $dbi->add_filter(
1009
        encode_utf8 => sub {
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1010
            my ($value, $key, $dbi, $infos) = @_;
1011
            utf8::upgrade($value) unless Encode::is_utf8($value);
1012
            return encode('UTF-8', $value);
packaging one directory
yuki-kimoto authored on 2009-11-16
1013
        },
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1014
        decode_utf8 => sub {
1015
            my ($value, $key, $dbi, $infos) = @_;
1016
            return decode('UTF-8', $value)
packaging one directory
yuki-kimoto authored on 2009-11-16
1017
        }
1018
    );
1019

            
1020
=head2 add_format
1021

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

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1028
    $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
1029

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1030
=head2 create_query
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1031
    
version 0.0901
yuki-kimoto authored on 2009-12-17
1032
Create Query object parsing SQL template
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1033

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1036
$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
1037

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

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

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

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

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

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

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1050
    $result = $dbi->query("select * from authors where {= name} and {= age}", 
1051
                          {author => 'taro', age => 19});
1052
    
1053
    while (my @row = $result->fetch) {
1054
        # do something
1055
    }
1056

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

            
1059
Return value of query method is L<DBIx::Custom::Result> object
1060

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

            
1063
=head2 run_transaction
1064

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1065
Run transaction
1066

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1067
    $dbi->run_transaction(sub {
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1068
        my $dbi = shift;
1069
        
packaging one directory
yuki-kimoto authored on 2009-11-16
1070
        # do something
1071
    });
1072

            
1073
If transaction is success, commit is execute. 
1074
If tranzation is died, rollback is execute.
1075

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1076
=head2 create_table
1077

            
1078
Create table
1079

            
1080
    $dbi->create_table(
1081
        'books',
1082
        'name char(255)',
1083
        'age  int'
1084
    );
1085

            
1086
First argument is table name. Rest arguments is column definition.
1087

            
1088
=head2 drop_table
1089

            
1090
Drop table
1091

            
1092
    $dbi->drop_table('books');
1093

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1094
=head2 insert
1095

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

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1101
Retrun value is affected rows count
packaging one directory
yuki-kimoto authored on 2009-11-16
1102
    
version 0.0901
yuki-kimoto authored on 2009-12-17
1103
The following is insert sample.
1104

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1107
You can add statement.
1108

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

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1111
=head2 update
1112

            
update document
yuki-kimoto authored on 2009-11-19
1113
Update rows
1114

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

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

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

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1124
You can add statement.
1125

            
1126
    $dbi->update('books', {title => 'Perl', author => 'Taro'},
1127
                 {id => 5}, "some statement");
1128

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1129
=head2 update_all
1130

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

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

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

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

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

            
1141
=head2 delete
1142

            
update document
yuki-kimoto authored on 2009-11-19
1143
Delete rows
1144

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1148
Retrun value is affected rows count
packaging one directory
yuki-kimoto authored on 2009-11-16
1149
    
version 0.0901
yuki-kimoto authored on 2009-12-17
1150
The following is delete sample.
1151

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1154
You can add statement.
1155

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

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1158
=head2 delete_all
1159

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

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

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

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

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

            
1170
=head2 select
1171
    
update document
yuki-kimoto authored on 2009-11-19
1172
Select rows
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1173

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1174
    $resut = $dbi->select(
packaging one directory
yuki-kimoto authored on 2009-11-16
1175
        $table,                # must be string or array;
version 0.0901
yuki-kimoto authored on 2009-12-17
1176
        \@$columns,            # must be array reference. this can be ommited
1177
        \%$where_params,       # must be hash reference.  this can be ommited
1178
        $append_statement,     # must be string.          this can be ommited
1179
        $query_edit_callback   # must be code reference.  this can be ommited
packaging one directory
yuki-kimoto authored on 2009-11-16
1180
    );
update document
yuki-kimoto authored on 2009-11-19
1181

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

            
1184
The following is some select samples
1185

            
1186
    # select * from books;
1187
    $result = $dbi->select('books');
packaging one directory
yuki-kimoto authored on 2009-11-16
1188
    
update document
yuki-kimoto authored on 2009-11-19
1189
    # select * from books where title = 'Perl';
1190
    $result = $dbi->select('books', {title => 1});
1191
    
1192
    # select title, author from books where id = 1 for update;
1193
    $result = $dbi->select(
1194
        'books',              # table
1195
        ['title', 'author'],  # columns
1196
        {id => 1},            # where clause
1197
        'for update',         # append statement
1198
    );
1199

            
1200
You can join multi tables
1201
    
1202
    $result = $dbi->select(
1203
        ['table1', 'table2'],                # tables
1204
        ['table1.id as table1_id', 'title'], # columns (alias is ok)
1205
        {table1.id => 1},                    # where clase
1206
        "where table1.id = table2.id",       # join clause (must start 'where')
1207
    );
1208

            
1209
You can also edit query
1210
        
packaging one directory
yuki-kimoto authored on 2009-11-16
1211
    $dbi->select(
update document
yuki-kimoto authored on 2009-11-19
1212
        'books',
1213
        # column, where clause, append statement,
packaging one directory
yuki-kimoto authored on 2009-11-16
1214
        sub {
1215
            my $query = shift;
1216
            $query->bind_filter(sub {
1217
                # ...
1218
            });
1219
        }
update document
yuki-kimoto authored on 2009-11-19
1220
    }
1221

            
1222

            
1223
=head2 last_insert_id
1224

            
1225
Get last insert id
packaging one directory
yuki-kimoto authored on 2009-11-16
1226

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

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1231
=head2 prepare
1232

            
1233
Prepare statement handle.
1234

            
1235
    $sth = $dbi->prepare('select * from books;');
1236

            
1237
This method is same as DBI prepare method.
1238

            
1239
See also L<DBI>.
1240

            
1241
=head2 do
1242

            
1243
Execute SQL
1244

            
1245
    $affected = $dbi->do('insert into books (title, author) values (?, ?)',
1246
                        'Perl', 'taro');
1247

            
1248
Retrun value is affected rows count.
1249

            
1250
This method is same as DBI do method.
1251

            
1252
See also L<DBI>
1253

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

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

            
1259
    1. AutoCommit is true
1260
    2. RaiseError is true
1261

            
1262
By default, Both AutoCommit and RaiseError is true.
1263
You must not change these mode not to damage your data.
1264

            
1265
If you change these mode, 
1266
you cannot get correct error message, 
1267
or run_transaction may fail.
1268

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

            
1271
DBIx::Custom is customizable DBI.
1272
You can inherit DBIx::Custom and custumize attributes.
1273

            
1274
    package DBIx::Custom::Yours;
1275
    use base DBIx::Custom;
1276
    
1277
    my $class = __PACKAGE__;
1278
    
1279
    $class->user('your_name');
1280
    $class->password('your_password');
1281

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1282
=head1 AUTHOR
1283

            
1284
Yuki Kimoto, C<< <kimoto.yuki at gmail.com> >>
1285

            
1286
Github L<http://github.com/yuki-kimoto>
1287

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

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

            
1292
Copyright 2009 Yuki Kimoto, all rights reserved.
1293

            
1294
This program is free software; you can redistribute it and/or modify it
1295
under the same terms as Perl itself.
1296

            
1297
=cut