DBIx-Custom / lib / DBIx / Custom.pm /
Newer Older
1217 lines | 29.046kb
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

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

            
423
sub update {
insert, update, delete appnd...
yuki-kimoto authored on 2009-11-16
424
    my $self             = shift;
425
    my $table            = shift || '';
426
    my $update_params    = shift || {};
427
    my $where_params     = shift || {};
428
    my $append_statement = shift unless ref $_[0];
429
    my $query_edit_cb    = shift;
430
    my $options          = shift;
packaging one directory
yuki-kimoto authored on 2009-11-16
431
    
432
    # Update keys
433
    my @update_keys = keys %$update_params;
434
    
435
    # Not exists update kyes
436
    croak("Key-value pairs for update must be specified to 'update' second argument")
437
      unless @update_keys;
438
    
439
    # Where keys
440
    my @where_keys = keys %$where_params;
441
    
442
    # Not exists where keys
443
    croak("Key-value pairs for where clause must be specified to 'update' third argument")
444
      if !@where_keys && !$options->{allow_update_all};
445
    
446
    # Update clause
447
    my $update_clause = '{update ' . join(' ', @update_keys) . '}';
448
    
449
    # Where clause
450
    my $where_clause = '';
451
    if (@where_keys) {
452
        $where_clause = 'where ';
453
        foreach my $where_key (@where_keys) {
many change
yuki-kimoto authored on 2010-02-11
454
            my $key_info = DBIx::Custom::KeyInfo->new($where_key);
455
            
456
            my $table_new = $key_info->table || $table;
457
            my $column = $table_new . '.' . $key_info->column
458
                         . '#@where';
459

            
460
            $where_clause .= "{= $column} and ";
packaging one directory
yuki-kimoto authored on 2009-11-16
461
        }
462
        $where_clause =~ s/ and $//;
463
    }
464
    
465
    # Template for update
466
    my $template = "update $table $update_clause $where_clause";
insert, update, delete appnd...
yuki-kimoto authored on 2009-11-16
467
    $template .= " $append_statement" if $append_statement;
packaging one directory
yuki-kimoto authored on 2009-11-16
468
    
469
    # Create query
Simplify key search
yuki-kimoto authored on 2010-02-11
470
    my $query = $self->create_query([$table, $template]);
packaging one directory
yuki-kimoto authored on 2009-11-16
471
    
472
    # Query edit callback must be code reference
473
    croak("Query edit callback must be code reference")
474
      if $query_edit_cb && ref $query_edit_cb ne 'CODE';
475
    
476
    # Query edit if need
477
    $query_edit_cb->($query) if $query_edit_cb;
478
    
479
    # Rearrange parammeters
many change
yuki-kimoto authored on 2010-02-11
480
    my $params = {%$update_params, '@where' => $where_params};
packaging one directory
yuki-kimoto authored on 2009-11-16
481
    
482
    # Execute query
version 0.0901
yuki-kimoto authored on 2009-12-17
483
    my $ret_val = $self->query($query, $params);
packaging one directory
yuki-kimoto authored on 2009-11-16
484
    
485
    return $ret_val;
486
}
487

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

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

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

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

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

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

            
682
=head1 NAME
683

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

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

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

            
690
=cut
691

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

            
cleanup
yuki-kimoto authored on 2010-02-11
694
=head1 STATE
695

            
696
This module is not stable. Method name and functionality will be change.
697

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

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

            
729
=head2 user
730

            
update document
yuki-kimoto authored on 2010-01-30
731
Database user name
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
732
    
version 0.0901
yuki-kimoto authored on 2009-12-17
733
    $dbi  = $dbi->user('Ken');
734
    $user = $dbi->user;
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
735
    
packaging one directory
yuki-kimoto authored on 2009-11-16
736
=head2 password
737

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

            
743
=head2 data_source
744

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

            
packaging one directory
yuki-kimoto authored on 2009-11-16
752
=head2 database
753

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

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

            
add port and host method
yuki-kimoto authored on 2009-11-16
759
=head2 host
760

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

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

            
768
=head2 port
769

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

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

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

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

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

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

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

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

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

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

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
795
    $dbi     = $dbi->filters({filter1 => sub { }, filter2 => sub {}});
796
    $filters = $dbi->filters;
packaging one directory
yuki-kimoto authored on 2009-11-16
797
    
version 0.0901
yuki-kimoto authored on 2009-12-17
798
This method is generally used to get a filter.
799

            
800
    $filter = $dbi->filters->{encode_utf8};
801

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

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

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

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

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

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

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

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

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

            
cleanup
yuki-kimoto authored on 2010-04-28
821
    $dbi                 = $dbi->default_bind_filter($default_bind_filter);
822
    $default_bind_filter = $dbi->default_bind_filter
packaging one directory
yuki-kimoto authored on 2009-11-16
823

            
version 0.0901
yuki-kimoto authored on 2009-12-17
824
The following is bind filter sample
cleanup
yuki-kimoto authored on 2010-04-28
825
    
826
    $dbi->add_filter(encode_utf8 => sub {
827
        my $value = shift;
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
828
        
cleanup
yuki-kimoto authored on 2010-04-28
829
        require Encode 'encode_utf8';
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
830
        
cleanup
yuki-kimoto authored on 2010-04-28
831
        return encode_utf8($value);
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
832
    });
cleanup
yuki-kimoto authored on 2010-04-28
833
    
834
    $dbi->default_bind_filter('encode_utf8')
packaging one directory
yuki-kimoto authored on 2009-11-16
835

            
version 0.0901
yuki-kimoto authored on 2009-12-17
836
Bind filter arguemts is
837

            
838
    1. $value : Value
839
    2. $key   : Key
840
    3. $dbi   : DBIx::Custom object
841
    4. $infos : {table => $table, column => $column}
842

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

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

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

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

            
cleanup
yuki-kimoto authored on 2010-04-28
852
    $dbi->add_filter(decode_utf8 => sub {
853
        my $value = shift;
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
854
        
cleanup
yuki-kimoto authored on 2010-04-28
855
        require Encode 'decode_utf8';
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
856
        
cleanup
yuki-kimoto authored on 2010-04-28
857
        return decode_utf8($value);
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
858
    });
packaging one directory
yuki-kimoto authored on 2009-11-16
859

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
862
Bind filter arguemts is
863

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

            
packaging one directory
yuki-kimoto authored on 2009-11-16
869
=head2 result_class
870

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

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

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

            
packaging one directory
yuki-kimoto authored on 2009-11-16
878
=head2 dbh
879

            
update document
yuki-kimoto authored on 2010-01-30
880
Database handle
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
881
    
version 0.0901
yuki-kimoto authored on 2009-12-17
882
    $dbi = $dbi->dbh($dbh);
883
    $dbh = $dbi->dbh;
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
884
    
885
=head2 query_cache_max
886

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

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

            
892
Default value is 50
893

            
update document
yuki-kimoto authored on 2010-01-30
894
=head1 METHODS
895

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

            
899
=head2 connect
900

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

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

            
905
=head2 disconnect
906

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
907
Disconnect database
908

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

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

            
913
=head2 reconnect
914

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

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

            
919
=head2 connected
920

            
version 0.0901
yuki-kimoto authored on 2009-12-17
921
Check if database is connected.
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
922
    
version 0.0901
yuki-kimoto authored on 2009-12-17
923
    $is_connected = $dbi->connected;
packaging one directory
yuki-kimoto authored on 2009-11-16
924
    
925
=head2 add_filter
926

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
927
Resist filter
packaging one directory
yuki-kimoto authored on 2009-11-16
928
    
version 0.0901
yuki-kimoto authored on 2009-12-17
929
    $dbi->add_filter($fname1 => $filter1, $fname => $filter2);
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
930
    
version 0.0901
yuki-kimoto authored on 2009-12-17
931
The following is add_filter sample
932

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

            
945
=head2 add_format
946

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

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

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
955
=head2 create_query
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
956
    
version 0.0901
yuki-kimoto authored on 2009-12-17
957
Create Query object parsing SQL template
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
958

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

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

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

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

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

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

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

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

            
packaging one directory
yuki-kimoto authored on 2009-11-16
975
    $result = $dbi->query("select * from authors where {= name} and {= age}", 
976
                          {author => 'taro', age => 19});
977
    
978
    while (my @row = $result->fetch) {
979
        # do something
980
    }
981

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

            
984
Return value of query method is L<DBIx::Custom::Result> object
985

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

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

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

            
remove run_transaction().
yuki-kimoto authored on 2010-01-30
992
    $dbi->transaction->run(sub {
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
993
        my $dbi = shift;
994
        
packaging one directory
yuki-kimoto authored on 2009-11-16
995
        # do something
996
    });
997

            
998
If transaction is success, commit is execute. 
999
If tranzation is died, rollback is execute.
1000

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1001
=head2 create_table
1002

            
1003
Create table
1004

            
1005
    $dbi->create_table(
1006
        'books',
1007
        'name char(255)',
1008
        'age  int'
1009
    );
1010

            
1011
First argument is table name. Rest arguments is column definition.
1012

            
1013
=head2 drop_table
1014

            
1015
Drop table
1016

            
1017
    $dbi->drop_table('books');
1018

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1019
=head2 insert
1020

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

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1026
Retrun value is affected rows count
packaging one directory
yuki-kimoto authored on 2009-11-16
1027
    
version 0.0901
yuki-kimoto authored on 2009-12-17
1028
The following is insert sample.
1029

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1032
You can add statement.
1033

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

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1036
=head2 update
1037

            
update document
yuki-kimoto authored on 2009-11-19
1038
Update rows
1039

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

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

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

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1049
You can add statement.
1050

            
1051
    $dbi->update('books', {title => 'Perl', author => 'Taro'},
1052
                 {id => 5}, "some statement");
1053

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1054
=head2 update_all
1055

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

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

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

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

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

            
1066
=head2 delete
1067

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

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1073
Retrun value is affected rows count
packaging one directory
yuki-kimoto authored on 2009-11-16
1074
    
version 0.0901
yuki-kimoto authored on 2009-12-17
1075
The following is delete sample.
1076

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

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

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

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1083
=head2 delete_all
1084

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

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

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

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

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

            
1095
=head2 select
1096
    
update document
yuki-kimoto authored on 2009-11-19
1097
Select rows
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1098

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

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

            
1109
The following is some select samples
1110

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

            
1125
You can join multi tables
1126
    
1127
    $result = $dbi->select(
1128
        ['table1', 'table2'],                # tables
1129
        ['table1.id as table1_id', 'title'], # columns (alias is ok)
1130
        {table1.id => 1},                    # where clase
1131
        "where table1.id = table2.id",       # join clause (must start 'where')
1132
    );
1133

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1147
=head2 prepare
1148

            
1149
Prepare statement handle.
1150

            
1151
    $sth = $dbi->prepare('select * from books;');
1152

            
1153
This method is same as DBI prepare method.
1154

            
1155
See also L<DBI>.
1156

            
1157
=head2 do
1158

            
1159
Execute SQL
1160

            
1161
    $affected = $dbi->do('insert into books (title, author) values (?, ?)',
1162
                        'Perl', 'taro');
1163

            
1164
Retrun value is affected rows count.
1165

            
1166
This method is same as DBI do method.
1167

            
1168
See also L<DBI>
1169

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

            
1172

            
1173

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

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

            
1179
    1. AutoCommit is true
1180
    2. RaiseError is true
1181

            
1182
By default, Both AutoCommit and RaiseError is true.
1183
You must not change these mode not to damage your data.
1184

            
1185
If you change these mode, 
1186
you cannot get correct error message, 
1187
or run_transaction may fail.
1188

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

            
1191
DBIx::Custom is customizable DBI.
1192
You can inherit DBIx::Custom and custumize attributes.
1193

            
1194
    package DBIx::Custom::Yours;
1195
    use base DBIx::Custom;
1196
    
1197
    my $class = __PACKAGE__;
1198
    
1199
    $class->user('your_name');
1200
    $class->password('your_password');
1201

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1202
=head1 AUTHOR
1203

            
1204
Yuki Kimoto, C<< <kimoto.yuki at gmail.com> >>
1205

            
1206
Github L<http://github.com/yuki-kimoto>
1207

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

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

            
1212
Copyright 2009 Yuki Kimoto, all rights reserved.
1213

            
1214
This program is free software; you can redistribute it and/or modify it
1215
under the same terms as Perl itself.
1216

            
1217
=cut