DBIx-Custom / lib / DBIx / Custom.pm /
Newer Older
1313 lines | 33.471kb
packaging one directory
yuki-kimoto authored on 2009-11-16
1
use 5.008001;
2

            
3
package DBIx::Custom;
4
use Object::Simple;
5

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

            
8
use Carp 'croak';
9
use DBI;
10
use DBIx::Custom::Result;
11
use DBIx::Custom::SQL::Template;
12

            
13

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
14
### Accessors
cleanup
yuki-kimoto authored on 2009-12-17
15
sub dbh : Attr {}
packaging one directory
yuki-kimoto authored on 2009-11-16
16

            
cleanup
yuki-kimoto authored on 2009-12-17
17
sub _query_caches     : ClassAttr { type => 'hash',  build => sub {{}} }
18
sub _query_cache_keys : ClassAttr { type => 'array', build => sub {[]} }
19
sub query_cache_max   : ClassAttr { build => 50 }
packaging one directory
yuki-kimoto authored on 2009-11-16
20

            
cleanup
yuki-kimoto authored on 2009-12-17
21
sub user         : HybridAttr { clone => 'scalar' }
22
sub password     : HybridAttr { clone => 'scalar' }
23
sub data_source  : HybridAttr { clone => 'scalar' }
24
sub database     : HybridAttr { clone => 'scalar' }
25
sub host         : HybridAttr { clone => 'scalar' }
26
sub port         : HybridAttr { clone => 'scalar' }
27
sub bind_filter  : HybridAttr { clone => 'scalar' }
28
sub fetch_filter : HybridAttr { clone => 'scalar' }
version 0.0901
yuki-kimoto authored on 2009-12-17
29

            
cleanup
yuki-kimoto authored on 2009-12-17
30
sub no_bind_filters  : HybridAttr { type  => 'array', build => sub {[]}, 
31
                                    clone => 'array' }
packaging one directory
yuki-kimoto authored on 2009-11-16
32

            
cleanup
yuki-kimoto authored on 2009-12-17
33
sub no_fetch_filters : HybridAttr { type  => 'array', build => sub { [] },
34
                                    clone => 'array' }
packaging one directory
yuki-kimoto authored on 2009-11-16
35

            
cleanup
yuki-kimoto authored on 2009-12-17
36
sub options : HybridAttr { type  => 'hash', build => sub {{}}, clone => 'hash' } 
packaging one directory
yuki-kimoto authored on 2009-11-16
37

            
cleanup
yuki-kimoto authored on 2009-12-17
38
sub filters : HybridAttr { type  => 'hash', build => sub {{}},
39
                           clone => 'hash', deref => 1 }
packaging one directory
yuki-kimoto authored on 2009-11-16
40

            
cleanup
yuki-kimoto authored on 2009-12-17
41
sub formats : HybridAttr { type  => 'hash', build => sub { {} },
42
                           clone => 'hash', deref => 1 }
packaging one directory
yuki-kimoto authored on 2009-11-16
43

            
cleanup
yuki-kimoto authored on 2009-12-17
44
sub result_class : HybridAttr { build => 'DBIx::Custom::Result',
45
                                clone => 'scalar' }
packaging one directory
yuki-kimoto authored on 2009-11-16
46

            
cleanup
yuki-kimoto authored on 2009-12-17
47
sub sql_tmpl : HybridAttr { build => sub {DBIx::Custom::SQL::Template->new},
48
                            clone => sub {$_[0] ? $_[0]->clone : undef} }
packaging one directory
yuki-kimoto authored on 2009-11-16
49

            
50
### Methods
51

            
52
sub add_filter {
53
    my $invocant = shift;
54
    
55
    my %old_filters = $invocant->filters;
56
    my %new_filters = ref $_[0] eq 'HASH' ? %{$_[0]} : @_;
57
    $invocant->filters(%old_filters, %new_filters);
58
    return $invocant;
59
}
60

            
61
sub add_format{
62
    my $invocant = shift;
63
    
64
    my %old_formats = $invocant->formats;
65
    my %new_formats = ref $_[0] eq 'HASH' ? %{$_[0]} : @_;
66
    $invocant->formats(%old_formats, %new_formats);
67
    return $invocant;
68
}
69

            
70
sub _auto_commit {
71
    my $self = shift;
72
    
73
    croak("Not yet connect to database") unless $self->dbh;
74
    
75
    if (@_) {
76
        $self->dbh->{AutoCommit} = $_[0];
77
        return $self;
78
    }
79
    return $self->dbh->{AutoCommit};
80
}
81

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

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

            
112
sub connected {
113
    my $self = shift;
114
    return ref $self->{dbh} eq 'DBI::db';
115
}
116

            
117
sub disconnect {
118
    my $self = shift;
119
    if ($self->connected) {
120
        $self->dbh->disconnect;
121
        delete $self->{dbh};
122
    }
123
}
124

            
125
sub reconnect {
126
    my $self = shift;
127
    $self->disconnect if $self->connected;
128
    $self->connect;
129
}
130

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

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

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

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

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

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

            
425
sub last_insert_id {
426
    my $self = shift;
add Oracle, DB2, Pg,
yuki-kimoto authored on 2009-11-16
427
    my $class = ref $self;
428
    croak "'$class' do not suppert 'last_insert_id'";
packaging one directory
yuki-kimoto authored on 2009-11-16
429
}
430

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

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

            
451
sub drop_table {
452
    my ($self, $table) = @_;
453
    
454
    # Drop table
455
    my $sql = "drop table $table;";
456

            
457
    # Do query
458
    return $self->do($sql);
459
}
460

            
packaging one directory
yuki-kimoto authored on 2009-11-16
461
sub insert {
insert, update, delete appnd...
yuki-kimoto authored on 2009-11-16
462
    my $self             = shift;
463
    my $table            = shift || '';
464
    my $insert_params    = shift || {};
465
    my $append_statement = shift unless ref $_[0];
466
    my $query_edit_cb    = shift;
packaging one directory
yuki-kimoto authored on 2009-11-16
467
    
468
    # Insert keys
469
    my @insert_keys = keys %$insert_params;
470
    
471
    # Not exists insert keys
472
    croak("Key-value pairs for insert must be specified to 'insert' second argument")
473
      unless @insert_keys;
474
    
475
    # Templte for insert
476
    my $template = "insert into $table {insert " . join(' ', @insert_keys) . '}';
insert, update, delete appnd...
yuki-kimoto authored on 2009-11-16
477
    $template .= " $append_statement" if $append_statement;
packaging one directory
yuki-kimoto authored on 2009-11-16
478
    # Create query
479
    my $query = $self->create_query($template);
480
    
481
    # Query edit callback must be code reference
482
    croak("Query edit callback must be code reference")
483
      if $query_edit_cb && ref $query_edit_cb ne 'CODE';
484
    
485
    # Query edit if need
486
    $query_edit_cb->($query) if $query_edit_cb;
487
    
488
    # Execute query
version 0.0901
yuki-kimoto authored on 2009-12-17
489
    my $ret_val = $self->query($query, $insert_params);
packaging one directory
yuki-kimoto authored on 2009-11-16
490
    
491
    return $ret_val;
492
}
493

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

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

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

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

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

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

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

            
729
sub filter_off {
730
    my $self = shift;
731
    
732
    # filter off
733
    $self->bind_filter(undef);
734
    $self->fetch_filter(undef);
735
    
736
    return $self;
737
}
738

            
739
Object::Simple->build_class;
740

            
741
=head1 NAME
742

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

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

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

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

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

            
780
=head2 user
781

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
782
Set and get database user name
783
    
version 0.0901
yuki-kimoto authored on 2009-12-17
784
    $dbi  = $dbi->user('Ken');
785
    $user = $dbi->user;
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
786
    
packaging one directory
yuki-kimoto authored on 2009-11-16
787
=head2 password
788

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

            
794
=head2 data_source
795

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
796
Set and get database data source
797
    
version 0.0901
yuki-kimoto authored on 2009-12-17
798
    $dbi         = $dbi->data_source("dbi:mysql:dbname=$database");
799
    $data_source = $dbi->data_source;
packaging one directory
yuki-kimoto authored on 2009-11-16
800
    
version 0.0901
yuki-kimoto authored on 2009-12-17
801
If you know data source more, See also L<DBI>.
802

            
packaging one directory
yuki-kimoto authored on 2009-11-16
803
=head2 database
804

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

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

            
add port and host method
yuki-kimoto authored on 2009-11-16
810
=head2 host
811

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

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

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

            
819
=head2 port
820

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

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

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

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

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

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

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

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

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

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

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
846
    $dbi     = $dbi->filters({filter1 => sub { }, filter2 => sub {}});
847
    $filters = $dbi->filters;
packaging one directory
yuki-kimoto authored on 2009-11-16
848
    
version 0.0901
yuki-kimoto authored on 2009-12-17
849
This method is generally used to get a filter.
850

            
851
    $filter = $dbi->filters->{encode_utf8};
852

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

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

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

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

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

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

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

            
868
=head2 bind_filter
869

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
872
    $dbi         = $dbi->bind_filter($bind_filter);
873
    $bind_filter = $dbi->bind_filter
packaging one directory
yuki-kimoto authored on 2009-11-16
874

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

            
877
    $dbi->bind_filter(sub {
878
        my ($value, $key, $dbi, $infos) = @_;
879
        
880
        # edit $value
881
        
882
        return $value;
883
    });
packaging one directory
yuki-kimoto authored on 2009-11-16
884

            
version 0.0901
yuki-kimoto authored on 2009-12-17
885
Bind filter arguemts is
886

            
887
    1. $value : Value
888
    2. $key   : Key
889
    3. $dbi   : DBIx::Custom object
890
    4. $infos : {table => $table, column => $column}
891

            
packaging one directory
yuki-kimoto authored on 2009-11-16
892
=head2 fetch_filter
893

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

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

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

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
901
    $dbi->fetch_filter(sub {
902
        my ($value, $key, $dbi, $infos) = @_;
903
        
904
        # edit $value
905
        
906
        return $value;
907
    });
packaging one directory
yuki-kimoto authored on 2009-11-16
908

            
version 0.0901
yuki-kimoto authored on 2009-12-17
909
Bind filter arguemts is
910

            
911
    1. $value : Value
912
    2. $key   : Key
913
    3. $dbi   : DBIx::Custom object
914
    4. $infos : {type => $table, sth => $sth, index => $index}
915

            
packaging one directory
yuki-kimoto authored on 2009-11-16
916
=head2 no_bind_filters
917

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

            
923
=head2 no_fetch_filters
924

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

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

            
930
=head2 result_class
931

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

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

            
937
=head2 dbh
938

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
939
Get database handle
940
    
version 0.0901
yuki-kimoto authored on 2009-12-17
941
    $dbi = $dbi->dbh($dbh);
942
    $dbh = $dbi->dbh;
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
943
    
944
=head2 query_cache_max
945

            
946
Set and get query cache max
947

            
version 0.0901
yuki-kimoto authored on 2009-12-17
948
    $class           = DBIx::Custom->query_cache_max(50);
949
    $query_cache_max = DBIx::Custom->query_cache_max;
950

            
951
Default value is 50
952

            
953
=head2 Accessor summary
954

            
955
                       Accessor type       Variable type
956
    user               class and object    scalar(string)
957
    password           class and object    scalar(string)
958
    data_source        class and object    scalar(string)
959
    database           class and object    scalar(string)
960
    host               class and object    scalar(string)
961

            
962
    port               class and object    scalar(int)
963
    options            class and object    hash(string)
964
    sql_tmpl           class and object    scalar(DBIx::Custom::SQL::Template)
965
    filters            class and object    hash(code ref)
966
    formats            class and object    hash(string)
packaging one directory
yuki-kimoto authored on 2009-11-16
967

            
version 0.0901
yuki-kimoto authored on 2009-12-17
968
    bind_filter        class and object    scalar(code ref)
969
    fetch_filter       class and object    scalar(code ref)
970
    no_bind_filters    class and object    array(string)
971
    no_fetch_filters   class and object    array(string)
972
    result_class       class and object    scalar(string)
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
973

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

            
977
=head1 Methods
packaging one directory
yuki-kimoto authored on 2009-11-16
978

            
979
=head2 connect
980

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

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

            
985
=head2 disconnect
986

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
987
Disconnect database
988

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

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

            
993
=head2 reconnect
994

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

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

            
999
=head2 connected
1000

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1001
Check if database is connected.
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1002
    
version 0.0901
yuki-kimoto authored on 2009-12-17
1003
    $is_connected = $dbi->connected;
packaging one directory
yuki-kimoto authored on 2009-11-16
1004
    
1005
=head2 filter_off
1006

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1007
bind_filter and fitch_filter off
1008
    
version 0.0901
yuki-kimoto authored on 2009-12-17
1009
    $dbi->filter_off
packaging one directory
yuki-kimoto authored on 2009-11-16
1010
    
version 0.0901
yuki-kimoto authored on 2009-12-17
1011
This method is equeal to
packaging one directory
yuki-kimoto authored on 2009-11-16
1012
    
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1013
    $dbi->bind_filter(undef);
1014
    $dbi->fetch_filter(undef);
packaging one directory
yuki-kimoto authored on 2009-11-16
1015

            
1016
=head2 add_filter
1017

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1018
Resist filter
packaging one directory
yuki-kimoto authored on 2009-11-16
1019
    
version 0.0901
yuki-kimoto authored on 2009-12-17
1020
    $dbi->add_filter($fname1 => $filter1, $fname => $filter2);
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1021
    
version 0.0901
yuki-kimoto authored on 2009-12-17
1022
The following is add_filter sample
1023

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1024
    $dbi->add_filter(
1025
        encode_utf8 => sub {
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1026
            my ($value, $key, $dbi, $infos) = @_;
1027
            utf8::upgrade($value) unless Encode::is_utf8($value);
1028
            return encode('UTF-8', $value);
packaging one directory
yuki-kimoto authored on 2009-11-16
1029
        },
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1030
        decode_utf8 => sub {
1031
            my ($value, $key, $dbi, $infos) = @_;
1032
            return decode('UTF-8', $value)
packaging one directory
yuki-kimoto authored on 2009-11-16
1033
        }
1034
    );
1035

            
1036
=head2 add_format
1037

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1038
Add format
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->add_format($fname1 => $format, $fname2 => $format2);
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1041
    
version 0.0901
yuki-kimoto authored on 2009-12-17
1042
The following is add_format sample.
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1043

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1046
=head2 create_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
Create Query object parsing SQL template
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1049

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

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

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

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

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

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

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

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

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1066
    $result = $dbi->query("select * from authors where {= name} and {= age}", 
1067
                          {author => 'taro', age => 19});
1068
    
1069
    while (my @row = $result->fetch) {
1070
        # do something
1071
    }
1072

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

            
1075
Return value of query method is L<DBIx::Custom::Result> object
1076

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

            
1079
=head2 run_transaction
1080

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1081
Run transaction
1082

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1083
    $dbi->run_transaction(sub {
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1084
        my $dbi = shift;
1085
        
packaging one directory
yuki-kimoto authored on 2009-11-16
1086
        # do something
1087
    });
1088

            
1089
If transaction is success, commit is execute. 
1090
If tranzation is died, rollback is execute.
1091

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1092
=head2 create_table
1093

            
1094
Create table
1095

            
1096
    $dbi->create_table(
1097
        'books',
1098
        'name char(255)',
1099
        'age  int'
1100
    );
1101

            
1102
First argument is table name. Rest arguments is column definition.
1103

            
1104
=head2 drop_table
1105

            
1106
Drop table
1107

            
1108
    $dbi->drop_table('books');
1109

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1110
=head2 insert
1111

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

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1117
Retrun value is affected rows count
packaging one directory
yuki-kimoto authored on 2009-11-16
1118
    
version 0.0901
yuki-kimoto authored on 2009-12-17
1119
The following is insert sample.
1120

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

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

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

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1127
=head2 update
1128

            
update document
yuki-kimoto authored on 2009-11-19
1129
Update rows
1130

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

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

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

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1140
You can add statement.
1141

            
1142
    $dbi->update('books', {title => 'Perl', author => 'Taro'},
1143
                 {id => 5}, "some statement");
1144

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1145
=head2 update_all
1146

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

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

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

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

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

            
1157
=head2 delete
1158

            
update document
yuki-kimoto authored on 2009-11-19
1159
Delete rows
1160

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1164
Retrun value is affected rows count
packaging one directory
yuki-kimoto authored on 2009-11-16
1165
    
version 0.0901
yuki-kimoto authored on 2009-12-17
1166
The following is delete sample.
1167

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1170
You can add statement.
1171

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

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1174
=head2 delete_all
1175

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

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

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

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

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

            
1186
=head2 select
1187
    
update document
yuki-kimoto authored on 2009-11-19
1188
Select rows
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1189

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1190
    $resut = $dbi->select(
packaging one directory
yuki-kimoto authored on 2009-11-16
1191
        $table,                # must be string or array;
version 0.0901
yuki-kimoto authored on 2009-12-17
1192
        \@$columns,            # must be array reference. this can be ommited
1193
        \%$where_params,       # must be hash reference.  this can be ommited
1194
        $append_statement,     # must be string.          this can be ommited
1195
        $query_edit_callback   # must be code reference.  this can be ommited
packaging one directory
yuki-kimoto authored on 2009-11-16
1196
    );
update document
yuki-kimoto authored on 2009-11-19
1197

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

            
1200
The following is some select samples
1201

            
1202
    # select * from books;
1203
    $result = $dbi->select('books');
packaging one directory
yuki-kimoto authored on 2009-11-16
1204
    
update document
yuki-kimoto authored on 2009-11-19
1205
    # select * from books where title = 'Perl';
1206
    $result = $dbi->select('books', {title => 1});
1207
    
1208
    # select title, author from books where id = 1 for update;
1209
    $result = $dbi->select(
1210
        'books',              # table
1211
        ['title', 'author'],  # columns
1212
        {id => 1},            # where clause
1213
        'for update',         # append statement
1214
    );
1215

            
1216
You can join multi tables
1217
    
1218
    $result = $dbi->select(
1219
        ['table1', 'table2'],                # tables
1220
        ['table1.id as table1_id', 'title'], # columns (alias is ok)
1221
        {table1.id => 1},                    # where clase
1222
        "where table1.id = table2.id",       # join clause (must start 'where')
1223
    );
1224

            
1225
You can also edit query
1226
        
packaging one directory
yuki-kimoto authored on 2009-11-16
1227
    $dbi->select(
update document
yuki-kimoto authored on 2009-11-19
1228
        'books',
1229
        # column, where clause, append statement,
packaging one directory
yuki-kimoto authored on 2009-11-16
1230
        sub {
1231
            my $query = shift;
1232
            $query->bind_filter(sub {
1233
                # ...
1234
            });
1235
        }
update document
yuki-kimoto authored on 2009-11-19
1236
    }
1237

            
1238

            
1239
=head2 last_insert_id
1240

            
1241
Get last insert id
packaging one directory
yuki-kimoto authored on 2009-11-16
1242

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

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1247
=head2 prepare
1248

            
1249
Prepare statement handle.
1250

            
1251
    $sth = $dbi->prepare('select * from books;');
1252

            
1253
This method is same as DBI prepare method.
1254

            
1255
See also L<DBI>.
1256

            
1257
=head2 do
1258

            
1259
Execute SQL
1260

            
1261
    $affected = $dbi->do('insert into books (title, author) values (?, ?)',
1262
                        'Perl', 'taro');
1263

            
1264
Retrun value is affected rows count.
1265

            
1266
This method is same as DBI do method.
1267

            
1268
See also L<DBI>
1269

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

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

            
1275
    1. AutoCommit is true
1276
    2. RaiseError is true
1277

            
1278
By default, Both AutoCommit and RaiseError is true.
1279
You must not change these mode not to damage your data.
1280

            
1281
If you change these mode, 
1282
you cannot get correct error message, 
1283
or run_transaction may fail.
1284

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

            
1287
DBIx::Custom is customizable DBI.
1288
You can inherit DBIx::Custom and custumize attributes.
1289

            
1290
    package DBIx::Custom::Yours;
1291
    use base DBIx::Custom;
1292
    
1293
    my $class = __PACKAGE__;
1294
    
1295
    $class->user('your_name');
1296
    $class->password('your_password');
1297

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1298
=head1 AUTHOR
1299

            
1300
Yuki Kimoto, C<< <kimoto.yuki at gmail.com> >>
1301

            
1302
Github L<http://github.com/yuki-kimoto>
1303

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

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

            
1308
Copyright 2009 Yuki Kimoto, all rights reserved.
1309

            
1310
This program is free software; you can redistribute it and/or modify it
1311
under the same terms as Perl itself.
1312

            
1313
=cut