DBIx-Custom / lib / DBIx / Custom.pm /
Newer Older
1243 lines | 30.954kb
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
    
update document
yuki-kimoto authored on 2010-01-30
40
    # Add filter
catch up with Object::Simple...
yuki-kimoto authored on 2010-01-18
41
    my $filters = ref $_[0] eq 'HASH' ? $_[0] : {@_};
42
    $invocant->filters({%{$invocant->filters}, %$filters});
43
    
packaging one directory
yuki-kimoto authored on 2009-11-16
44
    return $invocant;
45
}
46

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
382
sub create_table {
383
    my ($self, $table, @column_definitions) = @_;
384
    
385
    # Create table
rename fetch_first to fetch_...
yuki-kimoto authored on 2010-01-29
386
    my $sql = "create table $table (";
version 0.0901
yuki-kimoto authored on 2009-12-17
387
    
388
    # Column definitions
389
    foreach my $column_definition (@column_definitions) {
rename fetch_first to fetch_...
yuki-kimoto authored on 2010-01-29
390
        $sql .= "$column_definition,";
version 0.0901
yuki-kimoto authored on 2009-12-17
391
    }
rename fetch_first to fetch_...
yuki-kimoto authored on 2010-01-29
392
    $sql =~ s/,$//;
version 0.0901
yuki-kimoto authored on 2009-12-17
393
    
394
    # End
rename fetch_first to fetch_...
yuki-kimoto authored on 2010-01-29
395
    $sql .= ");";
version 0.0901
yuki-kimoto authored on 2009-12-17
396
    
397
    # Do query
398
    return $self->do($sql);
399
}
400

            
401
sub drop_table {
402
    my ($self, $table) = @_;
403
    
404
    # Drop table
405
    my $sql = "drop table $table;";
406

            
407
    # Do query
408
    return $self->do($sql);
409
}
410

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

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

            
503
sub update_all {
insert, update, delete appnd...
yuki-kimoto authored on 2009-11-16
504
    my $self             = shift;
505
    my $table            = shift || '';
506
    my $update_params    = shift || {};
507
    my $append_statement = shift unless ref $_[0];
508
    my $query_edit_cb    = shift;
509
    my $options          = {allow_update_all => 1};
510
    
update document
yuki-kimoto authored on 2010-01-30
511
    # Update all rows
insert, update, delete appnd...
yuki-kimoto authored on 2009-11-16
512
    return $self->update($table, $update_params, {}, $append_statement,
513
                         $query_edit_cb, $options);
packaging one directory
yuki-kimoto authored on 2009-11-16
514
}
515

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

            
561
sub delete_all {
insert, update, delete appnd...
yuki-kimoto authored on 2009-11-16
562
    my $self             = shift;
563
    my $table            = shift || '';
564
    my $append_statement = shift unless ref $_[0];
565
    my $query_edit_cb    = shift;
566
    my $options          = {allow_delete_all => 1};
567
    
update document
yuki-kimoto authored on 2010-01-30
568
    # Delete all rows
insert, update, delete appnd...
yuki-kimoto authored on 2009-11-16
569
    return $self->delete($table, {}, $append_statement, $query_edit_cb,
570
                         $options);
packaging one directory
yuki-kimoto authored on 2009-11-16
571
}
572

            
573
sub _select_usage { return << 'EOS' }
574
Your select arguments is wrong.
575
select usage:
576
$dbi->select(
577
    $table,                # must be string or array ref
version 0.0901
yuki-kimoto authored on 2009-12-17
578
    [@$columns],           # must be array reference. this can be ommited
579
    {%$where_params},      # must be hash reference.  this can be ommited
580
    $append_statement,     # must be string.          this can be ommited
581
    $query_edit_callback   # must be code reference.  this can be ommited
packaging one directory
yuki-kimoto authored on 2009-11-16
582
);
583
EOS
584

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

            
661
sub _add_query_cache {
662
    my ($class, $template, $query) = @_;
update document
yuki-kimoto authored on 2010-01-30
663
    
664
    # Query information
packaging one directory
yuki-kimoto authored on 2009-11-16
665
    my $query_cache_keys = $class->_query_cache_keys;
666
    my $query_caches     = $class->_query_caches;
667
    
update document
yuki-kimoto authored on 2010-01-30
668
    # Already cached
packaging one directory
yuki-kimoto authored on 2009-11-16
669
    return $class if $query_caches->{$template};
670
    
update document
yuki-kimoto authored on 2010-01-30
671
    # Cache
packaging one directory
yuki-kimoto authored on 2009-11-16
672
    $query_caches->{$template} = $query;
673
    push @$query_cache_keys, $template;
674
    
update document
yuki-kimoto authored on 2010-01-30
675
    # Check cache overflow
packaging one directory
yuki-kimoto authored on 2009-11-16
676
    my $overflow = @$query_cache_keys - $class->query_cache_max;
677
    for (my $i = 0; $i < $overflow; $i++) {
678
        my $template = shift @$query_cache_keys;
679
        delete $query_caches->{$template};
680
    }
681
    
682
    return $class;
683
}
684

            
685
sub filter_off {
686
    my $self = shift;
687
    
update document
yuki-kimoto authored on 2010-01-30
688
    # Filter off
packaging one directory
yuki-kimoto authored on 2009-11-16
689
    $self->bind_filter(undef);
690
    $self->fetch_filter(undef);
691
    
692
    return $self;
693
}
694

            
695
=head1 NAME
696

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

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

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

            
703
=cut
704

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
707
=head1 SYNOPSYS
708
    
709
    # New
710
    my $dbi = DBIx::Custom->new(data_source => "dbi:mysql:database=books"
711
                                user => 'ken', password => '!LFKD%$&');
712
    
713
    # Query
714
    $dbi->query("select title from books");
715
    
716
    # Query with parameters
717
    $dbi->query("select id from books where {= author} && {like title}",
718
                {author => 'ken', title => '%Perl%'});
719
    
720
    # Insert 
721
    $dbi->insert('books', {title => 'perl', author => 'Ken'});
722
    
723
    # Update 
724
    $dbi->update('books', {title => 'aaa', author => 'Ken'}, {id => 5});
725
    
726
    # Delete
727
    $dbi->delete('books', {author => 'Ken'});
728
    
729
    # Select
730
    $dbi->select('books');
731
    $dbi->select('books', {author => 'taro'}); 
732
    $dbi->select('books', [qw/author title/], {author => 'Ken'});
733
    $dbi->select('books', [qw/author title/], {author => 'Ken'},
734
                 'order by id limit 1');
packaging one directory
yuki-kimoto authored on 2009-11-16
735

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

            
738
=head2 user
739

            
update document
yuki-kimoto authored on 2010-01-30
740
Database user name
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
741
    
version 0.0901
yuki-kimoto authored on 2009-12-17
742
    $dbi  = $dbi->user('Ken');
743
    $user = $dbi->user;
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
744
    
packaging one directory
yuki-kimoto authored on 2009-11-16
745
=head2 password
746

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

            
752
=head2 data_source
753

            
update document
yuki-kimoto authored on 2010-01-30
754
Database data source
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->data_source("dbi:mysql:dbname=$database");
757
    $data_source = $dbi->data_source;
packaging one directory
yuki-kimoto authored on 2009-11-16
758
    
version 0.0901
yuki-kimoto authored on 2009-12-17
759
If you know data source more, See also L<DBI>.
760

            
packaging one directory
yuki-kimoto authored on 2009-11-16
761
=head2 database
762

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

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

            
add port and host method
yuki-kimoto authored on 2009-11-16
768
=head2 host
769

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

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

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

            
777
=head2 port
778

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

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

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

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

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

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

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

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

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

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

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
804
    $dbi     = $dbi->filters({filter1 => sub { }, filter2 => sub {}});
805
    $filters = $dbi->filters;
packaging one directory
yuki-kimoto authored on 2009-11-16
806
    
version 0.0901
yuki-kimoto authored on 2009-12-17
807
This method is generally used to get a filter.
808

            
809
    $filter = $dbi->filters->{encode_utf8};
810

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

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

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

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

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

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

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

            
826
=head2 bind_filter
827

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
830
    $dbi         = $dbi->bind_filter($bind_filter);
831
    $bind_filter = $dbi->bind_filter
packaging one directory
yuki-kimoto authored on 2009-11-16
832

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

            
835
    $dbi->bind_filter(sub {
836
        my ($value, $key, $dbi, $infos) = @_;
837
        
838
        # edit $value
839
        
840
        return $value;
841
    });
packaging one directory
yuki-kimoto authored on 2009-11-16
842

            
version 0.0901
yuki-kimoto authored on 2009-12-17
843
Bind filter arguemts is
844

            
845
    1. $value : Value
846
    2. $key   : Key
847
    3. $dbi   : DBIx::Custom object
848
    4. $infos : {table => $table, column => $column}
849

            
packaging one directory
yuki-kimoto authored on 2009-11-16
850
=head2 fetch_filter
851

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

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

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

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
859
    $dbi->fetch_filter(sub {
860
        my ($value, $key, $dbi, $infos) = @_;
861
        
862
        # edit $value
863
        
864
        return $value;
865
    });
packaging one directory
yuki-kimoto authored on 2009-11-16
866

            
version 0.0901
yuki-kimoto authored on 2009-12-17
867
Bind filter arguemts is
868

            
869
    1. $value : Value
870
    2. $key   : Key
871
    3. $dbi   : DBIx::Custom object
872
    4. $infos : {type => $table, sth => $sth, index => $index}
873

            
packaging one directory
yuki-kimoto authored on 2009-11-16
874
=head2 no_bind_filters
875

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

            
881
=head2 no_fetch_filters
882

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

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

            
888
=head2 result_class
889

            
update document
yuki-kimoto authored on 2010-01-30
890
Resultset class
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->result_class('DBIx::Custom::Result');
packaging one directory
yuki-kimoto authored on 2009-11-16
893
    $result_class = $dbi->result_class;
894

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

            
packaging one directory
yuki-kimoto authored on 2009-11-16
897
=head2 dbh
898

            
update document
yuki-kimoto authored on 2010-01-30
899
Database handle
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
900
    
version 0.0901
yuki-kimoto authored on 2009-12-17
901
    $dbi = $dbi->dbh($dbh);
902
    $dbh = $dbi->dbh;
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
903
    
904
=head2 query_cache_max
905

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
908
    $class           = DBIx::Custom->query_cache_max(50);
909
    $query_cache_max = DBIx::Custom->query_cache_max;
910

            
911
Default value is 50
912

            
update document
yuki-kimoto authored on 2010-01-30
913
=head1 METHODS
914

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

            
918
=head2 connect
919

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

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

            
924
=head2 disconnect
925

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
926
Disconnect database
927

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

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

            
932
=head2 reconnect
933

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

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

            
938
=head2 connected
939

            
version 0.0901
yuki-kimoto authored on 2009-12-17
940
Check if database is connected.
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
941
    
version 0.0901
yuki-kimoto authored on 2009-12-17
942
    $is_connected = $dbi->connected;
packaging one directory
yuki-kimoto authored on 2009-11-16
943
    
944
=head2 filter_off
945

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
946
bind_filter and fitch_filter off
947
    
version 0.0901
yuki-kimoto authored on 2009-12-17
948
    $dbi->filter_off
packaging one directory
yuki-kimoto authored on 2009-11-16
949
    
version 0.0901
yuki-kimoto authored on 2009-12-17
950
This method is equeal to
packaging one directory
yuki-kimoto authored on 2009-11-16
951
    
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
952
    $dbi->bind_filter(undef);
953
    $dbi->fetch_filter(undef);
packaging one directory
yuki-kimoto authored on 2009-11-16
954

            
955
=head2 add_filter
956

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
957
Resist filter
packaging one directory
yuki-kimoto authored on 2009-11-16
958
    
version 0.0901
yuki-kimoto authored on 2009-12-17
959
    $dbi->add_filter($fname1 => $filter1, $fname => $filter2);
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
960
    
version 0.0901
yuki-kimoto authored on 2009-12-17
961
The following is add_filter sample
962

            
packaging one directory
yuki-kimoto authored on 2009-11-16
963
    $dbi->add_filter(
964
        encode_utf8 => sub {
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
965
            my ($value, $key, $dbi, $infos) = @_;
966
            utf8::upgrade($value) unless Encode::is_utf8($value);
967
            return encode('UTF-8', $value);
packaging one directory
yuki-kimoto authored on 2009-11-16
968
        },
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
969
        decode_utf8 => sub {
970
            my ($value, $key, $dbi, $infos) = @_;
971
            return decode('UTF-8', $value)
packaging one directory
yuki-kimoto authored on 2009-11-16
972
        }
973
    );
974

            
975
=head2 add_format
976

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

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

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
985
=head2 create_query
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
986
    
version 0.0901
yuki-kimoto authored on 2009-12-17
987
Create Query object parsing SQL template
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
988

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

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

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

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

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
999
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
    $result = $dbi->query($template, $params);
packaging one directory
yuki-kimoto authored on 2009-11-16
1002

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

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1005
    $result = $dbi->query("select * from authors where {= name} and {= age}", 
1006
                          {author => 'taro', age => 19});
1007
    
1008
    while (my @row = $result->fetch) {
1009
        # do something
1010
    }
1011

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

            
1014
Return value of query method is L<DBIx::Custom::Result> object
1015

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

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

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

            
remove run_transaction().
yuki-kimoto authored on 2010-01-30
1022
    $dbi->transaction->run(sub {
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1023
        my $dbi = shift;
1024
        
packaging one directory
yuki-kimoto authored on 2009-11-16
1025
        # do something
1026
    });
1027

            
1028
If transaction is success, commit is execute. 
1029
If tranzation is died, rollback is execute.
1030

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1031
=head2 create_table
1032

            
1033
Create table
1034

            
1035
    $dbi->create_table(
1036
        'books',
1037
        'name char(255)',
1038
        'age  int'
1039
    );
1040

            
1041
First argument is table name. Rest arguments is column definition.
1042

            
1043
=head2 drop_table
1044

            
1045
Drop table
1046

            
1047
    $dbi->drop_table('books');
1048

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1049
=head2 insert
1050

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

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1056
Retrun value is affected rows count
packaging one directory
yuki-kimoto authored on 2009-11-16
1057
    
version 0.0901
yuki-kimoto authored on 2009-12-17
1058
The following is insert sample.
1059

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1062
You can add statement.
1063

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

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1066
=head2 update
1067

            
update document
yuki-kimoto authored on 2009-11-19
1068
Update rows
1069

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

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

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

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1079
You can add statement.
1080

            
1081
    $dbi->update('books', {title => 'Perl', author => 'Taro'},
1082
                 {id => 5}, "some statement");
1083

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1084
=head2 update_all
1085

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

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

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

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

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

            
1096
=head2 delete
1097

            
update document
yuki-kimoto authored on 2009-11-19
1098
Delete rows
1099

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

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

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

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

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

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

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

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

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

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

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

            
1125
=head2 select
1126
    
update document
yuki-kimoto authored on 2009-11-19
1127
Select rows
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1128

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1129
    $resut = $dbi->select(
packaging one directory
yuki-kimoto authored on 2009-11-16
1130
        $table,                # must be string or array;
version 0.0901
yuki-kimoto authored on 2009-12-17
1131
        \@$columns,            # must be array reference. this can be ommited
1132
        \%$where_params,       # must be hash reference.  this can be ommited
1133
        $append_statement,     # must be string.          this can be ommited
1134
        $query_edit_callback   # must be code reference.  this can be ommited
packaging one directory
yuki-kimoto authored on 2009-11-16
1135
    );
update document
yuki-kimoto authored on 2009-11-19
1136

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

            
1139
The following is some select samples
1140

            
1141
    # select * from books;
1142
    $result = $dbi->select('books');
packaging one directory
yuki-kimoto authored on 2009-11-16
1143
    
update document
yuki-kimoto authored on 2009-11-19
1144
    # select * from books where title = 'Perl';
1145
    $result = $dbi->select('books', {title => 1});
1146
    
1147
    # select title, author from books where id = 1 for update;
1148
    $result = $dbi->select(
1149
        'books',              # table
1150
        ['title', 'author'],  # columns
1151
        {id => 1},            # where clause
1152
        'for update',         # append statement
1153
    );
1154

            
1155
You can join multi tables
1156
    
1157
    $result = $dbi->select(
1158
        ['table1', 'table2'],                # tables
1159
        ['table1.id as table1_id', 'title'], # columns (alias is ok)
1160
        {table1.id => 1},                    # where clase
1161
        "where table1.id = table2.id",       # join clause (must start 'where')
1162
    );
1163

            
1164
You can also edit query
1165
        
packaging one directory
yuki-kimoto authored on 2009-11-16
1166
    $dbi->select(
update document
yuki-kimoto authored on 2009-11-19
1167
        'books',
1168
        # column, where clause, append statement,
packaging one directory
yuki-kimoto authored on 2009-11-16
1169
        sub {
1170
            my $query = shift;
1171
            $query->bind_filter(sub {
1172
                # ...
1173
            });
1174
        }
update document
yuki-kimoto authored on 2009-11-19
1175
    }
1176

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1177
=head2 prepare
1178

            
1179
Prepare statement handle.
1180

            
1181
    $sth = $dbi->prepare('select * from books;');
1182

            
1183
This method is same as DBI prepare method.
1184

            
1185
See also L<DBI>.
1186

            
1187
=head2 do
1188

            
1189
Execute SQL
1190

            
1191
    $affected = $dbi->do('insert into books (title, author) values (?, ?)',
1192
                        'Perl', 'taro');
1193

            
1194
Retrun value is affected rows count.
1195

            
1196
This method is same as DBI do method.
1197

            
1198
See also L<DBI>
1199

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

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

            
1205
    1. AutoCommit is true
1206
    2. RaiseError is true
1207

            
1208
By default, Both AutoCommit and RaiseError is true.
1209
You must not change these mode not to damage your data.
1210

            
1211
If you change these mode, 
1212
you cannot get correct error message, 
1213
or run_transaction may fail.
1214

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

            
1217
DBIx::Custom is customizable DBI.
1218
You can inherit DBIx::Custom and custumize attributes.
1219

            
1220
    package DBIx::Custom::Yours;
1221
    use base DBIx::Custom;
1222
    
1223
    my $class = __PACKAGE__;
1224
    
1225
    $class->user('your_name');
1226
    $class->password('your_password');
1227

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1228
=head1 AUTHOR
1229

            
1230
Yuki Kimoto, C<< <kimoto.yuki at gmail.com> >>
1231

            
1232
Github L<http://github.com/yuki-kimoto>
1233

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

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

            
1238
Copyright 2009 Yuki Kimoto, all rights reserved.
1239

            
1240
This program is free software; you can redistribute it and/or modify it
1241
under the same terms as Perl itself.
1242

            
1243
=cut