DBIx-Custom / lib / DBIx / Custom.pm /
Newer Older
1245 lines | 29.438kb
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') {
Simplify key search
yuki-kimoto authored on 2010-02-11
182
        $table    = $template->[0] if $template->[0];
cleanup
yuki-kimoto authored on 2010-02-11
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 {
Simplify key search
yuki-kimoto authored on 2010-02-11
201
        $sql_tmpl->table($table);
202
        $query = eval{$sql_tmpl->create_query($template)};
packaging one directory
yuki-kimoto authored on 2009-11-16
203
        croak($@) if $@;
204
        
Simplify key search
yuki-kimoto authored on 2010-02-11
205
        $class->_add_query_cache("$table$template", $query);
packaging one directory
yuki-kimoto authored on 2009-11-16
206
    }
207
    
208
    # Connect if not
209
    $self->connect unless $self->connected;
210
    
211
    # Prepare statement handle
212
    my $sth = $self->prepare($query->{sql});
213
    
214
    # Set statement handle
215
    $query->sth($sth);
216
    
217
    # Set bind filter
218
    $query->bind_filter($self->bind_filter);
219
    
220
    # Set no filter keys when binding
221
    $query->no_bind_filters($self->no_bind_filters);
222
    
223
    # Set fetch filter
224
    $query->fetch_filter($self->fetch_filter);
225
    
226
    # Set no filter keys when fetching
227
    $query->no_fetch_filters($self->no_fetch_filters);
228
    
229
    return $query;
230
}
231

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

            
288
sub _build_bind_values {
289
    my ($self, $query, $params) = @_;
Simplify key search
yuki-kimoto authored on 2010-02-11
290
    my $key_infos  = $query->key_infos;
291
    my $filter     = $query->bind_filter;
packaging one directory
yuki-kimoto authored on 2009-11-16
292
    
293
    # binding values
294
    my @bind_values;
295
    
Simplify key search
yuki-kimoto authored on 2010-02-11
296
    # Build bind values
packaging one directory
yuki-kimoto authored on 2009-11-16
297
    foreach my $key_info (@$key_infos) {
Simplify key search
yuki-kimoto authored on 2010-02-11
298
        my $table        = $key_info->table;
299
        my $column       = $key_info->column;
300
        my $id           = $key_info->id;
301
        my $pos          = $key_info->pos;
packaging one directory
yuki-kimoto authored on 2009-11-16
302
        
Simplify key search
yuki-kimoto authored on 2010-02-11
303
        # Value
304
        my $value = $id && $pos ? $params->{$id}->{$column}->[$pos]
305
                  : $id         ? $params->{$id}->{$column}
306
                  : $pos        ? $params->{$column}->[$pos]
307
                  : $params->{$column};
packaging one directory
yuki-kimoto authored on 2009-11-16
308
        
Simplify key search
yuki-kimoto authored on 2010-02-11
309
        # Filter
310
        push @bind_values, 
remove DBIx::Custom::Transac...
yuki-kimoto authored on 2010-02-11
311
             $filter ? $filter->($value, $table, $column, $self)
Simplify key search
yuki-kimoto authored on 2010-02-11
312
                     : $value;
cleanup
yuki-kimoto authored on 2010-02-11
313
    }
314
    
Simplify key search
yuki-kimoto authored on 2010-02-11
315
    return \@bind_values;
cleanup
yuki-kimoto authored on 2010-02-11
316
}
317

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

            
remove DBIx::Custom::Transac...
yuki-kimoto authored on 2010-02-11
320
sub run_transaction {
321
    my ($self, $transaction) = @_;
322
    
323
    # DBIx::Custom object
324
    my $dbi = $self->dbi;
325
    
326
    # Shorcut
327
    return unless $dbi;
328
    
329
    # Check auto commit
330
    croak("AutoCommit must be true before transaction start")
331
      unless $dbi->_auto_commit;
332
    
333
    # Auto commit off
334
    $dbi->_auto_commit(0);
335
    
336
    # Run transaction
337
    eval {$transaction->()};
338
    
339
    # Tranzaction error
340
    my $transaction_error = $@;
341
    
342
    # Tranzaction is failed.
343
    if ($transaction_error) {
344
        # Rollback
345
        eval{$dbi->dbh->rollback};
346
        
347
        # Rollback error
348
        my $rollback_error = $@;
349
        
350
        # Auto commit on
351
        $dbi->_auto_commit(1);
352
        
353
        if ($rollback_error) {
354
            # Rollback is failed
355
            croak("${transaction_error}Rollback is failed : $rollback_error");
356
        }
357
        else {
358
            # Rollback is success
359
            croak("${transaction_error}Rollback is success");
360
        }
361
    }
362
    # Tranzaction is success
363
    else {
364
        # Commit
365
        eval{$dbi->dbh->commit};
366
        my $commit_error = $@;
367
        
368
        # Auto commit on
369
        $dbi->_auto_commit(1);
370
        
371
        # Commit is failed
372
        croak($commit_error) if $commit_error;
373
    }
374
}
375

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

            
395
sub drop_table {
396
    my ($self, $table) = @_;
397
    
398
    # Drop table
399
    my $sql = "drop table $table;";
400

            
401
    # Do query
402
    return $self->do($sql);
403
}
404

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

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

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

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

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

            
567
sub _select_usage { return << 'EOS' }
568
Your select arguments is wrong.
569
select usage:
570
$dbi->select(
cleanup
yuki-kimoto authored on 2010-02-11
571
    $table,                # String or array ref
572
    [@$columns],           # Array reference. this can be ommited
573
    {%$where_params},      # Hash reference.  this can be ommited
574
    $append_statement,     # String.          this can be ommited
575
    $query_edit_callback   # Sub reference.   this can be ommited
packaging one directory
yuki-kimoto authored on 2009-11-16
576
);
577
EOS
578

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

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

            
679
sub filter_off {
680
    my $self = shift;
681
    
update document
yuki-kimoto authored on 2010-01-30
682
    # Filter off
packaging one directory
yuki-kimoto authored on 2009-11-16
683
    $self->bind_filter(undef);
684
    $self->fetch_filter(undef);
685
    
686
    return $self;
687
}
688

            
689
=head1 NAME
690

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

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

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

            
697
=cut
698

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

            
cleanup
yuki-kimoto authored on 2010-02-11
701
=head1 STATE
702

            
703
This module is not stable. Method name and functionality will be change.
704

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

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

            
736
=head2 user
737

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

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

            
750
=head2 data_source
751

            
update document
yuki-kimoto authored on 2010-01-30
752
Database data source
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
753
    
version 0.0901
yuki-kimoto authored on 2009-12-17
754
    $dbi         = $dbi->data_source("dbi:mysql:dbname=$database");
755
    $data_source = $dbi->data_source;
packaging one directory
yuki-kimoto authored on 2009-11-16
756
    
version 0.0901
yuki-kimoto authored on 2009-12-17
757
If you know data source more, See also L<DBI>.
758

            
packaging one directory
yuki-kimoto authored on 2009-11-16
759
=head2 database
760

            
update document
yuki-kimoto authored on 2010-01-30
761
Database name
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->database('books');
764
    $database = $dbi->database;
packaging one directory
yuki-kimoto authored on 2009-11-16
765

            
add port and host method
yuki-kimoto authored on 2009-11-16
766
=head2 host
767

            
update document
yuki-kimoto authored on 2010-01-30
768
Host name
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->host('somehost.com');
771
    $host = $dbi->host;
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
772

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

            
775
=head2 port
776

            
update document
yuki-kimoto authored on 2010-01-30
777
Port number
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->port(1198);
780
    $port = $dbi->port;
add port and host method
yuki-kimoto authored on 2009-11-16
781

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

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

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

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

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

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

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

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

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

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

            
807
    $filter = $dbi->filters->{encode_utf8};
808

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

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

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

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

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

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

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

            
824
=head2 bind_filter
825

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

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

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

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
841
Bind filter arguemts is
842

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

            
packaging one directory
yuki-kimoto authored on 2009-11-16
848
=head2 fetch_filter
849

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

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

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

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
865
Bind filter arguemts is
866

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

            
packaging one directory
yuki-kimoto authored on 2009-11-16
872
=head2 no_bind_filters
873

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

            
879
=head2 no_fetch_filters
880

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

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

            
886
=head2 result_class
887

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

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

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

            
packaging one directory
yuki-kimoto authored on 2009-11-16
895
=head2 dbh
896

            
update document
yuki-kimoto authored on 2010-01-30
897
Database handle
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->dbh($dbh);
900
    $dbh = $dbi->dbh;
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
901
    
902
=head2 query_cache_max
903

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

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

            
909
Default value is 50
910

            
update document
yuki-kimoto authored on 2010-01-30
911
=head1 METHODS
912

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

            
916
=head2 connect
917

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

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

            
922
=head2 disconnect
923

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
924
Disconnect database
925

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

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

            
930
=head2 reconnect
931

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

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

            
936
=head2 connected
937

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

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

            
953
=head2 add_filter
954

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

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

            
973
=head2 add_format
974

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
1012
Return value of query method is L<DBIx::Custom::Result> object
1013

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

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

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

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

            
1026
If transaction is success, commit is execute. 
1027
If tranzation is died, rollback is execute.
1028

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1029
=head2 create_table
1030

            
1031
Create table
1032

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

            
1039
First argument is table name. Rest arguments is column definition.
1040

            
1041
=head2 drop_table
1042

            
1043
Drop table
1044

            
1045
    $dbi->drop_table('books');
1046

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1047
=head2 insert
1048

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

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

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

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1060
You can add statement.
1061

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

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1064
=head2 update
1065

            
update document
yuki-kimoto authored on 2009-11-19
1066
Update rows
1067

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

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

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

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

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

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

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1082
=head2 update_all
1083

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

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

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

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

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

            
1094
=head2 delete
1095

            
update document
yuki-kimoto authored on 2009-11-19
1096
Delete rows
1097

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

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

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1107
You can add statement.
1108

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

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1111
=head2 delete_all
1112

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

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

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

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

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

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

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

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

            
1137
The following is some select samples
1138

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

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

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1175
=head2 prepare
1176

            
1177
Prepare statement handle.
1178

            
1179
    $sth = $dbi->prepare('select * from books;');
1180

            
1181
This method is same as DBI prepare method.
1182

            
1183
See also L<DBI>.
1184

            
1185
=head2 do
1186

            
1187
Execute SQL
1188

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

            
1192
Retrun value is affected rows count.
1193

            
1194
This method is same as DBI do method.
1195

            
1196
See also L<DBI>
1197

            
remove DBIx::Custom::Transac...
yuki-kimoto authored on 2010-02-11
1198
=head2 run_transaction
1199

            
1200

            
1201

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1202
=head1 DBIx::Custom default configuration
packaging one directory
yuki-kimoto authored on 2009-11-16
1203

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

            
1207
    1. AutoCommit is true
1208
    2. RaiseError is true
1209

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

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

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

            
1219
DBIx::Custom is customizable DBI.
1220
You can inherit DBIx::Custom and custumize attributes.
1221

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

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1230
=head1 AUTHOR
1231

            
1232
Yuki Kimoto, C<< <kimoto.yuki at gmail.com> >>
1233

            
1234
Github L<http://github.com/yuki-kimoto>
1235

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

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

            
1240
Copyright 2009 Yuki Kimoto, all rights reserved.
1241

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

            
1245
=cut