DBIx-Custom / lib / DBIx / Custom.pm /
Newer Older
1258 lines | 29.531kb
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';
many change
yuki-kimoto authored on 2010-02-11
7

            
packaging one directory
yuki-kimoto authored on 2009-11-16
8
use Carp 'croak';
9
use DBI;
10
use DBIx::Custom::Result;
11
use DBIx::Custom::SQL::Template;
cleanup
yuki-kimoto authored on 2010-02-11
12
use DBIx::Custom::Query;
many change
yuki-kimoto authored on 2010-02-11
13
use DBIx::Custom::KeyInfo;
packaging one directory
yuki-kimoto authored on 2009-11-16
14

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

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

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

            
cleanup
yuki-kimoto authored on 2010-04-28
23
__PACKAGE__->attr([qw/user password data_source/]);
24
__PACKAGE__->attr([qw/database host port/]);
cleanup
yuki-kimoto authored on 2010-04-28
25
__PACKAGE__->attr([qw/default_bind_filter default_fetch_filter options/]);
packaging one directory
yuki-kimoto authored on 2009-11-16
26

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

            
cleanup
yuki-kimoto authored on 2010-04-28
30
__PACKAGE__->attr(result_class => 'DBIx::Custom::Result');
31
__PACKAGE__->attr(sql_tmpl => sub { DBIx::Custom::SQL::Template->new });
packaging one directory
yuki-kimoto authored on 2009-11-16
32

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

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

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

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

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

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

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

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

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

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

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

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

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

            
276
sub _build_bind_values {
277
    my ($self, $query, $params) = @_;
Simplify key search
yuki-kimoto authored on 2010-02-11
278
    my $key_infos  = $query->key_infos;
279
    my $filter     = $query->bind_filter;
packaging one directory
yuki-kimoto authored on 2009-11-16
280
    
281
    # binding values
282
    my @bind_values;
283
    
Simplify key search
yuki-kimoto authored on 2010-02-11
284
    # Build bind values
packaging one directory
yuki-kimoto authored on 2009-11-16
285
    foreach my $key_info (@$key_infos) {
Simplify key search
yuki-kimoto authored on 2010-02-11
286
        my $table        = $key_info->table;
287
        my $column       = $key_info->column;
288
        my $id           = $key_info->id;
289
        my $pos          = $key_info->pos;
packaging one directory
yuki-kimoto authored on 2009-11-16
290
        
Simplify key search
yuki-kimoto authored on 2010-02-11
291
        # Value
many change
yuki-kimoto authored on 2010-02-11
292
        my $value = $id && defined $pos ? $params->{$id}->{$column}->[$pos]
293
                  : $id                 ? $params->{$id}->{$column}
294
                  : defined $pos        ? $params->{$column}->[$pos]
Simplify key search
yuki-kimoto authored on 2010-02-11
295
                  : $params->{$column};
packaging one directory
yuki-kimoto authored on 2009-11-16
296
        
Simplify key search
yuki-kimoto authored on 2010-02-11
297
        # Filter
298
        push @bind_values, 
remove DBIx::Custom::Transac...
yuki-kimoto authored on 2010-02-11
299
             $filter ? $filter->($value, $table, $column, $self)
Simplify key search
yuki-kimoto authored on 2010-02-11
300
                     : $value;
cleanup
yuki-kimoto authored on 2010-02-11
301
    }
302
    
Simplify key search
yuki-kimoto authored on 2010-02-11
303
    return \@bind_values;
cleanup
yuki-kimoto authored on 2010-02-11
304
}
305

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

            
remove DBIx::Custom::Transac...
yuki-kimoto authored on 2010-02-11
308
sub run_transaction {
309
    my ($self, $transaction) = @_;
310
    
311
    # Shorcut
many change
yuki-kimoto authored on 2010-02-11
312
    return unless $self;
remove DBIx::Custom::Transac...
yuki-kimoto authored on 2010-02-11
313
    
314
    # Check auto commit
315
    croak("AutoCommit must be true before transaction start")
many change
yuki-kimoto authored on 2010-02-11
316
      unless $self->_auto_commit;
remove DBIx::Custom::Transac...
yuki-kimoto authored on 2010-02-11
317
    
318
    # Auto commit off
many change
yuki-kimoto authored on 2010-02-11
319
    $self->_auto_commit(0);
remove DBIx::Custom::Transac...
yuki-kimoto authored on 2010-02-11
320
    
321
    # Run transaction
322
    eval {$transaction->()};
323
    
324
    # Tranzaction error
325
    my $transaction_error = $@;
326
    
327
    # Tranzaction is failed.
328
    if ($transaction_error) {
329
        # Rollback
many change
yuki-kimoto authored on 2010-02-11
330
        eval{$self->dbh->rollback};
remove DBIx::Custom::Transac...
yuki-kimoto authored on 2010-02-11
331
        
332
        # Rollback error
333
        my $rollback_error = $@;
334
        
335
        # Auto commit on
many change
yuki-kimoto authored on 2010-02-11
336
        $self->_auto_commit(1);
remove DBIx::Custom::Transac...
yuki-kimoto authored on 2010-02-11
337
        
338
        if ($rollback_error) {
339
            # Rollback is failed
340
            croak("${transaction_error}Rollback is failed : $rollback_error");
341
        }
342
        else {
343
            # Rollback is success
344
            croak("${transaction_error}Rollback is success");
345
        }
346
    }
347
    # Tranzaction is success
348
    else {
349
        # Commit
many change
yuki-kimoto authored on 2010-02-11
350
        eval{$self->dbh->commit};
remove DBIx::Custom::Transac...
yuki-kimoto authored on 2010-02-11
351
        my $commit_error = $@;
352
        
353
        # Auto commit on
many change
yuki-kimoto authored on 2010-02-11
354
        $self->_auto_commit(1);
remove DBIx::Custom::Transac...
yuki-kimoto authored on 2010-02-11
355
        
356
        # Commit is failed
357
        croak($commit_error) if $commit_error;
358
    }
359
}
360

            
version 0.0901
yuki-kimoto authored on 2009-12-17
361
sub create_table {
362
    my ($self, $table, @column_definitions) = @_;
363
    
364
    # Create table
rename fetch_first to fetch_...
yuki-kimoto authored on 2010-01-29
365
    my $sql = "create table $table (";
version 0.0901
yuki-kimoto authored on 2009-12-17
366
    
367
    # Column definitions
368
    foreach my $column_definition (@column_definitions) {
rename fetch_first to fetch_...
yuki-kimoto authored on 2010-01-29
369
        $sql .= "$column_definition,";
version 0.0901
yuki-kimoto authored on 2009-12-17
370
    }
rename fetch_first to fetch_...
yuki-kimoto authored on 2010-01-29
371
    $sql =~ s/,$//;
version 0.0901
yuki-kimoto authored on 2009-12-17
372
    
373
    # End
rename fetch_first to fetch_...
yuki-kimoto authored on 2010-01-29
374
    $sql .= ");";
version 0.0901
yuki-kimoto authored on 2009-12-17
375
    
376
    # Do query
377
    return $self->do($sql);
378
}
379

            
380
sub drop_table {
381
    my ($self, $table) = @_;
382
    
383
    # Drop table
384
    my $sql = "drop table $table;";
385

            
386
    # Do query
387
    return $self->do($sql);
388
}
389

            
cleanup insert
yuki-kimoto authored on 2010-04-28
390
our %VALID_INSERT_ARGS = map { $_ => 1 } qw/append query_edit_cb/;
391

            
packaging one directory
yuki-kimoto authored on 2009-11-16
392
sub insert {
cleanup insert
yuki-kimoto authored on 2010-04-28
393
    my ($self, $table, $insert_params, $args) = @_;
394
    
395
    # Table
396
    $table ||= '';
397
    
398
    # Insert params
399
    $insert_params ||= {};
400
    
401
    # Arguments
402
    $args ||= {};
403
    
404
    # Check arguments
405
    foreach my $name (keys %$args) {
406
        croak "\"$name\" is invalid name"
407
          unless $VALID_INSERT_ARGS{$name};
408
    }
409
    
410
    my $append_statement = $args->{append} || '';
411
    my $query_edit_cb    = $args->{query_edit_cb};
packaging one directory
yuki-kimoto authored on 2009-11-16
412
    
413
    # Insert keys
414
    my @insert_keys = keys %$insert_params;
415
    
416
    # Not exists insert keys
417
    croak("Key-value pairs for insert must be specified to 'insert' second argument")
418
      unless @insert_keys;
419
    
420
    # Templte for insert
421
    my $template = "insert into $table {insert " . join(' ', @insert_keys) . '}';
insert, update, delete appnd...
yuki-kimoto authored on 2009-11-16
422
    $template .= " $append_statement" if $append_statement;
packaging one directory
yuki-kimoto authored on 2009-11-16
423
    # Create query
Simplify key search
yuki-kimoto authored on 2010-02-11
424
    my $query = $self->create_query([$table, $template]);
packaging one directory
yuki-kimoto authored on 2009-11-16
425
    
426
    # Query edit callback must be code reference
427
    croak("Query edit callback must be code reference")
428
      if $query_edit_cb && ref $query_edit_cb ne 'CODE';
429
    
430
    # Query edit if need
431
    $query_edit_cb->($query) if $query_edit_cb;
432
    
433
    # Execute query
version 0.0901
yuki-kimoto authored on 2009-12-17
434
    my $ret_val = $self->query($query, $insert_params);
packaging one directory
yuki-kimoto authored on 2009-11-16
435
    
436
    return $ret_val;
437
}
438

            
cleanup update and update_al...
yuki-kimoto authored on 2010-04-28
439
our %VALID_UPDATE_ARGS
440
  = map { $_ => 1 } qw/where append query_edit_cb allow_update_all/;
441

            
packaging one directory
yuki-kimoto authored on 2009-11-16
442
sub update {
cleanup update and update_al...
yuki-kimoto authored on 2010-04-28
443
    my ($self, $table, $update_params, $args) = @_;
444
    
445
    # Check arguments
446
    foreach my $name (keys %$args) {
447
        croak "\"$name\" is invalid name"
448
          unless $VALID_UPDATE_ARGS{$name};
449
    }
450
    
451
    # Arguments
452
    my $where_params     = $args->{where} || {};
453
    my $append_statement = $args->{append} || '';
454
    my $query_edit_cb    = $args->{query_edit_cb};
455
    my $allow_update_all = $args->{allow_update_all};
packaging one directory
yuki-kimoto authored on 2009-11-16
456
    
457
    # Update keys
458
    my @update_keys = keys %$update_params;
459
    
460
    # Not exists update kyes
461
    croak("Key-value pairs for update must be specified to 'update' second argument")
462
      unless @update_keys;
463
    
464
    # Where keys
465
    my @where_keys = keys %$where_params;
466
    
467
    # Not exists where keys
468
    croak("Key-value pairs for where clause must be specified to 'update' third argument")
cleanup update and update_al...
yuki-kimoto authored on 2010-04-28
469
      if !@where_keys && !$allow_update_all;
packaging one directory
yuki-kimoto authored on 2009-11-16
470
    
471
    # Update clause
472
    my $update_clause = '{update ' . join(' ', @update_keys) . '}';
473
    
474
    # Where clause
475
    my $where_clause = '';
476
    if (@where_keys) {
477
        $where_clause = 'where ';
478
        foreach my $where_key (@where_keys) {
many change
yuki-kimoto authored on 2010-02-11
479
            my $key_info = DBIx::Custom::KeyInfo->new($where_key);
480
            
481
            my $table_new = $key_info->table || $table;
482
            my $column = $table_new . '.' . $key_info->column
483
                         . '#@where';
484

            
485
            $where_clause .= "{= $column} and ";
packaging one directory
yuki-kimoto authored on 2009-11-16
486
        }
487
        $where_clause =~ s/ and $//;
488
    }
489
    
490
    # Template for update
491
    my $template = "update $table $update_clause $where_clause";
insert, update, delete appnd...
yuki-kimoto authored on 2009-11-16
492
    $template .= " $append_statement" if $append_statement;
packaging one directory
yuki-kimoto authored on 2009-11-16
493
    
494
    # Create query
Simplify key search
yuki-kimoto authored on 2010-02-11
495
    my $query = $self->create_query([$table, $template]);
packaging one directory
yuki-kimoto authored on 2009-11-16
496
    
497
    # Query edit callback must be code reference
498
    croak("Query edit callback must be code reference")
499
      if $query_edit_cb && ref $query_edit_cb ne 'CODE';
500
    
501
    # Query edit if need
502
    $query_edit_cb->($query) if $query_edit_cb;
503
    
504
    # Rearrange parammeters
many change
yuki-kimoto authored on 2010-02-11
505
    my $params = {%$update_params, '@where' => $where_params};
packaging one directory
yuki-kimoto authored on 2009-11-16
506
    
507
    # Execute query
version 0.0901
yuki-kimoto authored on 2009-12-17
508
    my $ret_val = $self->query($query, $params);
packaging one directory
yuki-kimoto authored on 2009-11-16
509
    
510
    return $ret_val;
511
}
512

            
513
sub update_all {
cleanup update and update_al...
yuki-kimoto authored on 2010-04-28
514
    my ($self, $table, $update_params, $args) = @_;
515
    
refactoring select
yuki-kimoto authored on 2010-04-28
516
    # Allow all update
cleanup update and update_al...
yuki-kimoto authored on 2010-04-28
517
    $args ||= {};
518
    $args->{allow_update_all} = 1;
insert, update, delete appnd...
yuki-kimoto authored on 2009-11-16
519
    
update document
yuki-kimoto authored on 2010-01-30
520
    # Update all rows
cleanup update and update_al...
yuki-kimoto authored on 2010-04-28
521
    return $self->update($table, $update_params, $args);
packaging one directory
yuki-kimoto authored on 2009-11-16
522
}
523

            
refactoring delete and delet...
yuki-kimoto authored on 2010-04-28
524
our %VALID_DELETE_ARGS
525
  = map { $_ => 1 } qw/where append query_edit_cb allow_delete_all/;
526

            
packaging one directory
yuki-kimoto authored on 2009-11-16
527
sub delete {
refactoring delete and delet...
yuki-kimoto authored on 2010-04-28
528
    my ($self, $table, $args) = @_;
529
    
530
    # Table
531
    $table            ||= '';
532

            
533
    # Check arguments
534
    foreach my $name (keys %$args) {
535
        croak "\"$name\" is invalid name"
536
          unless $VALID_DELETE_ARGS{$name};
537
    }
538
    
539
    # Arguments
540
    my $where_params     = $args->{where} || {};
541
    my $append_statement = $args->{append};
542
    my $query_edit_cb    = $args->{query_edit_cb};
543
    my $allow_delete_all = $args->{allow_delete_all};
packaging one directory
yuki-kimoto authored on 2009-11-16
544
    
545
    # Where keys
546
    my @where_keys = keys %$where_params;
547
    
548
    # Not exists where keys
549
    croak("Key-value pairs for where clause must be specified to 'delete' second argument")
refactoring delete and delet...
yuki-kimoto authored on 2010-04-28
550
      if !@where_keys && !$allow_delete_all;
packaging one directory
yuki-kimoto authored on 2009-11-16
551
    
552
    # Where clause
553
    my $where_clause = '';
554
    if (@where_keys) {
555
        $where_clause = 'where ';
556
        foreach my $where_key (@where_keys) {
557
            $where_clause .= "{= $where_key} and ";
558
        }
559
        $where_clause =~ s/ and $//;
560
    }
561
    
562
    # Template for delete
563
    my $template = "delete from $table $where_clause";
insert, update, delete appnd...
yuki-kimoto authored on 2009-11-16
564
    $template .= " $append_statement" if $append_statement;
packaging one directory
yuki-kimoto authored on 2009-11-16
565
    
566
    # Create query
Simplify key search
yuki-kimoto authored on 2010-02-11
567
    my $query = $self->create_query([$table, $template]);
packaging one directory
yuki-kimoto authored on 2009-11-16
568
    
569
    # Query edit callback must be code reference
570
    croak("Query edit callback must be code reference")
571
      if $query_edit_cb && ref $query_edit_cb ne 'CODE';
572
    
573
    # Query edit if need
574
    $query_edit_cb->($query) if $query_edit_cb;
575
    
576
    # Execute query
version 0.0901
yuki-kimoto authored on 2009-12-17
577
    my $ret_val = $self->query($query, $where_params);
packaging one directory
yuki-kimoto authored on 2009-11-16
578
    
579
    return $ret_val;
580
}
581

            
582
sub delete_all {
refactoring delete and delet...
yuki-kimoto authored on 2010-04-28
583
    my ($self, $table, $args) = @_;
584
    
refactoring select
yuki-kimoto authored on 2010-04-28
585
    # Allow all delete
refactoring delete and delet...
yuki-kimoto authored on 2010-04-28
586
    $args ||= {};
587
    $args->{allow_delete_all} = 1;
insert, update, delete appnd...
yuki-kimoto authored on 2009-11-16
588
    
update document
yuki-kimoto authored on 2010-01-30
589
    # Delete all rows
refactoring delete and delet...
yuki-kimoto authored on 2010-04-28
590
    return $self->delete($table, $args);
packaging one directory
yuki-kimoto authored on 2009-11-16
591
}
592

            
593
sub _select_usage { return << 'EOS' }
refactoring select
yuki-kimoto authored on 2010-04-28
594
Select usage:
packaging one directory
yuki-kimoto authored on 2009-11-16
595
$dbi->select(
refactoring select
yuki-kimoto authored on 2010-04-28
596
    $table,                   # String or array ref
597
    {
598
        columns => $columns   # Array reference
599
        where   => $params    # Hash reference.
600
        append  => $statement # String. 
601
        query_edit_cb => $cb  # Sub reference
602
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
603
);
604
EOS
605

            
refactoring select
yuki-kimoto authored on 2010-04-28
606
our %VALID_SELECT_ARGS
607
  = map { $_ => 1 } qw/columns where append query_edit_cb/;
608

            
609

            
packaging one directory
yuki-kimoto authored on 2009-11-16
610
sub select {
refactoring select
yuki-kimoto authored on 2010-04-28
611
    my ($self, $tables, $args) = @_;
packaging one directory
yuki-kimoto authored on 2009-11-16
612
    
refactoring select
yuki-kimoto authored on 2010-04-28
613
    # Table
614
    $tables ||= '';
615
    $tables = [$tables] unless ref $tables;
packaging one directory
yuki-kimoto authored on 2009-11-16
616
    
refactoring select
yuki-kimoto authored on 2010-04-28
617
    # Check arguments
618
    foreach my $name (keys %$args) {
619
        croak "\"$name\" is invalid name"
620
          unless $VALID_SELECT_ARGS{$name};
621
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
622
    
refactoring select
yuki-kimoto authored on 2010-04-28
623
    # Arguments
624
    my $columns          = $args->{columns} || [];
625
    my $where_params     = $args->{where} || {};
626
    my $append_statement = $args->{append} || '';
627
    my $query_edit_cb    = $args->{query_edit_cb};
packaging one directory
yuki-kimoto authored on 2009-11-16
628
    
629
    # SQL template for select statement
630
    my $template = 'select ';
631
    
632
    # Join column clause
633
    if (@$columns) {
634
        foreach my $column (@$columns) {
635
            $template .= "$column, ";
636
        }
637
        $template =~ s/, $/ /;
638
    }
639
    else {
640
        $template .= '* ';
641
    }
642
    
643
    # Join table
644
    $template .= 'from ';
645
    foreach my $table (@$tables) {
646
        $template .= "$table, ";
647
    }
648
    $template =~ s/, $/ /;
649
    
650
    # Where clause keys
651
    my @where_keys = keys %$where_params;
652
    
many change
yuki-kimoto authored on 2010-02-11
653
    my $where_params_new = {};
654
    
packaging one directory
yuki-kimoto authored on 2009-11-16
655
    # Join where clause
656
    if (@where_keys) {
657
        $template .= 'where ';
658
        foreach my $where_key (@where_keys) {
many change
yuki-kimoto authored on 2010-02-11
659
            my $key_info = DBIx::Custom::KeyInfo->new($where_key);
660
            
661
            my $table_new = $key_info->table || $tables->[0];
662
            my $column = $table_new . '.' . $key_info->column
663
                         . '#' . $table_new;
664
                      
665
            $template .= "{= $column} and ";
666
            
667
            $where_params_new->{$table_new} ||= {};
668
            $where_params_new->{$table_new}->{$key_info->column}
669
              = $where_params->{$where_key};
packaging one directory
yuki-kimoto authored on 2009-11-16
670
        }
671
    }
672
    $template =~ s/ and $//;
673
    
674
    # Append something to last of statement
675
    if ($append_statement =~ s/^where //) {
676
        if (@where_keys) {
677
            $template .= " and $append_statement";
678
        }
679
        else {
680
            $template .= " where $append_statement";
681
        }
682
    }
683
    else {
684
        $template .= " $append_statement";
685
    }
686
    
687
    # Create query
Simplify key search
yuki-kimoto authored on 2010-02-11
688
    my $query = $self->create_query([$tables->[0], $template]);
packaging one directory
yuki-kimoto authored on 2009-11-16
689
    
690
    # Query edit
691
    $query_edit_cb->($query) if $query_edit_cb;
692
    
693
    # Execute query
many change
yuki-kimoto authored on 2010-02-11
694
    my $result = $self->query($query, $where_params_new);
packaging one directory
yuki-kimoto authored on 2009-11-16
695
    
696
    return $result;
697
}
698

            
699
sub _add_query_cache {
700
    my ($class, $template, $query) = @_;
update document
yuki-kimoto authored on 2010-01-30
701
    
702
    # Query information
packaging one directory
yuki-kimoto authored on 2009-11-16
703
    my $query_cache_keys = $class->_query_cache_keys;
704
    my $query_caches     = $class->_query_caches;
705
    
update document
yuki-kimoto authored on 2010-01-30
706
    # Already cached
packaging one directory
yuki-kimoto authored on 2009-11-16
707
    return $class if $query_caches->{$template};
708
    
update document
yuki-kimoto authored on 2010-01-30
709
    # Cache
packaging one directory
yuki-kimoto authored on 2009-11-16
710
    $query_caches->{$template} = $query;
711
    push @$query_cache_keys, $template;
712
    
update document
yuki-kimoto authored on 2010-01-30
713
    # Check cache overflow
packaging one directory
yuki-kimoto authored on 2009-11-16
714
    my $overflow = @$query_cache_keys - $class->query_cache_max;
715
    for (my $i = 0; $i < $overflow; $i++) {
716
        my $template = shift @$query_cache_keys;
717
        delete $query_caches->{$template};
718
    }
719
    
720
    return $class;
721
}
722

            
723
=head1 NAME
724

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

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

            
many change
yuki-kimoto authored on 2010-02-11
729
Version 0.1201
catch up with Object::Simple...
yuki-kimoto authored on 2010-01-18
730

            
731
=cut
732

            
many change
yuki-kimoto authored on 2010-02-11
733
our $VERSION = '0.1201';
packaging one directory
yuki-kimoto authored on 2009-11-16
734

            
cleanup
yuki-kimoto authored on 2010-02-11
735
=head1 STATE
736

            
737
This module is not stable. Method name and functionality will be change.
738

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

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

            
770
=head2 user
771

            
update document
yuki-kimoto authored on 2010-01-30
772
Database user name
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
773
    
version 0.0901
yuki-kimoto authored on 2009-12-17
774
    $dbi  = $dbi->user('Ken');
775
    $user = $dbi->user;
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
776
    
packaging one directory
yuki-kimoto authored on 2009-11-16
777
=head2 password
778

            
update document
yuki-kimoto authored on 2010-01-30
779
Database password
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->password('lkj&le`@s');
782
    $password = $dbi->password;
packaging one directory
yuki-kimoto authored on 2009-11-16
783

            
784
=head2 data_source
785

            
update document
yuki-kimoto authored on 2010-01-30
786
Database data source
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
787
    
version 0.0901
yuki-kimoto authored on 2009-12-17
788
    $dbi         = $dbi->data_source("dbi:mysql:dbname=$database");
789
    $data_source = $dbi->data_source;
packaging one directory
yuki-kimoto authored on 2009-11-16
790
    
version 0.0901
yuki-kimoto authored on 2009-12-17
791
If you know data source more, See also L<DBI>.
792

            
packaging one directory
yuki-kimoto authored on 2009-11-16
793
=head2 database
794

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

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

            
add port and host method
yuki-kimoto authored on 2009-11-16
800
=head2 host
801

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

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

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

            
809
=head2 port
810

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

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

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

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

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

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

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

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

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

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

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
836
    $dbi     = $dbi->filters({filter1 => sub { }, filter2 => sub {}});
837
    $filters = $dbi->filters;
packaging one directory
yuki-kimoto authored on 2009-11-16
838
    
version 0.0901
yuki-kimoto authored on 2009-12-17
839
This method is generally used to get a filter.
840

            
841
    $filter = $dbi->filters->{encode_utf8};
842

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

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

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

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

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

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

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

            
cleanup
yuki-kimoto authored on 2010-04-28
858
=head2 default_bind_filter
packaging one directory
yuki-kimoto authored on 2009-11-16
859

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

            
cleanup
yuki-kimoto authored on 2010-04-28
862
    $dbi                 = $dbi->default_bind_filter($default_bind_filter);
863
    $default_bind_filter = $dbi->default_bind_filter
packaging one directory
yuki-kimoto authored on 2009-11-16
864

            
version 0.0901
yuki-kimoto authored on 2009-12-17
865
The following is bind filter sample
cleanup
yuki-kimoto authored on 2010-04-28
866
    
867
    $dbi->add_filter(encode_utf8 => sub {
868
        my $value = shift;
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
869
        
cleanup
yuki-kimoto authored on 2010-04-28
870
        require Encode 'encode_utf8';
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
871
        
cleanup
yuki-kimoto authored on 2010-04-28
872
        return encode_utf8($value);
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
873
    });
cleanup
yuki-kimoto authored on 2010-04-28
874
    
875
    $dbi->default_bind_filter('encode_utf8')
packaging one directory
yuki-kimoto authored on 2009-11-16
876

            
version 0.0901
yuki-kimoto authored on 2009-12-17
877
Bind filter arguemts is
878

            
879
    1. $value : Value
880
    2. $key   : Key
881
    3. $dbi   : DBIx::Custom object
882
    4. $infos : {table => $table, column => $column}
883

            
cleanup
yuki-kimoto authored on 2010-04-28
884
=head2 default_fetch_filter
packaging one directory
yuki-kimoto authored on 2009-11-16
885

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

            
cleanup
yuki-kimoto authored on 2010-04-28
888
    $dbi                  = $dbi->default_fetch_filter($default_fetch_filter);
889
    $default_fetch_filter = $dbi->default_fetch_filter;
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
890

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

            
cleanup
yuki-kimoto authored on 2010-04-28
893
    $dbi->add_filter(decode_utf8 => sub {
894
        my $value = shift;
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
895
        
cleanup
yuki-kimoto authored on 2010-04-28
896
        require Encode 'decode_utf8';
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
897
        
cleanup
yuki-kimoto authored on 2010-04-28
898
        return decode_utf8($value);
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
899
    });
packaging one directory
yuki-kimoto authored on 2009-11-16
900

            
cleanup
yuki-kimoto authored on 2010-04-28
901
    $dbi->default_fetch_filter('decode_utf8');
902

            
version 0.0901
yuki-kimoto authored on 2009-12-17
903
Bind filter arguemts is
904

            
905
    1. $value : Value
906
    2. $key   : Key
907
    3. $dbi   : DBIx::Custom object
908
    4. $infos : {type => $table, sth => $sth, index => $index}
909

            
packaging one directory
yuki-kimoto authored on 2009-11-16
910
=head2 result_class
911

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

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

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

            
packaging one directory
yuki-kimoto authored on 2009-11-16
919
=head2 dbh
920

            
update document
yuki-kimoto authored on 2010-01-30
921
Database handle
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
922
    
version 0.0901
yuki-kimoto authored on 2009-12-17
923
    $dbi = $dbi->dbh($dbh);
924
    $dbh = $dbi->dbh;
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
925
    
926
=head2 query_cache_max
927

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
930
    $class           = DBIx::Custom->query_cache_max(50);
931
    $query_cache_max = DBIx::Custom->query_cache_max;
932

            
933
Default value is 50
934

            
update document
yuki-kimoto authored on 2010-01-30
935
=head1 METHODS
936

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

            
940
=head2 connect
941

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

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

            
946
=head2 disconnect
947

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

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

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

            
954
=head2 reconnect
955

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

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

            
960
=head2 connected
961

            
version 0.0901
yuki-kimoto authored on 2009-12-17
962
Check if database is connected.
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
963
    
version 0.0901
yuki-kimoto authored on 2009-12-17
964
    $is_connected = $dbi->connected;
packaging one directory
yuki-kimoto authored on 2009-11-16
965
    
966
=head2 add_filter
967

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

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

            
986
=head2 add_format
987

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
1025
Return value of query method is L<DBIx::Custom::Result> object
1026

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

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

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

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

            
1039
If transaction is success, commit is execute. 
1040
If tranzation is died, rollback is execute.
1041

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1042
=head2 create_table
1043

            
1044
Create table
1045

            
1046
    $dbi->create_table(
1047
        'books',
1048
        'name char(255)',
1049
        'age  int'
1050
    );
1051

            
1052
First argument is table name. Rest arguments is column definition.
1053

            
1054
=head2 drop_table
1055

            
1056
Drop table
1057

            
1058
    $dbi->drop_table('books');
1059

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

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

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

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

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1073
You can add statement.
1074

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

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1077
=head2 update
1078

            
update document
yuki-kimoto authored on 2009-11-19
1079
Update rows
1080

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

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

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

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1090
You can add statement.
1091

            
1092
    $dbi->update('books', {title => 'Perl', author => 'Taro'},
1093
                 {id => 5}, "some statement");
1094

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1095
=head2 update_all
1096

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1099
    $affected = $dbi->update_all($table, \%updat_params);
update document
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
1102

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

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

            
1107
=head2 delete
1108

            
update document
yuki-kimoto authored on 2009-11-19
1109
Delete rows
1110

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1114
Retrun value is affected rows count
packaging one directory
yuki-kimoto authored on 2009-11-16
1115
    
version 0.0901
yuki-kimoto authored on 2009-12-17
1116
The following is delete sample.
1117

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1120
You can add statement.
1121

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

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1124
=head2 delete_all
1125

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

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

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

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

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

            
1136
=head2 select
1137
    
update document
yuki-kimoto authored on 2009-11-19
1138
Select rows
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1139

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

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

            
1150
The following is some select samples
1151

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

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

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1188
=head2 prepare
1189

            
1190
Prepare statement handle.
1191

            
1192
    $sth = $dbi->prepare('select * from books;');
1193

            
1194
This method is same as DBI prepare method.
1195

            
1196
See also L<DBI>.
1197

            
1198
=head2 do
1199

            
1200
Execute SQL
1201

            
1202
    $affected = $dbi->do('insert into books (title, author) values (?, ?)',
1203
                        'Perl', 'taro');
1204

            
1205
Retrun value is affected rows count.
1206

            
1207
This method is same as DBI do method.
1208

            
1209
See also L<DBI>
1210

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

            
1213

            
1214

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

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

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

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

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

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

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

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

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

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

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

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

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

            
1253
Copyright 2009 Yuki Kimoto, all rights reserved.
1254

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

            
1258
=cut