DBIx-Custom / lib / DBIx / Custom.pm /
Newer Older
1275 lines | 31.879kb
cleanup
yuki-kimoto authored on 2009-12-22
1
package DBIx::Custom;
catch up with Object::Simple...
yuki-kimoto authored on 2010-01-22
2
use base 'Object::Simple';
cleanup
yuki-kimoto authored on 2009-12-22
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 { [] });
packaging one directory
yuki-kimoto authored on 2009-11-16
16

            
catch up with Object::Simple...
yuki-kimoto authored on 2010-01-22
17
__PACKAGE__->class_attr('query_cache_max', default => 50,
18
                                           inherit => 'scalar_copy');
19

            
20
__PACKAGE__->dual_attr([qw/user password data_source/], inherit => 'scalar_copy');
21
__PACKAGE__->dual_attr([qw/database host port/],        inherit => 'scalar_copy');
22
__PACKAGE__->dual_attr([qw/bind_filter fetch_filter/],  inherit => 'scalar_copy');
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/],
catch up with Object::Simple...
yuki-kimoto authored on 2010-01-22
25
                       default => sub { [] }, inherit => 'array_copy');
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/],
catch up with Object::Simple...
yuki-kimoto authored on 2010-01-22
28
                       default => sub { {} }, inherit => 'hash_copy');
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',
catch up with Object::Simple...
yuki-kimoto authored on 2010-01-22
31
                                       inherit => 'scalar_copy');
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},
cleanup
yuki-kimoto authored on 2010-01-21
34
                                   inherit   => 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;
cleanup
yuki-kimoto authored on 2010-01-21
253
    my $no_bind_filters     = $query->_no_bind_filters || {};
packaging one directory
yuki-kimoto authored on 2009-11-16
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 &&
cleanup
yuki-kimoto authored on 2010-01-21
287
                            !$no_bind_filters->{$original_key})
packaging one directory
yuki-kimoto authored on 2009-11-16
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 &&
cleanup
yuki-kimoto authored on 2010-01-21
308
                            !$no_bind_filters->{$original_key}) 
packaging one directory
yuki-kimoto authored on 2009-11-16
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

            
fix some bug
yuki-kimoto authored on 2010-01-24
729
Version 0.0906
catch up with Object::Simple...
yuki-kimoto authored on 2010-01-18
730

            
731
=cut
732

            
fix some bug
yuki-kimoto authored on 2010-01-24
733
our $VERSION = '0.0906';
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

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
939
=head1 Methods
packaging one directory
yuki-kimoto authored on 2009-11-16
940

            
941
=head2 connect
942

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

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

            
947
=head2 disconnect
948

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
949
Disconnect database
950

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

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

            
955
=head2 reconnect
956

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

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

            
961
=head2 connected
962

            
version 0.0901
yuki-kimoto authored on 2009-12-17
963
Check if database is connected.
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
964
    
version 0.0901
yuki-kimoto authored on 2009-12-17
965
    $is_connected = $dbi->connected;
packaging one directory
yuki-kimoto authored on 2009-11-16
966
    
967
=head2 filter_off
968

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
969
bind_filter and fitch_filter off
970
    
version 0.0901
yuki-kimoto authored on 2009-12-17
971
    $dbi->filter_off
packaging one directory
yuki-kimoto authored on 2009-11-16
972
    
version 0.0901
yuki-kimoto authored on 2009-12-17
973
This method is equeal to
packaging one directory
yuki-kimoto authored on 2009-11-16
974
    
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
975
    $dbi->bind_filter(undef);
976
    $dbi->fetch_filter(undef);
packaging one directory
yuki-kimoto authored on 2009-11-16
977

            
978
=head2 add_filter
979

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
980
Resist filter
packaging one directory
yuki-kimoto authored on 2009-11-16
981
    
version 0.0901
yuki-kimoto authored on 2009-12-17
982
    $dbi->add_filter($fname1 => $filter1, $fname => $filter2);
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
983
    
version 0.0901
yuki-kimoto authored on 2009-12-17
984
The following is add_filter sample
985

            
packaging one directory
yuki-kimoto authored on 2009-11-16
986
    $dbi->add_filter(
987
        encode_utf8 => sub {
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
988
            my ($value, $key, $dbi, $infos) = @_;
989
            utf8::upgrade($value) unless Encode::is_utf8($value);
990
            return encode('UTF-8', $value);
packaging one directory
yuki-kimoto authored on 2009-11-16
991
        },
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
992
        decode_utf8 => sub {
993
            my ($value, $key, $dbi, $infos) = @_;
994
            return decode('UTF-8', $value)
packaging one directory
yuki-kimoto authored on 2009-11-16
995
        }
996
    );
997

            
998
=head2 add_format
999

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

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

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1008
=head2 create_query
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1009
    
version 0.0901
yuki-kimoto authored on 2009-12-17
1010
Create Query object parsing SQL template
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1011

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

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

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

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

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

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

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

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

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1028
    $result = $dbi->query("select * from authors where {= name} and {= age}", 
1029
                          {author => 'taro', age => 19});
1030
    
1031
    while (my @row = $result->fetch) {
1032
        # do something
1033
    }
1034

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

            
1037
Return value of query method is L<DBIx::Custom::Result> object
1038

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

            
1041
=head2 run_transaction
1042

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1043
Run transaction
1044

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1045
    $dbi->run_transaction(sub {
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1046
        my $dbi = shift;
1047
        
packaging one directory
yuki-kimoto authored on 2009-11-16
1048
        # do something
1049
    });
1050

            
1051
If transaction is success, commit is execute. 
1052
If tranzation is died, rollback is execute.
1053

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1054
=head2 create_table
1055

            
1056
Create table
1057

            
1058
    $dbi->create_table(
1059
        'books',
1060
        'name char(255)',
1061
        'age  int'
1062
    );
1063

            
1064
First argument is table name. Rest arguments is column definition.
1065

            
1066
=head2 drop_table
1067

            
1068
Drop table
1069

            
1070
    $dbi->drop_table('books');
1071

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1072
=head2 insert
1073

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

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1079
Retrun value is affected rows count
packaging one directory
yuki-kimoto authored on 2009-11-16
1080
    
version 0.0901
yuki-kimoto authored on 2009-12-17
1081
The following is insert sample.
1082

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1085
You can add statement.
1086

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

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1089
=head2 update
1090

            
update document
yuki-kimoto authored on 2009-11-19
1091
Update rows
1092

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

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

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

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1102
You can add statement.
1103

            
1104
    $dbi->update('books', {title => 'Perl', author => 'Taro'},
1105
                 {id => 5}, "some statement");
1106

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1107
=head2 update_all
1108

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

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

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

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

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

            
1119
=head2 delete
1120

            
update document
yuki-kimoto authored on 2009-11-19
1121
Delete rows
1122

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1126
Retrun value is affected rows count
packaging one directory
yuki-kimoto authored on 2009-11-16
1127
    
version 0.0901
yuki-kimoto authored on 2009-12-17
1128
The following is delete sample.
1129

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

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

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

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1136
=head2 delete_all
1137

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

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

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

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

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

            
1148
=head2 select
1149
    
update document
yuki-kimoto authored on 2009-11-19
1150
Select rows
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1151

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1152
    $resut = $dbi->select(
packaging one directory
yuki-kimoto authored on 2009-11-16
1153
        $table,                # must be string or array;
version 0.0901
yuki-kimoto authored on 2009-12-17
1154
        \@$columns,            # must be array reference. this can be ommited
1155
        \%$where_params,       # must be hash reference.  this can be ommited
1156
        $append_statement,     # must be string.          this can be ommited
1157
        $query_edit_callback   # must be code reference.  this can be ommited
packaging one directory
yuki-kimoto authored on 2009-11-16
1158
    );
update document
yuki-kimoto authored on 2009-11-19
1159

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

            
1162
The following is some select samples
1163

            
1164
    # select * from books;
1165
    $result = $dbi->select('books');
packaging one directory
yuki-kimoto authored on 2009-11-16
1166
    
update document
yuki-kimoto authored on 2009-11-19
1167
    # select * from books where title = 'Perl';
1168
    $result = $dbi->select('books', {title => 1});
1169
    
1170
    # select title, author from books where id = 1 for update;
1171
    $result = $dbi->select(
1172
        'books',              # table
1173
        ['title', 'author'],  # columns
1174
        {id => 1},            # where clause
1175
        'for update',         # append statement
1176
    );
1177

            
1178
You can join multi tables
1179
    
1180
    $result = $dbi->select(
1181
        ['table1', 'table2'],                # tables
1182
        ['table1.id as table1_id', 'title'], # columns (alias is ok)
1183
        {table1.id => 1},                    # where clase
1184
        "where table1.id = table2.id",       # join clause (must start 'where')
1185
    );
1186

            
1187
You can also edit query
1188
        
packaging one directory
yuki-kimoto authored on 2009-11-16
1189
    $dbi->select(
update document
yuki-kimoto authored on 2009-11-19
1190
        'books',
1191
        # column, where clause, append statement,
packaging one directory
yuki-kimoto authored on 2009-11-16
1192
        sub {
1193
            my $query = shift;
1194
            $query->bind_filter(sub {
1195
                # ...
1196
            });
1197
        }
update document
yuki-kimoto authored on 2009-11-19
1198
    }
1199

            
1200

            
1201
=head2 last_insert_id
1202

            
1203
Get last insert id
packaging one directory
yuki-kimoto authored on 2009-11-16
1204

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

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1209
=head2 prepare
1210

            
1211
Prepare statement handle.
1212

            
1213
    $sth = $dbi->prepare('select * from books;');
1214

            
1215
This method is same as DBI prepare method.
1216

            
1217
See also L<DBI>.
1218

            
1219
=head2 do
1220

            
1221
Execute SQL
1222

            
1223
    $affected = $dbi->do('insert into books (title, author) values (?, ?)',
1224
                        'Perl', 'taro');
1225

            
1226
Retrun value is affected rows count.
1227

            
1228
This method is same as DBI do method.
1229

            
1230
See also L<DBI>
1231

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

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

            
1237
    1. AutoCommit is true
1238
    2. RaiseError is true
1239

            
1240
By default, Both AutoCommit and RaiseError is true.
1241
You must not change these mode not to damage your data.
1242

            
1243
If you change these mode, 
1244
you cannot get correct error message, 
1245
or run_transaction may fail.
1246

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

            
1249
DBIx::Custom is customizable DBI.
1250
You can inherit DBIx::Custom and custumize attributes.
1251

            
1252
    package DBIx::Custom::Yours;
1253
    use base DBIx::Custom;
1254
    
1255
    my $class = __PACKAGE__;
1256
    
1257
    $class->user('your_name');
1258
    $class->password('your_password');
1259

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1260
=head1 AUTHOR
1261

            
1262
Yuki Kimoto, C<< <kimoto.yuki at gmail.com> >>
1263

            
1264
Github L<http://github.com/yuki-kimoto>
1265

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

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

            
1270
Copyright 2009 Yuki Kimoto, all rights reserved.
1271

            
1272
This program is free software; you can redistribute it and/or modify it
1273
under the same terms as Perl itself.
1274

            
1275
=cut