DBIx-Custom / lib / DBIx / Custom.pm /
Newer Older
1234 lines | 29.094kb
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/]);
25
__PACKAGE__->attr([qw/bind_filter 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
213
    $query->bind_filter($self->bind_filter);
214
    
215
    # Set fetch filter
216
    $query->fetch_filter($self->fetch_filter);
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
sub filter_off {
683
    my $self = shift;
684
    
update document
yuki-kimoto authored on 2010-01-30
685
    # Filter off
packaging one directory
yuki-kimoto authored on 2009-11-16
686
    $self->bind_filter(undef);
687
    $self->fetch_filter(undef);
688
    
689
    return $self;
690
}
691

            
692
=head1 NAME
693

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

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

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

            
700
=cut
701

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

            
cleanup
yuki-kimoto authored on 2010-02-11
704
=head1 STATE
705

            
706
This module is not stable. Method name and functionality will be change.
707

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

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

            
739
=head2 user
740

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

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

            
753
=head2 data_source
754

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

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

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

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

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

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

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

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

            
778
=head2 port
779

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
827
=head2 bind_filter
828

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

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

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

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

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

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

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

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

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

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

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

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

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

            
packaging one directory
yuki-kimoto authored on 2009-11-16
875
=head2 result_class
876

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

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

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

            
packaging one directory
yuki-kimoto authored on 2009-11-16
884
=head2 dbh
885

            
update document
yuki-kimoto authored on 2010-01-30
886
Database handle
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
887
    
version 0.0901
yuki-kimoto authored on 2009-12-17
888
    $dbi = $dbi->dbh($dbh);
889
    $dbh = $dbi->dbh;
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
890
    
891
=head2 query_cache_max
892

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
895
    $class           = DBIx::Custom->query_cache_max(50);
896
    $query_cache_max = DBIx::Custom->query_cache_max;
897

            
898
Default value is 50
899

            
update document
yuki-kimoto authored on 2010-01-30
900
=head1 METHODS
901

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

            
905
=head2 connect
906

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

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

            
911
=head2 disconnect
912

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
913
Disconnect database
914

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

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

            
919
=head2 reconnect
920

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

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

            
925
=head2 connected
926

            
version 0.0901
yuki-kimoto authored on 2009-12-17
927
Check if database is connected.
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
928
    
version 0.0901
yuki-kimoto authored on 2009-12-17
929
    $is_connected = $dbi->connected;
packaging one directory
yuki-kimoto authored on 2009-11-16
930
    
931
=head2 filter_off
932

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
933
bind_filter and fitch_filter off
934
    
version 0.0901
yuki-kimoto authored on 2009-12-17
935
    $dbi->filter_off
packaging one directory
yuki-kimoto authored on 2009-11-16
936
    
version 0.0901
yuki-kimoto authored on 2009-12-17
937
This method is equeal to
packaging one directory
yuki-kimoto authored on 2009-11-16
938
    
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
939
    $dbi->bind_filter(undef);
940
    $dbi->fetch_filter(undef);
packaging one directory
yuki-kimoto authored on 2009-11-16
941

            
942
=head2 add_filter
943

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
944
Resist filter
packaging one directory
yuki-kimoto authored on 2009-11-16
945
    
version 0.0901
yuki-kimoto authored on 2009-12-17
946
    $dbi->add_filter($fname1 => $filter1, $fname => $filter2);
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
947
    
version 0.0901
yuki-kimoto authored on 2009-12-17
948
The following is add_filter sample
949

            
packaging one directory
yuki-kimoto authored on 2009-11-16
950
    $dbi->add_filter(
951
        encode_utf8 => sub {
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
952
            my ($value, $key, $dbi, $infos) = @_;
953
            utf8::upgrade($value) unless Encode::is_utf8($value);
954
            return encode('UTF-8', $value);
packaging one directory
yuki-kimoto authored on 2009-11-16
955
        },
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
956
        decode_utf8 => sub {
957
            my ($value, $key, $dbi, $infos) = @_;
958
            return decode('UTF-8', $value)
packaging one directory
yuki-kimoto authored on 2009-11-16
959
        }
960
    );
961

            
962
=head2 add_format
963

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

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

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
972
=head2 create_query
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
973
    
version 0.0901
yuki-kimoto authored on 2009-12-17
974
Create Query object parsing SQL template
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
975

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

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

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

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

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

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

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

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

            
packaging one directory
yuki-kimoto authored on 2009-11-16
992
    $result = $dbi->query("select * from authors where {= name} and {= age}", 
993
                          {author => 'taro', age => 19});
994
    
995
    while (my @row = $result->fetch) {
996
        # do something
997
    }
998

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

            
1001
Return value of query method is L<DBIx::Custom::Result> object
1002

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

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

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

            
remove run_transaction().
yuki-kimoto authored on 2010-01-30
1009
    $dbi->transaction->run(sub {
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1010
        my $dbi = shift;
1011
        
packaging one directory
yuki-kimoto authored on 2009-11-16
1012
        # do something
1013
    });
1014

            
1015
If transaction is success, commit is execute. 
1016
If tranzation is died, rollback is execute.
1017

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1018
=head2 create_table
1019

            
1020
Create table
1021

            
1022
    $dbi->create_table(
1023
        'books',
1024
        'name char(255)',
1025
        'age  int'
1026
    );
1027

            
1028
First argument is table name. Rest arguments is column definition.
1029

            
1030
=head2 drop_table
1031

            
1032
Drop table
1033

            
1034
    $dbi->drop_table('books');
1035

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

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

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1043
Retrun value is affected rows count
packaging one directory
yuki-kimoto authored on 2009-11-16
1044
    
version 0.0901
yuki-kimoto authored on 2009-12-17
1045
The following is insert sample.
1046

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

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

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

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1053
=head2 update
1054

            
update document
yuki-kimoto authored on 2009-11-19
1055
Update rows
1056

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

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

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

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1066
You can add statement.
1067

            
1068
    $dbi->update('books', {title => 'Perl', author => 'Taro'},
1069
                 {id => 5}, "some statement");
1070

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1071
=head2 update_all
1072

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

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

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

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

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

            
1083
=head2 delete
1084

            
update document
yuki-kimoto authored on 2009-11-19
1085
Delete rows
1086

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1090
Retrun value is affected rows count
packaging one directory
yuki-kimoto authored on 2009-11-16
1091
    
version 0.0901
yuki-kimoto authored on 2009-12-17
1092
The following is delete sample.
1093

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1096
You can add statement.
1097

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

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1100
=head2 delete_all
1101

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

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

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

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

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

            
1112
=head2 select
1113
    
update document
yuki-kimoto authored on 2009-11-19
1114
Select rows
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1115

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1116
    $resut = $dbi->select(
packaging one directory
yuki-kimoto authored on 2009-11-16
1117
        $table,                # must be string or array;
version 0.0901
yuki-kimoto authored on 2009-12-17
1118
        \@$columns,            # must be array reference. this can be ommited
1119
        \%$where_params,       # must be hash reference.  this can be ommited
1120
        $append_statement,     # must be string.          this can be ommited
1121
        $query_edit_callback   # must be code reference.  this can be ommited
packaging one directory
yuki-kimoto authored on 2009-11-16
1122
    );
update document
yuki-kimoto authored on 2009-11-19
1123

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

            
1126
The following is some select samples
1127

            
1128
    # select * from books;
1129
    $result = $dbi->select('books');
packaging one directory
yuki-kimoto authored on 2009-11-16
1130
    
update document
yuki-kimoto authored on 2009-11-19
1131
    # select * from books where title = 'Perl';
1132
    $result = $dbi->select('books', {title => 1});
1133
    
1134
    # select title, author from books where id = 1 for update;
1135
    $result = $dbi->select(
1136
        'books',              # table
1137
        ['title', 'author'],  # columns
1138
        {id => 1},            # where clause
1139
        'for update',         # append statement
1140
    );
1141

            
1142
You can join multi tables
1143
    
1144
    $result = $dbi->select(
1145
        ['table1', 'table2'],                # tables
1146
        ['table1.id as table1_id', 'title'], # columns (alias is ok)
1147
        {table1.id => 1},                    # where clase
1148
        "where table1.id = table2.id",       # join clause (must start 'where')
1149
    );
1150

            
1151
You can also edit query
1152
        
packaging one directory
yuki-kimoto authored on 2009-11-16
1153
    $dbi->select(
update document
yuki-kimoto authored on 2009-11-19
1154
        'books',
1155
        # column, where clause, append statement,
packaging one directory
yuki-kimoto authored on 2009-11-16
1156
        sub {
1157
            my $query = shift;
1158
            $query->bind_filter(sub {
1159
                # ...
1160
            });
1161
        }
update document
yuki-kimoto authored on 2009-11-19
1162
    }
1163

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1164
=head2 prepare
1165

            
1166
Prepare statement handle.
1167

            
1168
    $sth = $dbi->prepare('select * from books;');
1169

            
1170
This method is same as DBI prepare method.
1171

            
1172
See also L<DBI>.
1173

            
1174
=head2 do
1175

            
1176
Execute SQL
1177

            
1178
    $affected = $dbi->do('insert into books (title, author) values (?, ?)',
1179
                        'Perl', 'taro');
1180

            
1181
Retrun value is affected rows count.
1182

            
1183
This method is same as DBI do method.
1184

            
1185
See also L<DBI>
1186

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

            
1189

            
1190

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

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

            
1196
    1. AutoCommit is true
1197
    2. RaiseError is true
1198

            
1199
By default, Both AutoCommit and RaiseError is true.
1200
You must not change these mode not to damage your data.
1201

            
1202
If you change these mode, 
1203
you cannot get correct error message, 
1204
or run_transaction may fail.
1205

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

            
1208
DBIx::Custom is customizable DBI.
1209
You can inherit DBIx::Custom and custumize attributes.
1210

            
1211
    package DBIx::Custom::Yours;
1212
    use base DBIx::Custom;
1213
    
1214
    my $class = __PACKAGE__;
1215
    
1216
    $class->user('your_name');
1217
    $class->password('your_password');
1218

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1219
=head1 AUTHOR
1220

            
1221
Yuki Kimoto, C<< <kimoto.yuki at gmail.com> >>
1222

            
1223
Github L<http://github.com/yuki-kimoto>
1224

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

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

            
1229
Copyright 2009 Yuki Kimoto, all rights reserved.
1230

            
1231
This program is free software; you can redistribute it and/or modify it
1232
under the same terms as Perl itself.
1233

            
1234
=cut