DBIx-Custom / lib / DBIx / Custom.pm /
Newer Older
1228 lines | 30.835kb
cleanup
yuki-kimoto authored on 2009-12-22
1
package DBIx::Custom;
2

            
3
use strict;
4
use warnings;
5

            
remove run_transaction().
yuki-kimoto authored on 2010-01-30
6
use base 'Object::Simple';
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;
remove run_transaction().
yuki-kimoto authored on 2010-01-30
11
use DBIx::Custom::Transaction;
packaging one directory
yuki-kimoto authored on 2009-11-16
12

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

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

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

            
21
__PACKAGE__->dual_attr([qw/user password data_source/], inherit => 'scalar_copy');
22
__PACKAGE__->dual_attr([qw/database host port/],        inherit => 'scalar_copy');
23
__PACKAGE__->dual_attr([qw/bind_filter fetch_filter/],  inherit => 'scalar_copy');
packaging one directory
yuki-kimoto authored on 2009-11-16
24

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
remove run_transaction().
yuki-kimoto authored on 2010-01-30
360
sub transaction { DBIx::Custom::Transaction->new(dbi => shift) }
packaging one directory
yuki-kimoto authored on 2009-11-16
361

            
362
sub last_insert_id {
363
    my $self = shift;
add Oracle, DB2, Pg,
yuki-kimoto authored on 2009-11-16
364
    my $class = ref $self;
365
    croak "'$class' do not suppert 'last_insert_id'";
packaging one directory
yuki-kimoto authored on 2009-11-16
366
}
367

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

            
369
sub create_table {
370
    my ($self, $table, @column_definitions) = @_;
371
    
372
    # Create table
rename fetch_first to fetch_...
yuki-kimoto authored on 2010-01-29
373
    my $sql = "create table $table (";
version 0.0901
yuki-kimoto authored on 2009-12-17
374
    
375
    # Column definitions
376
    foreach my $column_definition (@column_definitions) {
rename fetch_first to fetch_...
yuki-kimoto authored on 2010-01-29
377
        $sql .= "$column_definition,";
version 0.0901
yuki-kimoto authored on 2009-12-17
378
    }
rename fetch_first to fetch_...
yuki-kimoto authored on 2010-01-29
379
    $sql =~ s/,$//;
version 0.0901
yuki-kimoto authored on 2009-12-17
380
    
381
    # End
rename fetch_first to fetch_...
yuki-kimoto authored on 2010-01-29
382
    $sql .= ");";
version 0.0901
yuki-kimoto authored on 2009-12-17
383
    
384
    # Do query
385
    return $self->do($sql);
386
}
387

            
388
sub drop_table {
389
    my ($self, $table) = @_;
390
    
391
    # Drop table
392
    my $sql = "drop table $table;";
393

            
394
    # Do query
395
    return $self->do($sql);
396
}
397

            
packaging one directory
yuki-kimoto authored on 2009-11-16
398
sub insert {
insert, update, delete appnd...
yuki-kimoto authored on 2009-11-16
399
    my $self             = shift;
400
    my $table            = shift || '';
401
    my $insert_params    = shift || {};
402
    my $append_statement = shift unless ref $_[0];
403
    my $query_edit_cb    = shift;
packaging one directory
yuki-kimoto authored on 2009-11-16
404
    
405
    # Insert keys
406
    my @insert_keys = keys %$insert_params;
407
    
408
    # Not exists insert keys
409
    croak("Key-value pairs for insert must be specified to 'insert' second argument")
410
      unless @insert_keys;
411
    
412
    # Templte for insert
413
    my $template = "insert into $table {insert " . join(' ', @insert_keys) . '}';
insert, update, delete appnd...
yuki-kimoto authored on 2009-11-16
414
    $template .= " $append_statement" if $append_statement;
packaging one directory
yuki-kimoto authored on 2009-11-16
415
    # Create query
416
    my $query = $self->create_query($template);
417
    
418
    # Query edit callback must be code reference
419
    croak("Query edit callback must be code reference")
420
      if $query_edit_cb && ref $query_edit_cb ne 'CODE';
421
    
422
    # Query edit if need
423
    $query_edit_cb->($query) if $query_edit_cb;
424
    
425
    # Execute query
version 0.0901
yuki-kimoto authored on 2009-12-17
426
    my $ret_val = $self->query($query, $insert_params);
packaging one directory
yuki-kimoto authored on 2009-11-16
427
    
428
    return $ret_val;
429
}
430

            
431
sub update {
insert, update, delete appnd...
yuki-kimoto authored on 2009-11-16
432
    my $self             = shift;
433
    my $table            = shift || '';
434
    my $update_params    = shift || {};
435
    my $where_params     = shift || {};
436
    my $append_statement = shift unless ref $_[0];
437
    my $query_edit_cb    = shift;
438
    my $options          = shift;
packaging one directory
yuki-kimoto authored on 2009-11-16
439
    
440
    # Update keys
441
    my @update_keys = keys %$update_params;
442
    
443
    # Not exists update kyes
444
    croak("Key-value pairs for update must be specified to 'update' second argument")
445
      unless @update_keys;
446
    
447
    # Where keys
448
    my @where_keys = keys %$where_params;
449
    
450
    # Not exists where keys
451
    croak("Key-value pairs for where clause must be specified to 'update' third argument")
452
      if !@where_keys && !$options->{allow_update_all};
453
    
454
    # Update clause
455
    my $update_clause = '{update ' . join(' ', @update_keys) . '}';
456
    
457
    # Where clause
458
    my $where_clause = '';
459
    if (@where_keys) {
460
        $where_clause = 'where ';
461
        foreach my $where_key (@where_keys) {
462
            $where_clause .= "{= $where_key} and ";
463
        }
464
        $where_clause =~ s/ and $//;
465
    }
466
    
467
    # Template for update
468
    my $template = "update $table $update_clause $where_clause";
insert, update, delete appnd...
yuki-kimoto authored on 2009-11-16
469
    $template .= " $append_statement" if $append_statement;
packaging one directory
yuki-kimoto authored on 2009-11-16
470
    
471
    # Create query
472
    my $query = $self->create_query($template);
473
    
474
    # Query edit callback must be code reference
475
    croak("Query edit callback must be code reference")
476
      if $query_edit_cb && ref $query_edit_cb ne 'CODE';
477
    
478
    # Query edit if need
479
    $query_edit_cb->($query) if $query_edit_cb;
480
    
481
    # Rearrange parammeters
482
    my $params = {'#update' => $update_params, %$where_params};
483
    
484
    # Execute query
version 0.0901
yuki-kimoto authored on 2009-12-17
485
    my $ret_val = $self->query($query, $params);
packaging one directory
yuki-kimoto authored on 2009-11-16
486
    
487
    return $ret_val;
488
}
489

            
490
sub update_all {
insert, update, delete appnd...
yuki-kimoto authored on 2009-11-16
491
    my $self             = shift;
492
    my $table            = shift || '';
493
    my $update_params    = shift || {};
494
    my $append_statement = shift unless ref $_[0];
495
    my $query_edit_cb    = shift;
496
    my $options          = {allow_update_all => 1};
497
    
498
    return $self->update($table, $update_params, {}, $append_statement,
499
                         $query_edit_cb, $options);
packaging one directory
yuki-kimoto authored on 2009-11-16
500
}
501

            
502
sub delete {
insert, update, delete appnd...
yuki-kimoto authored on 2009-11-16
503
    my $self             = shift;
504
    my $table            = shift || '';
505
    my $where_params     = shift || {};
506
    my $append_statement = shift unless ref $_[0];
507
    my $query_edit_cb    = shift;
508
    my $options          = shift;
packaging one directory
yuki-kimoto authored on 2009-11-16
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 'delete' second argument")
515
      if !@where_keys && !$options->{allow_delete_all};
516
    
517
    # Where clause
518
    my $where_clause = '';
519
    if (@where_keys) {
520
        $where_clause = 'where ';
521
        foreach my $where_key (@where_keys) {
522
            $where_clause .= "{= $where_key} and ";
523
        }
524
        $where_clause =~ s/ and $//;
525
    }
526
    
527
    # Template for delete
528
    my $template = "delete from $table $where_clause";
insert, update, delete appnd...
yuki-kimoto authored on 2009-11-16
529
    $template .= " $append_statement" if $append_statement;
packaging one directory
yuki-kimoto authored on 2009-11-16
530
    
531
    # Create query
532
    my $query = $self->create_query($template);
533
    
534
    # Query edit callback must be code reference
535
    croak("Query edit callback must be code reference")
536
      if $query_edit_cb && ref $query_edit_cb ne 'CODE';
537
    
538
    # Query edit if need
539
    $query_edit_cb->($query) if $query_edit_cb;
540
    
541
    # Execute query
version 0.0901
yuki-kimoto authored on 2009-12-17
542
    my $ret_val = $self->query($query, $where_params);
packaging one directory
yuki-kimoto authored on 2009-11-16
543
    
544
    return $ret_val;
545
}
546

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

            
558
sub _select_usage { return << 'EOS' }
559
Your select arguments is wrong.
560
select usage:
561
$dbi->select(
562
    $table,                # must be string or array ref
version 0.0901
yuki-kimoto authored on 2009-12-17
563
    [@$columns],           # must be array reference. this can be ommited
564
    {%$where_params},      # must be hash reference.  this can be ommited
565
    $append_statement,     # must be string.          this can be ommited
566
    $query_edit_callback   # must be code reference.  this can be ommited
packaging one directory
yuki-kimoto authored on 2009-11-16
567
);
568
EOS
569

            
570
sub select {
571
    my $self = shift;
572
    
573
    # Check argument
574
    croak($self->_select_usage) unless @_;
575
    
576
    # Arguments
577
    my $tables = shift || '';
578
    $tables    = [$tables] unless ref $tables;
579
    
580
    my $columns          = ref $_[0] eq 'ARRAY' ? shift : [];
581
    my $where_params     = ref $_[0] eq 'HASH'  ? shift : {};
582
    my $append_statement = $_[0] && !ref $_[0]  ? shift : '';
583
    my $query_edit_cb    = shift if ref $_[0] eq 'CODE';
584
    
585
    # Check rest argument
586
    croak($self->_select_usage) if @_;
587
    
588
    # SQL template for select statement
589
    my $template = 'select ';
590
    
591
    # Join column clause
592
    if (@$columns) {
593
        foreach my $column (@$columns) {
594
            $template .= "$column, ";
595
        }
596
        $template =~ s/, $/ /;
597
    }
598
    else {
599
        $template .= '* ';
600
    }
601
    
602
    # Join table
603
    $template .= 'from ';
604
    foreach my $table (@$tables) {
605
        $template .= "$table, ";
606
    }
607
    $template =~ s/, $/ /;
608
    
609
    # Where clause keys
610
    my @where_keys = keys %$where_params;
611
    
612
    # Join where clause
613
    if (@where_keys) {
614
        $template .= 'where ';
615
        foreach my $where_key (@where_keys) {
616
            $template .= "{= $where_key} and ";
617
        }
618
    }
619
    $template =~ s/ and $//;
620
    
621
    # Append something to last of statement
622
    if ($append_statement =~ s/^where //) {
623
        if (@where_keys) {
624
            $template .= " and $append_statement";
625
        }
626
        else {
627
            $template .= " where $append_statement";
628
        }
629
    }
630
    else {
631
        $template .= " $append_statement";
632
    }
633
    
634
    # Create query
635
    my $query = $self->create_query($template);
636
    
637
    # Query edit
638
    $query_edit_cb->($query) if $query_edit_cb;
639
    
640
    # Execute query
version 0.0901
yuki-kimoto authored on 2009-12-17
641
    my $result = $self->query($query, $where_params);
packaging one directory
yuki-kimoto authored on 2009-11-16
642
    
643
    return $result;
644
}
645

            
646
sub _add_query_cache {
647
    my ($class, $template, $query) = @_;
648
    my $query_cache_keys = $class->_query_cache_keys;
649
    my $query_caches     = $class->_query_caches;
650
    
651
    return $class if $query_caches->{$template};
652
    
653
    $query_caches->{$template} = $query;
654
    push @$query_cache_keys, $template;
655
    
656
    my $overflow = @$query_cache_keys - $class->query_cache_max;
657
    
658
    for (my $i = 0; $i < $overflow; $i++) {
659
        my $template = shift @$query_cache_keys;
660
        delete $query_caches->{$template};
661
    }
662
    
663
    return $class;
664
}
665

            
666
sub filter_off {
667
    my $self = shift;
668
    
669
    # filter off
670
    $self->bind_filter(undef);
671
    $self->fetch_filter(undef);
672
    
673
    return $self;
674
}
675

            
676
=head1 NAME
677

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

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

            
remove run_transaction().
yuki-kimoto authored on 2010-01-30
682
Version 0.1001
catch up with Object::Simple...
yuki-kimoto authored on 2010-01-18
683

            
684
=cut
685

            
remove run_transaction().
yuki-kimoto authored on 2010-01-30
686
our $VERSION = '0.1001';
packaging one directory
yuki-kimoto authored on 2009-11-16
687

            
version 0.0901
yuki-kimoto authored on 2009-12-17
688
=head1 SYNOPSYS
689
    
690
    # New
691
    my $dbi = DBIx::Custom->new(data_source => "dbi:mysql:database=books"
692
                                user => 'ken', password => '!LFKD%$&');
693
    
694
    # Query
695
    $dbi->query("select title from books");
696
    
697
    # Query with parameters
698
    $dbi->query("select id from books where {= author} && {like title}",
699
                {author => 'ken', title => '%Perl%'});
700
    
701
    # Insert 
702
    $dbi->insert('books', {title => 'perl', author => 'Ken'});
703
    
704
    # Update 
705
    $dbi->update('books', {title => 'aaa', author => 'Ken'}, {id => 5});
706
    
707
    # Delete
708
    $dbi->delete('books', {author => 'Ken'});
709
    
710
    # Select
711
    $dbi->select('books');
712
    $dbi->select('books', {author => 'taro'}); 
713
    $dbi->select('books', [qw/author title/], {author => 'Ken'});
714
    $dbi->select('books', [qw/author title/], {author => 'Ken'},
715
                 'order by id limit 1');
packaging one directory
yuki-kimoto authored on 2009-11-16
716

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

            
719
=head2 user
720

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
721
Set and get database user name
722
    
version 0.0901
yuki-kimoto authored on 2009-12-17
723
    $dbi  = $dbi->user('Ken');
724
    $user = $dbi->user;
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
725
    
packaging one directory
yuki-kimoto authored on 2009-11-16
726
=head2 password
727

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

            
733
=head2 data_source
734

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
735
Set and get database data source
736
    
version 0.0901
yuki-kimoto authored on 2009-12-17
737
    $dbi         = $dbi->data_source("dbi:mysql:dbname=$database");
738
    $data_source = $dbi->data_source;
packaging one directory
yuki-kimoto authored on 2009-11-16
739
    
version 0.0901
yuki-kimoto authored on 2009-12-17
740
If you know data source more, See also L<DBI>.
741

            
packaging one directory
yuki-kimoto authored on 2009-11-16
742
=head2 database
743

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

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

            
add port and host method
yuki-kimoto authored on 2009-11-16
749
=head2 host
750

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

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

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

            
758
=head2 port
759

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

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

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

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

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

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

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

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

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

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

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
785
    $dbi     = $dbi->filters({filter1 => sub { }, filter2 => sub {}});
786
    $filters = $dbi->filters;
packaging one directory
yuki-kimoto authored on 2009-11-16
787
    
version 0.0901
yuki-kimoto authored on 2009-12-17
788
This method is generally used to get a filter.
789

            
790
    $filter = $dbi->filters->{encode_utf8};
791

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

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

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

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

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

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

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

            
807
=head2 bind_filter
808

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
811
    $dbi         = $dbi->bind_filter($bind_filter);
812
    $bind_filter = $dbi->bind_filter
packaging one directory
yuki-kimoto authored on 2009-11-16
813

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

            
816
    $dbi->bind_filter(sub {
817
        my ($value, $key, $dbi, $infos) = @_;
818
        
819
        # edit $value
820
        
821
        return $value;
822
    });
packaging one directory
yuki-kimoto authored on 2009-11-16
823

            
version 0.0901
yuki-kimoto authored on 2009-12-17
824
Bind filter arguemts is
825

            
826
    1. $value : Value
827
    2. $key   : Key
828
    3. $dbi   : DBIx::Custom object
829
    4. $infos : {table => $table, column => $column}
830

            
packaging one directory
yuki-kimoto authored on 2009-11-16
831
=head2 fetch_filter
832

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

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

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

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
840
    $dbi->fetch_filter(sub {
841
        my ($value, $key, $dbi, $infos) = @_;
842
        
843
        # edit $value
844
        
845
        return $value;
846
    });
packaging one directory
yuki-kimoto authored on 2009-11-16
847

            
version 0.0901
yuki-kimoto authored on 2009-12-17
848
Bind filter arguemts is
849

            
850
    1. $value : Value
851
    2. $key   : Key
852
    3. $dbi   : DBIx::Custom object
853
    4. $infos : {type => $table, sth => $sth, index => $index}
854

            
packaging one directory
yuki-kimoto authored on 2009-11-16
855
=head2 no_bind_filters
856

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

            
862
=head2 no_fetch_filters
863

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

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

            
869
=head2 result_class
870

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

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

            
876
=head2 dbh
877

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
878
Get database handle
879
    
version 0.0901
yuki-kimoto authored on 2009-12-17
880
    $dbi = $dbi->dbh($dbh);
881
    $dbh = $dbi->dbh;
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
882
    
883
=head2 query_cache_max
884

            
885
Set and get query cache max
886

            
version 0.0901
yuki-kimoto authored on 2009-12-17
887
    $class           = DBIx::Custom->query_cache_max(50);
888
    $query_cache_max = DBIx::Custom->query_cache_max;
889

            
890
Default value is 50
891

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

            
894
=head2 connect
895

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

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

            
900
=head2 disconnect
901

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
902
Disconnect database
903

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

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

            
908
=head2 reconnect
909

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

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

            
914
=head2 connected
915

            
version 0.0901
yuki-kimoto authored on 2009-12-17
916
Check if database is connected.
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
917
    
version 0.0901
yuki-kimoto authored on 2009-12-17
918
    $is_connected = $dbi->connected;
packaging one directory
yuki-kimoto authored on 2009-11-16
919
    
920
=head2 filter_off
921

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
922
bind_filter and fitch_filter off
923
    
version 0.0901
yuki-kimoto authored on 2009-12-17
924
    $dbi->filter_off
packaging one directory
yuki-kimoto authored on 2009-11-16
925
    
version 0.0901
yuki-kimoto authored on 2009-12-17
926
This method is equeal to
packaging one directory
yuki-kimoto authored on 2009-11-16
927
    
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
928
    $dbi->bind_filter(undef);
929
    $dbi->fetch_filter(undef);
packaging one directory
yuki-kimoto authored on 2009-11-16
930

            
931
=head2 add_filter
932

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
933
Resist filter
packaging one directory
yuki-kimoto authored on 2009-11-16
934
    
version 0.0901
yuki-kimoto authored on 2009-12-17
935
    $dbi->add_filter($fname1 => $filter1, $fname => $filter2);
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
936
    
version 0.0901
yuki-kimoto authored on 2009-12-17
937
The following is add_filter sample
938

            
packaging one directory
yuki-kimoto authored on 2009-11-16
939
    $dbi->add_filter(
940
        encode_utf8 => sub {
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
941
            my ($value, $key, $dbi, $infos) = @_;
942
            utf8::upgrade($value) unless Encode::is_utf8($value);
943
            return encode('UTF-8', $value);
packaging one directory
yuki-kimoto authored on 2009-11-16
944
        },
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
945
        decode_utf8 => sub {
946
            my ($value, $key, $dbi, $infos) = @_;
947
            return decode('UTF-8', $value)
packaging one directory
yuki-kimoto authored on 2009-11-16
948
        }
949
    );
950

            
951
=head2 add_format
952

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

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

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
961
=head2 create_query
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
962
    
version 0.0901
yuki-kimoto authored on 2009-12-17
963
Create Query object parsing SQL template
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
964

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

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

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

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

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

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

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

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

            
packaging one directory
yuki-kimoto authored on 2009-11-16
981
    $result = $dbi->query("select * from authors where {= name} and {= age}", 
982
                          {author => 'taro', age => 19});
983
    
984
    while (my @row = $result->fetch) {
985
        # do something
986
    }
987

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

            
990
Return value of query method is L<DBIx::Custom::Result> object
991

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

            
remove run_transaction().
yuki-kimoto authored on 2010-01-30
994
=head2 transaction
packaging one directory
yuki-kimoto authored on 2009-11-16
995

            
remove run_transaction().
yuki-kimoto authored on 2010-01-30
996
Get L<DBIx::Custom::Transaction> object, and you run a transaction.
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
997

            
remove run_transaction().
yuki-kimoto authored on 2010-01-30
998
    $dbi->transaction->run(sub {
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
999
        my $dbi = shift;
1000
        
packaging one directory
yuki-kimoto authored on 2009-11-16
1001
        # do something
1002
    });
1003

            
1004
If transaction is success, commit is execute. 
1005
If tranzation is died, rollback is execute.
1006

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1007
=head2 create_table
1008

            
1009
Create table
1010

            
1011
    $dbi->create_table(
1012
        'books',
1013
        'name char(255)',
1014
        'age  int'
1015
    );
1016

            
1017
First argument is table name. Rest arguments is column definition.
1018

            
1019
=head2 drop_table
1020

            
1021
Drop table
1022

            
1023
    $dbi->drop_table('books');
1024

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1025
=head2 insert
1026

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

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1032
Retrun value is affected rows count
packaging one directory
yuki-kimoto authored on 2009-11-16
1033
    
version 0.0901
yuki-kimoto authored on 2009-12-17
1034
The following is insert sample.
1035

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1038
You can add statement.
1039

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

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1042
=head2 update
1043

            
update document
yuki-kimoto authored on 2009-11-19
1044
Update rows
1045

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

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

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

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1055
You can add statement.
1056

            
1057
    $dbi->update('books', {title => 'Perl', author => 'Taro'},
1058
                 {id => 5}, "some statement");
1059

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1060
=head2 update_all
1061

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

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

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

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

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

            
1072
=head2 delete
1073

            
update document
yuki-kimoto authored on 2009-11-19
1074
Delete rows
1075

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1076
    $affected = $dbi->delete($table, \%where);
1077
    $affected = $dbi->delete($table, \%where, $append);
bind_filter argument is chan...
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 delete sample.
1082

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

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

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

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

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

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

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

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

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

            
1101
=head2 select
1102
    
update document
yuki-kimoto authored on 2009-11-19
1103
Select rows
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1104

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1105
    $resut = $dbi->select(
packaging one directory
yuki-kimoto authored on 2009-11-16
1106
        $table,                # must be string or array;
version 0.0901
yuki-kimoto authored on 2009-12-17
1107
        \@$columns,            # must be array reference. this can be ommited
1108
        \%$where_params,       # must be hash reference.  this can be ommited
1109
        $append_statement,     # must be string.          this can be ommited
1110
        $query_edit_callback   # must be code reference.  this can be ommited
packaging one directory
yuki-kimoto authored on 2009-11-16
1111
    );
update document
yuki-kimoto authored on 2009-11-19
1112

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

            
1115
The following is some select samples
1116

            
1117
    # select * from books;
1118
    $result = $dbi->select('books');
packaging one directory
yuki-kimoto authored on 2009-11-16
1119
    
update document
yuki-kimoto authored on 2009-11-19
1120
    # select * from books where title = 'Perl';
1121
    $result = $dbi->select('books', {title => 1});
1122
    
1123
    # select title, author from books where id = 1 for update;
1124
    $result = $dbi->select(
1125
        'books',              # table
1126
        ['title', 'author'],  # columns
1127
        {id => 1},            # where clause
1128
        'for update',         # append statement
1129
    );
1130

            
1131
You can join multi tables
1132
    
1133
    $result = $dbi->select(
1134
        ['table1', 'table2'],                # tables
1135
        ['table1.id as table1_id', 'title'], # columns (alias is ok)
1136
        {table1.id => 1},                    # where clase
1137
        "where table1.id = table2.id",       # join clause (must start 'where')
1138
    );
1139

            
1140
You can also edit query
1141
        
packaging one directory
yuki-kimoto authored on 2009-11-16
1142
    $dbi->select(
update document
yuki-kimoto authored on 2009-11-19
1143
        'books',
1144
        # column, where clause, append statement,
packaging one directory
yuki-kimoto authored on 2009-11-16
1145
        sub {
1146
            my $query = shift;
1147
            $query->bind_filter(sub {
1148
                # ...
1149
            });
1150
        }
update document
yuki-kimoto authored on 2009-11-19
1151
    }
1152

            
1153

            
1154
=head2 last_insert_id
1155

            
1156
Get last insert id
packaging one directory
yuki-kimoto authored on 2009-11-16
1157

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

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1162
=head2 prepare
1163

            
1164
Prepare statement handle.
1165

            
1166
    $sth = $dbi->prepare('select * from books;');
1167

            
1168
This method is same as DBI prepare method.
1169

            
1170
See also L<DBI>.
1171

            
1172
=head2 do
1173

            
1174
Execute SQL
1175

            
1176
    $affected = $dbi->do('insert into books (title, author) values (?, ?)',
1177
                        'Perl', 'taro');
1178

            
1179
Retrun value is affected rows count.
1180

            
1181
This method is same as DBI do method.
1182

            
1183
See also L<DBI>
1184

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

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

            
1190
    1. AutoCommit is true
1191
    2. RaiseError is true
1192

            
1193
By default, Both AutoCommit and RaiseError is true.
1194
You must not change these mode not to damage your data.
1195

            
1196
If you change these mode, 
1197
you cannot get correct error message, 
1198
or run_transaction may fail.
1199

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

            
1202
DBIx::Custom is customizable DBI.
1203
You can inherit DBIx::Custom and custumize attributes.
1204

            
1205
    package DBIx::Custom::Yours;
1206
    use base DBIx::Custom;
1207
    
1208
    my $class = __PACKAGE__;
1209
    
1210
    $class->user('your_name');
1211
    $class->password('your_password');
1212

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1213
=head1 AUTHOR
1214

            
1215
Yuki Kimoto, C<< <kimoto.yuki at gmail.com> >>
1216

            
1217
Github L<http://github.com/yuki-kimoto>
1218

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

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

            
1223
Copyright 2009 Yuki Kimoto, all rights reserved.
1224

            
1225
This program is free software; you can redistribute it and/or modify it
1226
under the same terms as Perl itself.
1227

            
1228
=cut