DBIx-Custom / lib / DBIx / Custom.pm /
Newer Older
1299 lines | 32.901kb
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
use Carp 'croak';
10
use DBI;
11
use DBIx::Custom::Result;
12
use DBIx::Custom::SQL::Template;
13

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

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

            
catch up with Object::Simple...
yuki-kimoto authored on 2010-01-18
20
__PACKAGE__->dual_attr([qw/user password data_source/], clone => 'scalar');
21
__PACKAGE__->dual_attr([qw/database host port/],        clone => 'scalar');
22
__PACKAGE__->dual_attr([qw/bind_filter fetch_filter/],  clone => 'scalar');
packaging one directory
yuki-kimoto authored on 2009-11-16
23

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
723
=head1 NAME
724

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

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

            
catch up with Object::Simple...
yuki-kimoto authored on 2010-01-18
729
Version 0.0903
730

            
731
=cut
732

            
733
our $VERSION = '0.0903';
packaging one directory
yuki-kimoto authored on 2009-11-16
734

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

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

            
766
=head2 user
767

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

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

            
780
=head2 data_source
781

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

            
packaging one directory
yuki-kimoto authored on 2009-11-16
789
=head2 database
790

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

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

            
add port and host method
yuki-kimoto authored on 2009-11-16
796
=head2 host
797

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

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

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

            
805
=head2 port
806

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

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

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

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

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
819
=head2 sql_tmpl
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 SQL::Template object
packaging one directory
yuki-kimoto authored on 2009-11-16
822

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

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

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

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

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

            
837
    $filter = $dbi->filters->{encode_utf8};
838

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

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

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

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

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

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

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

            
854
=head2 bind_filter
855

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

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

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

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
871
Bind filter arguemts is
872

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

            
packaging one directory
yuki-kimoto authored on 2009-11-16
878
=head2 fetch_filter
879

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

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

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

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
895
Bind filter arguemts is
896

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

            
packaging one directory
yuki-kimoto authored on 2009-11-16
902
=head2 no_bind_filters
903

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

            
909
=head2 no_fetch_filters
910

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

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

            
916
=head2 result_class
917

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

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

            
923
=head2 dbh
924

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

            
932
Set and get query cache max
933

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

            
937
Default value is 50
938

            
939
=head2 Accessor summary
940

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

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

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

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

            
963
=head1 Methods
packaging one directory
yuki-kimoto authored on 2009-11-16
964

            
965
=head2 connect
966

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

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

            
971
=head2 disconnect
972

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
973
Disconnect database
974

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

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

            
979
=head2 reconnect
980

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

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

            
985
=head2 connected
986

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

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

            
1002
=head2 add_filter
1003

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

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

            
1022
=head2 add_format
1023

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
1061
Return value of query method is L<DBIx::Custom::Result> object
1062

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

            
1065
=head2 run_transaction
1066

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1067
Run transaction
1068

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

            
1075
If transaction is success, commit is execute. 
1076
If tranzation is died, rollback is execute.
1077

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1078
=head2 create_table
1079

            
1080
Create table
1081

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

            
1088
First argument is table name. Rest arguments is column definition.
1089

            
1090
=head2 drop_table
1091

            
1092
Drop table
1093

            
1094
    $dbi->drop_table('books');
1095

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1096
=head2 insert
1097

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

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

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

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1109
You can add statement.
1110

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

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1113
=head2 update
1114

            
update document
yuki-kimoto authored on 2009-11-19
1115
Update rows
1116

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

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

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

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1126
You can add statement.
1127

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

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1131
=head2 update_all
1132

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

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

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

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

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

            
1143
=head2 delete
1144

            
update document
yuki-kimoto authored on 2009-11-19
1145
Delete rows
1146

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

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

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1156
You can add statement.
1157

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

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1160
=head2 delete_all
1161

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

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

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

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

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

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

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

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

            
1186
The following is some select samples
1187

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

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

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

            
1224

            
1225
=head2 last_insert_id
1226

            
1227
Get last insert id
packaging one directory
yuki-kimoto authored on 2009-11-16
1228

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

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1233
=head2 prepare
1234

            
1235
Prepare statement handle.
1236

            
1237
    $sth = $dbi->prepare('select * from books;');
1238

            
1239
This method is same as DBI prepare method.
1240

            
1241
See also L<DBI>.
1242

            
1243
=head2 do
1244

            
1245
Execute SQL
1246

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

            
1250
Retrun value is affected rows count.
1251

            
1252
This method is same as DBI do method.
1253

            
1254
See also L<DBI>
1255

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

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

            
1261
    1. AutoCommit is true
1262
    2. RaiseError is true
1263

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

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

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

            
1273
DBIx::Custom is customizable DBI.
1274
You can inherit DBIx::Custom and custumize attributes.
1275

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

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1284
=head1 AUTHOR
1285

            
1286
Yuki Kimoto, C<< <kimoto.yuki at gmail.com> >>
1287

            
1288
Github L<http://github.com/yuki-kimoto>
1289

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

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

            
1294
Copyright 2009 Yuki Kimoto, all rights reserved.
1295

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

            
1299
=cut