DBIx-Custom / lib / DBIx / Custom.pm /
Newer Older
1257 lines | 30.798kb
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;
cleanup
yuki-kimoto authored on 2010-02-11
12
use DBIx::Custom::Query;
packaging one directory
yuki-kimoto authored on 2009-11-16
13

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

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

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

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

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

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

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

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

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

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

            
packaging one directory
yuki-kimoto authored on 2009-11-16
55
    return $invocant;
56
}
57

            
58
sub _auto_commit {
59
    my $self = shift;
60
    
update document
yuki-kimoto authored on 2010-01-30
61
    # Not connected
packaging one directory
yuki-kimoto authored on 2009-11-16
62
    croak("Not yet connect to database") unless $self->dbh;
63
    
64
    if (@_) {
update document
yuki-kimoto authored on 2010-01-30
65
        
66
        # Set AutoCommit
packaging one directory
yuki-kimoto authored on 2009-11-16
67
        $self->dbh->{AutoCommit} = $_[0];
update document
yuki-kimoto authored on 2010-01-30
68
        
packaging one directory
yuki-kimoto authored on 2009-11-16
69
        return $self;
70
    }
71
    return $self->dbh->{AutoCommit};
72
}
73

            
74
sub connect {
75
    my $self = shift;
update document
yuki-kimoto authored on 2010-01-30
76
    
77
    # Information
packaging one directory
yuki-kimoto authored on 2009-11-16
78
    my $data_source = $self->data_source;
79
    my $user        = $self->user;
80
    my $password    = $self->password;
version 0.0901
yuki-kimoto authored on 2009-12-17
81
    my $options     = $self->options;
packaging one directory
yuki-kimoto authored on 2009-11-16
82
    
update document
yuki-kimoto authored on 2010-01-30
83
    # Connect
packaging one directory
yuki-kimoto authored on 2009-11-16
84
    my $dbh = eval{DBI->connect(
85
        $data_source,
86
        $user,
87
        $password,
88
        {
89
            RaiseError => 1,
90
            PrintError => 0,
91
            AutoCommit => 1,
version 0.0901
yuki-kimoto authored on 2009-12-17
92
            %{$options || {} }
packaging one directory
yuki-kimoto authored on 2009-11-16
93
        }
94
    )};
95
    
update document
yuki-kimoto authored on 2010-01-30
96
    # Connect error
packaging one directory
yuki-kimoto authored on 2009-11-16
97
    croak $@ if $@;
98
    
update document
yuki-kimoto authored on 2010-01-30
99
    # Database handle
packaging one directory
yuki-kimoto authored on 2009-11-16
100
    $self->dbh($dbh);
update document
yuki-kimoto authored on 2010-01-30
101
    
packaging one directory
yuki-kimoto authored on 2009-11-16
102
    return $self;
103
}
104

            
105
sub DESTROY {
106
    my $self = shift;
update document
yuki-kimoto authored on 2010-01-30
107
    
108
    # Disconnect
packaging one directory
yuki-kimoto authored on 2009-11-16
109
    $self->disconnect if $self->connected;
110
}
111

            
update document
yuki-kimoto authored on 2010-01-30
112
sub connected { ref shift->{dbh} eq 'DBI::db' }
packaging one directory
yuki-kimoto authored on 2009-11-16
113

            
114
sub disconnect {
115
    my $self = shift;
update document
yuki-kimoto authored on 2010-01-30
116
    
packaging one directory
yuki-kimoto authored on 2009-11-16
117
    if ($self->connected) {
update document
yuki-kimoto authored on 2010-01-30
118
        
119
        # Disconnect
packaging one directory
yuki-kimoto authored on 2009-11-16
120
        $self->dbh->disconnect;
121
        delete $self->{dbh};
122
    }
update document
yuki-kimoto authored on 2010-01-30
123
    
124
    return $self;
packaging one directory
yuki-kimoto authored on 2009-11-16
125
}
126

            
127
sub reconnect {
128
    my $self = shift;
update document
yuki-kimoto authored on 2010-01-30
129
    
130
    # Reconnect
packaging one directory
yuki-kimoto authored on 2009-11-16
131
    $self->disconnect if $self->connected;
132
    $self->connect;
update document
yuki-kimoto authored on 2010-01-30
133
    
134
    return $self;
packaging one directory
yuki-kimoto authored on 2009-11-16
135
}
136

            
137
sub prepare {
138
    my ($self, $sql) = @_;
139
    
140
    # Connect if not
141
    $self->connect unless $self->connected;
142
    
143
    # Prepare
144
    my $sth = eval{$self->dbh->prepare($sql)};
145
    
146
    # Error
147
    croak("$@<Your SQL>\n$sql") if $@;
148
    
149
    return $sth;
150
}
151

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

            
175
sub create_query {
176
    my ($self, $template) = @_;
cleanup
yuki-kimoto authored on 2010-02-11
177
    
packaging one directory
yuki-kimoto authored on 2009-11-16
178
    my $class = ref $self;
179
    
cleanup
yuki-kimoto authored on 2010-02-11
180
    my $table = '';
181
    if (ref $template eq 'ARRAY') {
182
        $table    = $template->[0];
183
        $template = $template->[1];
184
    }
185
    
packaging one directory
yuki-kimoto authored on 2009-11-16
186
    # Create query from SQL template
version 0.0901
yuki-kimoto authored on 2009-12-17
187
    my $sql_tmpl = $self->sql_tmpl;
packaging one directory
yuki-kimoto authored on 2009-11-16
188
    
189
    # Try to get cached query
cleanup
yuki-kimoto authored on 2010-02-11
190
    my $cached_query = $class->_query_caches->{"$table$template"};
packaging one directory
yuki-kimoto authored on 2009-11-16
191
    
192
    # Create query
fix timeformat tests
yuki-kimoto authored on 2009-11-23
193
    my $query;
cleanup
yuki-kimoto authored on 2010-02-11
194
    if ($cached_query) {
195
        $query = DBIx::Custom::Query->new(
196
            sql       => $cached_query->sql,
197
            key_infos => $cached_query->key_infos
198
        );
fix timeformat tests
yuki-kimoto authored on 2009-11-23
199
    }
200
    else {
cleanup
yuki-kimoto authored on 2010-02-11
201
        $query = eval{$sql_tmpl->create_query([$table , $template])};
packaging one directory
yuki-kimoto authored on 2009-11-16
202
        croak($@) if $@;
203
        
204
        $class->_add_query_cache($template, $query);
205
    }
206
    
207
    # Connect if not
208
    $self->connect unless $self->connected;
209
    
210
    # Prepare statement handle
211
    my $sth = $self->prepare($query->{sql});
212
    
213
    # Set statement handle
214
    $query->sth($sth);
215
    
216
    # Set bind filter
217
    $query->bind_filter($self->bind_filter);
218
    
219
    # Set no filter keys when binding
220
    $query->no_bind_filters($self->no_bind_filters);
221
    
222
    # Set fetch filter
223
    $query->fetch_filter($self->fetch_filter);
224
    
225
    # Set no filter keys when fetching
226
    $query->no_fetch_filters($self->no_fetch_filters);
227
    
228
    return $query;
229
}
230

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

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

            
cleanup
yuki-kimoto authored on 2010-02-11
368
sub _filter {
369
    my ($self, $value, $key_info, $query) = @_;
370
    
371
    my $bind_filter     = $query->bind_filter;
372
    my $no_bind_filters = $query->_no_bind_filters || {};
373
    
374
    my $original_key = $key_info->{original_key} || '';
375
    my $table        = $key_info->{table}        || '';
376
    my $column       = $key_info->{column}       || '';
377
    
378
    # Filtering 
379
    if ($bind_filter &&
380
        !$no_bind_filters->{$original_key})
381
    {
382
        return $bind_filter->($value, $original_key, $self,
383
                              {table => $table, column => $column});
384
    }
385
    
386
    # Not filtering
387
    return $value;
388
}
389

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
392
sub create_table {
393
    my ($self, $table, @column_definitions) = @_;
394
    
395
    # Create table
rename fetch_first to fetch_...
yuki-kimoto authored on 2010-01-29
396
    my $sql = "create table $table (";
version 0.0901
yuki-kimoto authored on 2009-12-17
397
    
398
    # Column definitions
399
    foreach my $column_definition (@column_definitions) {
rename fetch_first to fetch_...
yuki-kimoto authored on 2010-01-29
400
        $sql .= "$column_definition,";
version 0.0901
yuki-kimoto authored on 2009-12-17
401
    }
rename fetch_first to fetch_...
yuki-kimoto authored on 2010-01-29
402
    $sql =~ s/,$//;
version 0.0901
yuki-kimoto authored on 2009-12-17
403
    
404
    # End
rename fetch_first to fetch_...
yuki-kimoto authored on 2010-01-29
405
    $sql .= ");";
version 0.0901
yuki-kimoto authored on 2009-12-17
406
    
407
    # Do query
408
    return $self->do($sql);
409
}
410

            
411
sub drop_table {
412
    my ($self, $table) = @_;
413
    
414
    # Drop table
415
    my $sql = "drop table $table;";
416

            
417
    # Do query
418
    return $self->do($sql);
419
}
420

            
packaging one directory
yuki-kimoto authored on 2009-11-16
421
sub insert {
insert, update, delete appnd...
yuki-kimoto authored on 2009-11-16
422
    my $self             = shift;
423
    my $table            = shift || '';
424
    my $insert_params    = shift || {};
425
    my $append_statement = shift unless ref $_[0];
426
    my $query_edit_cb    = shift;
packaging one directory
yuki-kimoto authored on 2009-11-16
427
    
428
    # Insert keys
429
    my @insert_keys = keys %$insert_params;
430
    
431
    # Not exists insert keys
432
    croak("Key-value pairs for insert must be specified to 'insert' second argument")
433
      unless @insert_keys;
434
    
435
    # Templte for insert
436
    my $template = "insert into $table {insert " . join(' ', @insert_keys) . '}';
insert, update, delete appnd...
yuki-kimoto authored on 2009-11-16
437
    $template .= " $append_statement" if $append_statement;
packaging one directory
yuki-kimoto authored on 2009-11-16
438
    # Create query
439
    my $query = $self->create_query($template);
440
    
441
    # Query edit callback must be code reference
442
    croak("Query edit callback must be code reference")
443
      if $query_edit_cb && ref $query_edit_cb ne 'CODE';
444
    
445
    # Query edit if need
446
    $query_edit_cb->($query) if $query_edit_cb;
447
    
448
    # Execute query
version 0.0901
yuki-kimoto authored on 2009-12-17
449
    my $ret_val = $self->query($query, $insert_params);
packaging one directory
yuki-kimoto authored on 2009-11-16
450
    
451
    return $ret_val;
452
}
453

            
454
sub update {
insert, update, delete appnd...
yuki-kimoto authored on 2009-11-16
455
    my $self             = shift;
456
    my $table            = shift || '';
457
    my $update_params    = shift || {};
458
    my $where_params     = shift || {};
459
    my $append_statement = shift unless ref $_[0];
460
    my $query_edit_cb    = shift;
461
    my $options          = shift;
packaging one directory
yuki-kimoto authored on 2009-11-16
462
    
463
    # Update keys
464
    my @update_keys = keys %$update_params;
465
    
466
    # Not exists update kyes
467
    croak("Key-value pairs for update must be specified to 'update' second argument")
468
      unless @update_keys;
469
    
470
    # Where keys
471
    my @where_keys = keys %$where_params;
472
    
473
    # Not exists where keys
474
    croak("Key-value pairs for where clause must be specified to 'update' third argument")
475
      if !@where_keys && !$options->{allow_update_all};
476
    
477
    # Update clause
478
    my $update_clause = '{update ' . join(' ', @update_keys) . '}';
479
    
480
    # Where clause
481
    my $where_clause = '';
482
    if (@where_keys) {
483
        $where_clause = 'where ';
484
        foreach my $where_key (@where_keys) {
485
            $where_clause .= "{= $where_key} and ";
486
        }
487
        $where_clause =~ s/ and $//;
488
    }
489
    
490
    # Template for update
491
    my $template = "update $table $update_clause $where_clause";
insert, update, delete appnd...
yuki-kimoto authored on 2009-11-16
492
    $template .= " $append_statement" if $append_statement;
packaging one directory
yuki-kimoto authored on 2009-11-16
493
    
494
    # Create query
495
    my $query = $self->create_query($template);
496
    
497
    # Query edit callback must be code reference
498
    croak("Query edit callback must be code reference")
499
      if $query_edit_cb && ref $query_edit_cb ne 'CODE';
500
    
501
    # Query edit if need
502
    $query_edit_cb->($query) if $query_edit_cb;
503
    
504
    # Rearrange parammeters
add DBIx::Custom::Column
yuki-kimoto authored on 2010-02-11
505
    my $params = {%$update_params, %$where_params};
packaging one directory
yuki-kimoto authored on 2009-11-16
506
    
507
    # Execute query
version 0.0901
yuki-kimoto authored on 2009-12-17
508
    my $ret_val = $self->query($query, $params);
packaging one directory
yuki-kimoto authored on 2009-11-16
509
    
510
    return $ret_val;
511
}
512

            
513
sub update_all {
insert, update, delete appnd...
yuki-kimoto authored on 2009-11-16
514
    my $self             = shift;
515
    my $table            = shift || '';
516
    my $update_params    = shift || {};
517
    my $append_statement = shift unless ref $_[0];
518
    my $query_edit_cb    = shift;
519
    my $options          = {allow_update_all => 1};
520
    
update document
yuki-kimoto authored on 2010-01-30
521
    # Update all rows
insert, update, delete appnd...
yuki-kimoto authored on 2009-11-16
522
    return $self->update($table, $update_params, {}, $append_statement,
523
                         $query_edit_cb, $options);
packaging one directory
yuki-kimoto authored on 2009-11-16
524
}
525

            
526
sub delete {
insert, update, delete appnd...
yuki-kimoto authored on 2009-11-16
527
    my $self             = shift;
528
    my $table            = shift || '';
529
    my $where_params     = shift || {};
530
    my $append_statement = shift unless ref $_[0];
531
    my $query_edit_cb    = shift;
532
    my $options          = shift;
packaging one directory
yuki-kimoto authored on 2009-11-16
533
    
534
    # Where keys
535
    my @where_keys = keys %$where_params;
536
    
537
    # Not exists where keys
538
    croak("Key-value pairs for where clause must be specified to 'delete' second argument")
539
      if !@where_keys && !$options->{allow_delete_all};
540
    
541
    # Where clause
542
    my $where_clause = '';
543
    if (@where_keys) {
544
        $where_clause = 'where ';
545
        foreach my $where_key (@where_keys) {
546
            $where_clause .= "{= $where_key} and ";
547
        }
548
        $where_clause =~ s/ and $//;
549
    }
550
    
551
    # Template for delete
552
    my $template = "delete from $table $where_clause";
insert, update, delete appnd...
yuki-kimoto authored on 2009-11-16
553
    $template .= " $append_statement" if $append_statement;
packaging one directory
yuki-kimoto authored on 2009-11-16
554
    
555
    # Create query
556
    my $query = $self->create_query($template);
557
    
558
    # Query edit callback must be code reference
559
    croak("Query edit callback must be code reference")
560
      if $query_edit_cb && ref $query_edit_cb ne 'CODE';
561
    
562
    # Query edit if need
563
    $query_edit_cb->($query) if $query_edit_cb;
564
    
565
    # Execute query
version 0.0901
yuki-kimoto authored on 2009-12-17
566
    my $ret_val = $self->query($query, $where_params);
packaging one directory
yuki-kimoto authored on 2009-11-16
567
    
568
    return $ret_val;
569
}
570

            
571
sub delete_all {
insert, update, delete appnd...
yuki-kimoto authored on 2009-11-16
572
    my $self             = shift;
573
    my $table            = shift || '';
574
    my $append_statement = shift unless ref $_[0];
575
    my $query_edit_cb    = shift;
576
    my $options          = {allow_delete_all => 1};
577
    
update document
yuki-kimoto authored on 2010-01-30
578
    # Delete all rows
insert, update, delete appnd...
yuki-kimoto authored on 2009-11-16
579
    return $self->delete($table, {}, $append_statement, $query_edit_cb,
580
                         $options);
packaging one directory
yuki-kimoto authored on 2009-11-16
581
}
582

            
583
sub _select_usage { return << 'EOS' }
584
Your select arguments is wrong.
585
select usage:
586
$dbi->select(
cleanup
yuki-kimoto authored on 2010-02-11
587
    $table,                # String or array ref
588
    [@$columns],           # Array reference. this can be ommited
589
    {%$where_params},      # Hash reference.  this can be ommited
590
    $append_statement,     # String.          this can be ommited
591
    $query_edit_callback   # Sub reference.   this can be ommited
packaging one directory
yuki-kimoto authored on 2009-11-16
592
);
593
EOS
594

            
595
sub select {
596
    my $self = shift;
597
    
598
    # Check argument
599
    croak($self->_select_usage) unless @_;
600
    
601
    # Arguments
602
    my $tables = shift || '';
603
    $tables    = [$tables] unless ref $tables;
604
    
605
    my $columns          = ref $_[0] eq 'ARRAY' ? shift : [];
606
    my $where_params     = ref $_[0] eq 'HASH'  ? shift : {};
607
    my $append_statement = $_[0] && !ref $_[0]  ? shift : '';
608
    my $query_edit_cb    = shift if ref $_[0] eq 'CODE';
609
    
610
    # Check rest argument
611
    croak($self->_select_usage) if @_;
612
    
613
    # SQL template for select statement
614
    my $template = 'select ';
615
    
616
    # Join column clause
617
    if (@$columns) {
618
        foreach my $column (@$columns) {
619
            $template .= "$column, ";
620
        }
621
        $template =~ s/, $/ /;
622
    }
623
    else {
624
        $template .= '* ';
625
    }
626
    
627
    # Join table
628
    $template .= 'from ';
629
    foreach my $table (@$tables) {
630
        $template .= "$table, ";
631
    }
632
    $template =~ s/, $/ /;
633
    
634
    # Where clause keys
635
    my @where_keys = keys %$where_params;
636
    
637
    # Join where clause
638
    if (@where_keys) {
639
        $template .= 'where ';
640
        foreach my $where_key (@where_keys) {
641
            $template .= "{= $where_key} and ";
642
        }
643
    }
644
    $template =~ s/ and $//;
645
    
646
    # Append something to last of statement
647
    if ($append_statement =~ s/^where //) {
648
        if (@where_keys) {
649
            $template .= " and $append_statement";
650
        }
651
        else {
652
            $template .= " where $append_statement";
653
        }
654
    }
655
    else {
656
        $template .= " $append_statement";
657
    }
658
    
659
    # Create query
660
    my $query = $self->create_query($template);
661
    
662
    # Query edit
663
    $query_edit_cb->($query) if $query_edit_cb;
664
    
665
    # Execute query
version 0.0901
yuki-kimoto authored on 2009-12-17
666
    my $result = $self->query($query, $where_params);
packaging one directory
yuki-kimoto authored on 2009-11-16
667
    
668
    return $result;
669
}
670

            
671
sub _add_query_cache {
672
    my ($class, $template, $query) = @_;
update document
yuki-kimoto authored on 2010-01-30
673
    
674
    # Query information
packaging one directory
yuki-kimoto authored on 2009-11-16
675
    my $query_cache_keys = $class->_query_cache_keys;
676
    my $query_caches     = $class->_query_caches;
677
    
update document
yuki-kimoto authored on 2010-01-30
678
    # Already cached
packaging one directory
yuki-kimoto authored on 2009-11-16
679
    return $class if $query_caches->{$template};
680
    
update document
yuki-kimoto authored on 2010-01-30
681
    # Cache
packaging one directory
yuki-kimoto authored on 2009-11-16
682
    $query_caches->{$template} = $query;
683
    push @$query_cache_keys, $template;
684
    
update document
yuki-kimoto authored on 2010-01-30
685
    # Check cache overflow
packaging one directory
yuki-kimoto authored on 2009-11-16
686
    my $overflow = @$query_cache_keys - $class->query_cache_max;
687
    for (my $i = 0; $i < $overflow; $i++) {
688
        my $template = shift @$query_cache_keys;
689
        delete $query_caches->{$template};
690
    }
691
    
692
    return $class;
693
}
694

            
695
sub filter_off {
696
    my $self = shift;
697
    
update document
yuki-kimoto authored on 2010-01-30
698
    # Filter off
packaging one directory
yuki-kimoto authored on 2009-11-16
699
    $self->bind_filter(undef);
700
    $self->fetch_filter(undef);
701
    
702
    return $self;
703
}
704

            
705
=head1 NAME
706

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

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

            
update document
yuki-kimoto authored on 2010-01-30
711
Version 0.1101
catch up with Object::Simple...
yuki-kimoto authored on 2010-01-18
712

            
713
=cut
714

            
update document
yuki-kimoto authored on 2010-01-30
715
our $VERSION = '0.1101';
packaging one directory
yuki-kimoto authored on 2009-11-16
716

            
cleanup
yuki-kimoto authored on 2010-02-11
717
=head1 STATE
718

            
719
This module is not stable. Method name and functionality will be change.
720

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

            
update document
yuki-kimoto authored on 2010-01-30
750
=head1 ATTRIBUTES
packaging one directory
yuki-kimoto authored on 2009-11-16
751

            
752
=head2 user
753

            
update document
yuki-kimoto authored on 2010-01-30
754
Database user name
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
755
    
version 0.0901
yuki-kimoto authored on 2009-12-17
756
    $dbi  = $dbi->user('Ken');
757
    $user = $dbi->user;
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
758
    
packaging one directory
yuki-kimoto authored on 2009-11-16
759
=head2 password
760

            
update document
yuki-kimoto authored on 2010-01-30
761
Database password
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
762
    
version 0.0901
yuki-kimoto authored on 2009-12-17
763
    $dbi      = $dbi->password('lkj&le`@s');
764
    $password = $dbi->password;
packaging one directory
yuki-kimoto authored on 2009-11-16
765

            
766
=head2 data_source
767

            
update document
yuki-kimoto authored on 2010-01-30
768
Database data source
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
769
    
version 0.0901
yuki-kimoto authored on 2009-12-17
770
    $dbi         = $dbi->data_source("dbi:mysql:dbname=$database");
771
    $data_source = $dbi->data_source;
packaging one directory
yuki-kimoto authored on 2009-11-16
772
    
version 0.0901
yuki-kimoto authored on 2009-12-17
773
If you know data source more, See also L<DBI>.
774

            
packaging one directory
yuki-kimoto authored on 2009-11-16
775
=head2 database
776

            
update document
yuki-kimoto authored on 2010-01-30
777
Database name
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
778

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

            
add port and host method
yuki-kimoto authored on 2009-11-16
782
=head2 host
783

            
update document
yuki-kimoto authored on 2010-01-30
784
Host name
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
785

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

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

            
791
=head2 port
792

            
update document
yuki-kimoto authored on 2010-01-30
793
Port number
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
794

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

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

            
update document
yuki-kimoto authored on 2010-01-30
800
DBI options
packaging one directory
yuki-kimoto authored on 2009-11-16
801

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

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

            
update document
yuki-kimoto authored on 2010-01-30
807
SQL::Template object
packaging one directory
yuki-kimoto authored on 2009-11-16
808

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

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

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

            
update document
yuki-kimoto authored on 2010-01-30
816
Filters
packaging one directory
yuki-kimoto authored on 2009-11-16
817

            
version 0.0901
yuki-kimoto authored on 2009-12-17
818
    $dbi     = $dbi->filters({filter1 => sub { }, filter2 => sub {}});
819
    $filters = $dbi->filters;
packaging one directory
yuki-kimoto authored on 2009-11-16
820
    
version 0.0901
yuki-kimoto authored on 2009-12-17
821
This method is generally used to get a filter.
822

            
823
    $filter = $dbi->filters->{encode_utf8};
824

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

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

            
update document
yuki-kimoto authored on 2010-01-30
829
Formats
packaging one directory
yuki-kimoto authored on 2009-11-16
830

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

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

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

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

            
840
=head2 bind_filter
841

            
update document
yuki-kimoto authored on 2010-01-30
842
Binding filter
packaging one directory
yuki-kimoto authored on 2009-11-16
843

            
version 0.0901
yuki-kimoto authored on 2009-12-17
844
    $dbi         = $dbi->bind_filter($bind_filter);
845
    $bind_filter = $dbi->bind_filter
packaging one directory
yuki-kimoto authored on 2009-11-16
846

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

            
849
    $dbi->bind_filter(sub {
850
        my ($value, $key, $dbi, $infos) = @_;
851
        
852
        # edit $value
853
        
854
        return $value;
855
    });
packaging one directory
yuki-kimoto authored on 2009-11-16
856

            
version 0.0901
yuki-kimoto authored on 2009-12-17
857
Bind filter arguemts is
858

            
859
    1. $value : Value
860
    2. $key   : Key
861
    3. $dbi   : DBIx::Custom object
862
    4. $infos : {table => $table, column => $column}
863

            
packaging one directory
yuki-kimoto authored on 2009-11-16
864
=head2 fetch_filter
865

            
update document
yuki-kimoto authored on 2010-01-30
866
Fetching filter
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
867

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

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

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
873
    $dbi->fetch_filter(sub {
874
        my ($value, $key, $dbi, $infos) = @_;
875
        
876
        # edit $value
877
        
878
        return $value;
879
    });
packaging one directory
yuki-kimoto authored on 2009-11-16
880

            
version 0.0901
yuki-kimoto authored on 2009-12-17
881
Bind filter arguemts is
882

            
883
    1. $value : Value
884
    2. $key   : Key
885
    3. $dbi   : DBIx::Custom object
886
    4. $infos : {type => $table, sth => $sth, index => $index}
887

            
packaging one directory
yuki-kimoto authored on 2009-11-16
888
=head2 no_bind_filters
889

            
update document
yuki-kimoto authored on 2010-01-30
890
Key list which dose not have to bind filtering
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
891
    
version 0.0901
yuki-kimoto authored on 2009-12-17
892
    $dbi             = $dbi->no_bind_filters(qw/title author/);
893
    $no_bind_filters = $dbi->no_bind_filters;
packaging one directory
yuki-kimoto authored on 2009-11-16
894

            
895
=head2 no_fetch_filters
896

            
update document
yuki-kimoto authored on 2010-01-30
897
Key list which dose not have to fetch filtering
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
898

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

            
902
=head2 result_class
903

            
update document
yuki-kimoto authored on 2010-01-30
904
Resultset class
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
905

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

            
update document
yuki-kimoto authored on 2010-01-30
909
Default is L<DBIx::Custom::Result>
910

            
packaging one directory
yuki-kimoto authored on 2009-11-16
911
=head2 dbh
912

            
update document
yuki-kimoto authored on 2010-01-30
913
Database handle
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
914
    
version 0.0901
yuki-kimoto authored on 2009-12-17
915
    $dbi = $dbi->dbh($dbh);
916
    $dbh = $dbi->dbh;
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
917
    
918
=head2 query_cache_max
919

            
update document
yuki-kimoto authored on 2010-01-30
920
Query cache max
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
921

            
version 0.0901
yuki-kimoto authored on 2009-12-17
922
    $class           = DBIx::Custom->query_cache_max(50);
923
    $query_cache_max = DBIx::Custom->query_cache_max;
924

            
925
Default value is 50
926

            
update document
yuki-kimoto authored on 2010-01-30
927
=head1 METHODS
928

            
929
This class is L<Object::Simple> subclass.
930
You can use all methods of L<Object::Simple>
packaging one directory
yuki-kimoto authored on 2009-11-16
931

            
932
=head2 connect
933

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

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

            
938
=head2 disconnect
939

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
940
Disconnect database
941

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

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

            
946
=head2 reconnect
947

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

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

            
952
=head2 connected
953

            
version 0.0901
yuki-kimoto authored on 2009-12-17
954
Check if database is connected.
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
955
    
version 0.0901
yuki-kimoto authored on 2009-12-17
956
    $is_connected = $dbi->connected;
packaging one directory
yuki-kimoto authored on 2009-11-16
957
    
958
=head2 filter_off
959

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
960
bind_filter and fitch_filter off
961
    
version 0.0901
yuki-kimoto authored on 2009-12-17
962
    $dbi->filter_off
packaging one directory
yuki-kimoto authored on 2009-11-16
963
    
version 0.0901
yuki-kimoto authored on 2009-12-17
964
This method is equeal to
packaging one directory
yuki-kimoto authored on 2009-11-16
965
    
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
966
    $dbi->bind_filter(undef);
967
    $dbi->fetch_filter(undef);
packaging one directory
yuki-kimoto authored on 2009-11-16
968

            
969
=head2 add_filter
970

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
971
Resist filter
packaging one directory
yuki-kimoto authored on 2009-11-16
972
    
version 0.0901
yuki-kimoto authored on 2009-12-17
973
    $dbi->add_filter($fname1 => $filter1, $fname => $filter2);
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
974
    
version 0.0901
yuki-kimoto authored on 2009-12-17
975
The following is add_filter sample
976

            
packaging one directory
yuki-kimoto authored on 2009-11-16
977
    $dbi->add_filter(
978
        encode_utf8 => sub {
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
979
            my ($value, $key, $dbi, $infos) = @_;
980
            utf8::upgrade($value) unless Encode::is_utf8($value);
981
            return encode('UTF-8', $value);
packaging one directory
yuki-kimoto authored on 2009-11-16
982
        },
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
983
        decode_utf8 => sub {
984
            my ($value, $key, $dbi, $infos) = @_;
985
            return decode('UTF-8', $value)
packaging one directory
yuki-kimoto authored on 2009-11-16
986
        }
987
    );
988

            
989
=head2 add_format
990

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

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

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
999
=head2 create_query
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1000
    
version 0.0901
yuki-kimoto authored on 2009-12-17
1001
Create Query object parsing SQL template
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1002

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

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

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

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

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

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

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

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

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1019
    $result = $dbi->query("select * from authors where {= name} and {= age}", 
1020
                          {author => 'taro', age => 19});
1021
    
1022
    while (my @row = $result->fetch) {
1023
        # do something
1024
    }
1025

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

            
1028
Return value of query method is L<DBIx::Custom::Result> object
1029

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

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

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

            
remove run_transaction().
yuki-kimoto authored on 2010-01-30
1036
    $dbi->transaction->run(sub {
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1037
        my $dbi = shift;
1038
        
packaging one directory
yuki-kimoto authored on 2009-11-16
1039
        # do something
1040
    });
1041

            
1042
If transaction is success, commit is execute. 
1043
If tranzation is died, rollback is execute.
1044

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1045
=head2 create_table
1046

            
1047
Create table
1048

            
1049
    $dbi->create_table(
1050
        'books',
1051
        'name char(255)',
1052
        'age  int'
1053
    );
1054

            
1055
First argument is table name. Rest arguments is column definition.
1056

            
1057
=head2 drop_table
1058

            
1059
Drop table
1060

            
1061
    $dbi->drop_table('books');
1062

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1063
=head2 insert
1064

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

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1070
Retrun value is affected rows count
packaging one directory
yuki-kimoto authored on 2009-11-16
1071
    
version 0.0901
yuki-kimoto authored on 2009-12-17
1072
The following is insert sample.
1073

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1076
You can add statement.
1077

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

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1080
=head2 update
1081

            
update document
yuki-kimoto authored on 2009-11-19
1082
Update rows
1083

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

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

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

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1093
You can add statement.
1094

            
1095
    $dbi->update('books', {title => 'Perl', author => 'Taro'},
1096
                 {id => 5}, "some statement");
1097

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1098
=head2 update_all
1099

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

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

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

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

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

            
1110
=head2 delete
1111

            
update document
yuki-kimoto authored on 2009-11-19
1112
Delete rows
1113

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

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

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

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

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

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

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

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

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

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

            
1139
=head2 select
1140
    
update document
yuki-kimoto authored on 2009-11-19
1141
Select rows
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1142

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1143
    $resut = $dbi->select(
packaging one directory
yuki-kimoto authored on 2009-11-16
1144
        $table,                # must be string or array;
version 0.0901
yuki-kimoto authored on 2009-12-17
1145
        \@$columns,            # must be array reference. this can be ommited
1146
        \%$where_params,       # must be hash reference.  this can be ommited
1147
        $append_statement,     # must be string.          this can be ommited
1148
        $query_edit_callback   # must be code reference.  this can be ommited
packaging one directory
yuki-kimoto authored on 2009-11-16
1149
    );
update document
yuki-kimoto authored on 2009-11-19
1150

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

            
1153
The following is some select samples
1154

            
1155
    # select * from books;
1156
    $result = $dbi->select('books');
packaging one directory
yuki-kimoto authored on 2009-11-16
1157
    
update document
yuki-kimoto authored on 2009-11-19
1158
    # select * from books where title = 'Perl';
1159
    $result = $dbi->select('books', {title => 1});
1160
    
1161
    # select title, author from books where id = 1 for update;
1162
    $result = $dbi->select(
1163
        'books',              # table
1164
        ['title', 'author'],  # columns
1165
        {id => 1},            # where clause
1166
        'for update',         # append statement
1167
    );
1168

            
1169
You can join multi tables
1170
    
1171
    $result = $dbi->select(
1172
        ['table1', 'table2'],                # tables
1173
        ['table1.id as table1_id', 'title'], # columns (alias is ok)
1174
        {table1.id => 1},                    # where clase
1175
        "where table1.id = table2.id",       # join clause (must start 'where')
1176
    );
1177

            
1178
You can also edit query
1179
        
packaging one directory
yuki-kimoto authored on 2009-11-16
1180
    $dbi->select(
update document
yuki-kimoto authored on 2009-11-19
1181
        'books',
1182
        # column, where clause, append statement,
packaging one directory
yuki-kimoto authored on 2009-11-16
1183
        sub {
1184
            my $query = shift;
1185
            $query->bind_filter(sub {
1186
                # ...
1187
            });
1188
        }
update document
yuki-kimoto authored on 2009-11-19
1189
    }
1190

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1191
=head2 prepare
1192

            
1193
Prepare statement handle.
1194

            
1195
    $sth = $dbi->prepare('select * from books;');
1196

            
1197
This method is same as DBI prepare method.
1198

            
1199
See also L<DBI>.
1200

            
1201
=head2 do
1202

            
1203
Execute SQL
1204

            
1205
    $affected = $dbi->do('insert into books (title, author) values (?, ?)',
1206
                        'Perl', 'taro');
1207

            
1208
Retrun value is affected rows count.
1209

            
1210
This method is same as DBI do method.
1211

            
1212
See also L<DBI>
1213

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

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

            
1219
    1. AutoCommit is true
1220
    2. RaiseError is true
1221

            
1222
By default, Both AutoCommit and RaiseError is true.
1223
You must not change these mode not to damage your data.
1224

            
1225
If you change these mode, 
1226
you cannot get correct error message, 
1227
or run_transaction may fail.
1228

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

            
1231
DBIx::Custom is customizable DBI.
1232
You can inherit DBIx::Custom and custumize attributes.
1233

            
1234
    package DBIx::Custom::Yours;
1235
    use base DBIx::Custom;
1236
    
1237
    my $class = __PACKAGE__;
1238
    
1239
    $class->user('your_name');
1240
    $class->password('your_password');
1241

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1242
=head1 AUTHOR
1243

            
1244
Yuki Kimoto, C<< <kimoto.yuki at gmail.com> >>
1245

            
1246
Github L<http://github.com/yuki-kimoto>
1247

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

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

            
1252
Copyright 2009 Yuki Kimoto, all rights reserved.
1253

            
1254
This program is free software; you can redistribute it and/or modify it
1255
under the same terms as Perl itself.
1256

            
1257
=cut