DBIx-Custom / lib / DBIx / Custom.pm /
Newer Older
1150 lines | 26.431kb
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;
many many changes
yuki-kimoto authored on 2010-04-30
11
use DBIx::Custom::SQLTemplate;
cleanup
yuki-kimoto authored on 2010-02-11
12
use DBIx::Custom::Query;
packaging one directory
yuki-kimoto authored on 2009-11-16
13

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
131
sub create_query {
132
    my ($self, $template) = @_;
cleanup
yuki-kimoto authored on 2010-02-11
133
    
packaging one directory
yuki-kimoto authored on 2009-11-16
134
    my $class = ref $self;
135
    
cleanup
yuki-kimoto authored on 2010-02-11
136
    if (ref $template eq 'ARRAY') {
137
        $template = $template->[1];
138
    }
139
    
packaging one directory
yuki-kimoto authored on 2009-11-16
140
    # Create query from SQL template
version 0.0901
yuki-kimoto authored on 2009-12-17
141
    my $sql_tmpl = $self->sql_tmpl;
packaging one directory
yuki-kimoto authored on 2009-11-16
142
    
143
    # Try to get cached query
many many changes
yuki-kimoto authored on 2010-04-30
144
    my $cached_query = $class->_query_caches->{"$template"};
packaging one directory
yuki-kimoto authored on 2009-11-16
145
    
146
    # Create query
fix timeformat tests
yuki-kimoto authored on 2009-11-23
147
    my $query;
cleanup
yuki-kimoto authored on 2010-02-11
148
    if ($cached_query) {
149
        $query = DBIx::Custom::Query->new(
150
            sql       => $cached_query->sql,
simplify filtering system
yuki-kimoto authored on 2010-05-01
151
            columns => $cached_query->columns
cleanup
yuki-kimoto authored on 2010-02-11
152
        );
fix timeformat tests
yuki-kimoto authored on 2009-11-23
153
    }
154
    else {
Simplify key search
yuki-kimoto authored on 2010-02-11
155
        $query = eval{$sql_tmpl->create_query($template)};
packaging one directory
yuki-kimoto authored on 2009-11-16
156
        croak($@) if $@;
157
        
many many changes
yuki-kimoto authored on 2010-04-30
158
        $class->_add_query_cache("$template", $query);
packaging one directory
yuki-kimoto authored on 2009-11-16
159
    }
160
    
161
    # Connect if not
162
    $self->connect unless $self->connected;
163
    
164
    # Prepare statement handle
add all tests
yuki-kimoto authored on 2010-05-01
165
    my $sth = $self->dbh->prepare($query->{sql});
packaging one directory
yuki-kimoto authored on 2009-11-16
166
    
167
    # Set statement handle
168
    $query->sth($sth);
169
    
170
    return $query;
171
}
172

            
rename query() to execute()
yuki-kimoto authored on 2010-05-01
173
sub execute{
many many changes
yuki-kimoto authored on 2010-04-30
174
    my ($self, $query, $params, $args)  = @_;
packaging one directory
yuki-kimoto authored on 2009-11-16
175
    $params ||= {};
176
    
177
    # First argument is SQL template
Simplify key search
yuki-kimoto authored on 2010-02-11
178
    unless (ref $query eq 'DBIx::Custom::Query') {
179
        my $template;
180
        
181
        if (ref $query eq 'ARRAY') {
many many changes
yuki-kimoto authored on 2010-04-30
182
            $template = $query->[0];
Simplify key search
yuki-kimoto authored on 2010-02-11
183
        }
184
        else { $template = $query }
185
        
many many changes
yuki-kimoto authored on 2010-04-30
186
        $query = $self->create_query($template);
packaging one directory
yuki-kimoto authored on 2009-11-16
187
    }
many many changes
yuki-kimoto authored on 2010-04-30
188

            
many change
yuki-kimoto authored on 2010-04-30
189
    # Filter
190
    my $filter = $args->{filter} || $query->filter || {};
191

            
packaging one directory
yuki-kimoto authored on 2009-11-16
192
    # Create bind value
many many changes
yuki-kimoto authored on 2010-04-30
193
    my $bind_values = $self->_build_bind_values($query, $params, $filter);
packaging one directory
yuki-kimoto authored on 2009-11-16
194
    
195
    # Execute
version 0.0901
yuki-kimoto authored on 2009-12-17
196
    my $sth      = $query->sth;
197
    my $affected = eval{$sth->execute(@$bind_values)};
packaging one directory
yuki-kimoto authored on 2009-11-16
198
    
199
    # Execute error
200
    if (my $execute_error = $@) {
201
        require Data::Dumper;
202
        my $sql              = $query->{sql} || '';
203
        my $params_dump      = Data::Dumper->Dump([$params], ['*params']);
204
        
205
        croak("$execute_error" . 
206
              "<Your SQL>\n$sql\n" . 
207
              "<Your parameters>\n$params_dump");
208
    }
209
    
210
    # Return resultset if select statement is executed
211
    if ($sth->{NUM_OF_FIELDS}) {
212
        
213
        # Get result class
214
        my $result_class = $self->result_class;
215
        
216
        # Create result
217
        my $result = $result_class->new({
many many changes
yuki-kimoto authored on 2010-04-30
218
            sth             => $sth,
219
            default_filter  => $self->default_fetch_filter,
220
            filters         => $self->filters
packaging one directory
yuki-kimoto authored on 2009-11-16
221
        });
222
        return $result;
223
    }
version 0.0901
yuki-kimoto authored on 2009-12-17
224
    return $affected;
packaging one directory
yuki-kimoto authored on 2009-11-16
225
}
226

            
227
sub _build_bind_values {
many many changes
yuki-kimoto authored on 2010-04-30
228
    my ($self, $query, $params, $filter) = @_;
packaging one directory
yuki-kimoto authored on 2009-11-16
229
    
230
    # binding values
231
    my @bind_values;
232
    
Simplify key search
yuki-kimoto authored on 2010-02-11
233
    # Build bind values
simplify filtering system
yuki-kimoto authored on 2010-05-01
234
    my $count = {};
235
    foreach my $column (@{$query->columns}) {
packaging one directory
yuki-kimoto authored on 2009-11-16
236
        
Simplify key search
yuki-kimoto authored on 2010-02-11
237
        # Value
simplify filtering system
yuki-kimoto authored on 2010-05-01
238
        my $value = ref $params->{$column}
239
                  ? $params->{$column}->[$count->{$column} || 0]
240
                  : $params->{$column};
packaging one directory
yuki-kimoto authored on 2009-11-16
241
        
Simplify key search
yuki-kimoto authored on 2010-02-11
242
        # Filter
simplify filtering system
yuki-kimoto authored on 2010-05-01
243
        $filter ||= {};
many many changes
yuki-kimoto authored on 2010-04-30
244
        
simplify filtering system
yuki-kimoto authored on 2010-05-01
245
        # Filter name
246
        my $fname = $filter->{$column} || $self->default_query_filter || '';
247
        
248
        my $filters = $self->filters;
many change
yuki-kimoto authored on 2010-04-30
249
        push @bind_values, $filters->{$fname}
250
                         ? $filters->{$fname}->($value)
251
                         : $value;
simplify filtering system
yuki-kimoto authored on 2010-05-01
252
        
253
        # Count up 
254
        $count->{$column}++;
cleanup
yuki-kimoto authored on 2010-02-11
255
    }
256
    
Simplify key search
yuki-kimoto authored on 2010-02-11
257
    return \@bind_values;
cleanup
yuki-kimoto authored on 2010-02-11
258
}
259

            
remove DBIx::Custom::Transac...
yuki-kimoto authored on 2010-02-11
260
sub run_transaction {
261
    my ($self, $transaction) = @_;
262
    
263
    # Shorcut
many change
yuki-kimoto authored on 2010-02-11
264
    return unless $self;
remove DBIx::Custom::Transac...
yuki-kimoto authored on 2010-02-11
265
    
266
    # Check auto commit
267
    croak("AutoCommit must be true before transaction start")
many change
yuki-kimoto authored on 2010-02-11
268
      unless $self->_auto_commit;
remove DBIx::Custom::Transac...
yuki-kimoto authored on 2010-02-11
269
    
270
    # Auto commit off
many change
yuki-kimoto authored on 2010-02-11
271
    $self->_auto_commit(0);
remove DBIx::Custom::Transac...
yuki-kimoto authored on 2010-02-11
272
    
273
    # Run transaction
274
    eval {$transaction->()};
275
    
276
    # Tranzaction error
277
    my $transaction_error = $@;
278
    
279
    # Tranzaction is failed.
280
    if ($transaction_error) {
281
        # Rollback
many change
yuki-kimoto authored on 2010-02-11
282
        eval{$self->dbh->rollback};
remove DBIx::Custom::Transac...
yuki-kimoto authored on 2010-02-11
283
        
284
        # Rollback error
285
        my $rollback_error = $@;
286
        
287
        # Auto commit on
many change
yuki-kimoto authored on 2010-02-11
288
        $self->_auto_commit(1);
remove DBIx::Custom::Transac...
yuki-kimoto authored on 2010-02-11
289
        
290
        if ($rollback_error) {
291
            # Rollback is failed
292
            croak("${transaction_error}Rollback is failed : $rollback_error");
293
        }
294
        else {
295
            # Rollback is success
296
            croak("${transaction_error}Rollback is success");
297
        }
298
    }
299
    # Tranzaction is success
300
    else {
301
        # Commit
many change
yuki-kimoto authored on 2010-02-11
302
        eval{$self->dbh->commit};
remove DBIx::Custom::Transac...
yuki-kimoto authored on 2010-02-11
303
        my $commit_error = $@;
304
        
305
        # Auto commit on
many change
yuki-kimoto authored on 2010-02-11
306
        $self->_auto_commit(1);
remove DBIx::Custom::Transac...
yuki-kimoto authored on 2010-02-11
307
        
308
        # Commit is failed
309
        croak($commit_error) if $commit_error;
310
    }
311
}
312

            
version 0.0901
yuki-kimoto authored on 2009-12-17
313
sub create_table {
314
    my ($self, $table, @column_definitions) = @_;
315
    
316
    # Create table
rename fetch_first to fetch_...
yuki-kimoto authored on 2010-01-29
317
    my $sql = "create table $table (";
version 0.0901
yuki-kimoto authored on 2009-12-17
318
    
319
    # Column definitions
320
    foreach my $column_definition (@column_definitions) {
rename fetch_first to fetch_...
yuki-kimoto authored on 2010-01-29
321
        $sql .= "$column_definition,";
version 0.0901
yuki-kimoto authored on 2009-12-17
322
    }
rename fetch_first to fetch_...
yuki-kimoto authored on 2010-01-29
323
    $sql =~ s/,$//;
version 0.0901
yuki-kimoto authored on 2009-12-17
324
    
325
    # End
rename fetch_first to fetch_...
yuki-kimoto authored on 2010-01-29
326
    $sql .= ");";
version 0.0901
yuki-kimoto authored on 2009-12-17
327
    
add all tests
yuki-kimoto authored on 2010-05-01
328
    # Connect
329
    $self->connect unless $self->connected;
330
    
version 0.0901
yuki-kimoto authored on 2009-12-17
331
    # Do query
add all tests
yuki-kimoto authored on 2010-05-01
332
    return $self->dbh->do($sql);
version 0.0901
yuki-kimoto authored on 2009-12-17
333
}
334

            
335
sub drop_table {
336
    my ($self, $table) = @_;
337
    
338
    # Drop table
339
    my $sql = "drop table $table;";
340

            
add all tests
yuki-kimoto authored on 2010-05-01
341
    # Connect
342
    $self->connect unless $self->connected;
343

            
version 0.0901
yuki-kimoto authored on 2009-12-17
344
    # Do query
add all tests
yuki-kimoto authored on 2010-05-01
345
    return $self->dbh->do($sql);
version 0.0901
yuki-kimoto authored on 2009-12-17
346
}
347

            
many many changes
yuki-kimoto authored on 2010-04-30
348
our %VALID_INSERT_ARGS = map { $_ => 1 } qw/append filter/;
cleanup insert
yuki-kimoto authored on 2010-04-28
349

            
packaging one directory
yuki-kimoto authored on 2009-11-16
350
sub insert {
cleanup insert
yuki-kimoto authored on 2010-04-28
351
    my ($self, $table, $insert_params, $args) = @_;
352
    
353
    # Table
354
    $table ||= '';
355
    
356
    # Insert params
357
    $insert_params ||= {};
358
    
359
    # Arguments
360
    $args ||= {};
361
    
362
    # Check arguments
363
    foreach my $name (keys %$args) {
364
        croak "\"$name\" is invalid name"
365
          unless $VALID_INSERT_ARGS{$name};
366
    }
367
    
368
    my $append_statement = $args->{append} || '';
many many changes
yuki-kimoto authored on 2010-04-30
369
    my $filter           = $args->{filter};
packaging one directory
yuki-kimoto authored on 2009-11-16
370
    
371
    # Insert keys
372
    my @insert_keys = keys %$insert_params;
373
    
374
    # Not exists insert keys
375
    croak("Key-value pairs for insert must be specified to 'insert' second argument")
376
      unless @insert_keys;
377
    
378
    # Templte for insert
379
    my $template = "insert into $table {insert " . join(' ', @insert_keys) . '}';
insert, update, delete appnd...
yuki-kimoto authored on 2009-11-16
380
    $template .= " $append_statement" if $append_statement;
packaging one directory
yuki-kimoto authored on 2009-11-16
381
    
382
    # Execute query
rename query() to execute()
yuki-kimoto authored on 2010-05-01
383
    my $ret_val = $self->execute($template, $insert_params, {filter => $filter});
packaging one directory
yuki-kimoto authored on 2009-11-16
384
    
385
    return $ret_val;
386
}
387

            
cleanup update and update_al...
yuki-kimoto authored on 2010-04-28
388
our %VALID_UPDATE_ARGS
many many changes
yuki-kimoto authored on 2010-04-30
389
  = map { $_ => 1 } qw/where append filter allow_update_all/;
cleanup update and update_al...
yuki-kimoto authored on 2010-04-28
390

            
packaging one directory
yuki-kimoto authored on 2009-11-16
391
sub update {
simplify filtering system
yuki-kimoto authored on 2010-05-01
392
    my ($self, $table, $params, $args) = @_;
cleanup update and update_al...
yuki-kimoto authored on 2010-04-28
393
    
394
    # Check arguments
395
    foreach my $name (keys %$args) {
396
        croak "\"$name\" is invalid name"
397
          unless $VALID_UPDATE_ARGS{$name};
398
    }
399
    
400
    # Arguments
401
    my $where_params     = $args->{where} || {};
402
    my $append_statement = $args->{append} || '';
many many changes
yuki-kimoto authored on 2010-04-30
403
    my $filter           = $args->{filter};
cleanup update and update_al...
yuki-kimoto authored on 2010-04-28
404
    my $allow_update_all = $args->{allow_update_all};
packaging one directory
yuki-kimoto authored on 2009-11-16
405
    
406
    # Update keys
simplify filtering system
yuki-kimoto authored on 2010-05-01
407
    my @update_keys = keys %$params;
packaging one directory
yuki-kimoto authored on 2009-11-16
408
    
409
    # Not exists update kyes
410
    croak("Key-value pairs for update must be specified to 'update' second argument")
411
      unless @update_keys;
412
    
413
    # Where keys
414
    my @where_keys = keys %$where_params;
415
    
416
    # Not exists where keys
417
    croak("Key-value pairs for where clause must be specified to 'update' third argument")
cleanup update and update_al...
yuki-kimoto authored on 2010-04-28
418
      if !@where_keys && !$allow_update_all;
packaging one directory
yuki-kimoto authored on 2009-11-16
419
    
420
    # Update clause
421
    my $update_clause = '{update ' . join(' ', @update_keys) . '}';
422
    
423
    # Where clause
424
    my $where_clause = '';
simplify filtering system
yuki-kimoto authored on 2010-05-01
425
    my $new_where = {};
many change
yuki-kimoto authored on 2010-04-30
426
    
packaging one directory
yuki-kimoto authored on 2009-11-16
427
    if (@where_keys) {
428
        $where_clause = 'where ';
429
        foreach my $where_key (@where_keys) {
simplify filtering system
yuki-kimoto authored on 2010-05-01
430
            
431
            $where_clause .= "{= $where_key} and ";
packaging one directory
yuki-kimoto authored on 2009-11-16
432
        }
433
        $where_clause =~ s/ and $//;
434
    }
435
    
436
    # Template for update
437
    my $template = "update $table $update_clause $where_clause";
insert, update, delete appnd...
yuki-kimoto authored on 2009-11-16
438
    $template .= " $append_statement" if $append_statement;
packaging one directory
yuki-kimoto authored on 2009-11-16
439
    
440
    # Rearrange parammeters
simplify filtering system
yuki-kimoto authored on 2010-05-01
441
    foreach my $where_key (@where_keys) {
442
        
443
        if (exists $params->{$where_key}) {
444
            $params->{$where_key} = [$params->{$where_key}]
445
              unless ref $params->{$where_key} eq 'ARRAY';
446
            
compile success
yuki-kimoto authored on 2010-05-01
447
            push @{$params->{$where_key}}, $where_params->{$where_key};
simplify filtering system
yuki-kimoto authored on 2010-05-01
448
        }
add tests
yuki-kimoto authored on 2010-05-01
449
        else {
450
            $params->{$where_key} = $where_params->{$where_key};
451
        }
simplify filtering system
yuki-kimoto authored on 2010-05-01
452
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
453
    
454
    # Execute query
rename query() to execute()
yuki-kimoto authored on 2010-05-01
455
    my $ret_val = $self->execute($template, $params, {filter => $filter});
packaging one directory
yuki-kimoto authored on 2009-11-16
456
    
457
    return $ret_val;
458
}
459

            
460
sub update_all {
cleanup update and update_al...
yuki-kimoto authored on 2010-04-28
461
    my ($self, $table, $update_params, $args) = @_;
462
    
refactoring select
yuki-kimoto authored on 2010-04-28
463
    # Allow all update
cleanup update and update_al...
yuki-kimoto authored on 2010-04-28
464
    $args ||= {};
465
    $args->{allow_update_all} = 1;
insert, update, delete appnd...
yuki-kimoto authored on 2009-11-16
466
    
update document
yuki-kimoto authored on 2010-01-30
467
    # Update all rows
cleanup update and update_al...
yuki-kimoto authored on 2010-04-28
468
    return $self->update($table, $update_params, $args);
packaging one directory
yuki-kimoto authored on 2009-11-16
469
}
470

            
refactoring delete and delet...
yuki-kimoto authored on 2010-04-28
471
our %VALID_DELETE_ARGS
many many changes
yuki-kimoto authored on 2010-04-30
472
  = map { $_ => 1 } qw/where append filter allow_delete_all/;
refactoring delete and delet...
yuki-kimoto authored on 2010-04-28
473

            
packaging one directory
yuki-kimoto authored on 2009-11-16
474
sub delete {
refactoring delete and delet...
yuki-kimoto authored on 2010-04-28
475
    my ($self, $table, $args) = @_;
476
    
477
    # Table
478
    $table            ||= '';
479

            
480
    # Check arguments
481
    foreach my $name (keys %$args) {
482
        croak "\"$name\" is invalid name"
483
          unless $VALID_DELETE_ARGS{$name};
484
    }
485
    
486
    # Arguments
487
    my $where_params     = $args->{where} || {};
488
    my $append_statement = $args->{append};
many many changes
yuki-kimoto authored on 2010-04-30
489
    my $filter    = $args->{filter};
refactoring delete and delet...
yuki-kimoto authored on 2010-04-28
490
    my $allow_delete_all = $args->{allow_delete_all};
packaging one directory
yuki-kimoto authored on 2009-11-16
491
    
492
    # Where keys
493
    my @where_keys = keys %$where_params;
494
    
495
    # Not exists where keys
496
    croak("Key-value pairs for where clause must be specified to 'delete' second argument")
refactoring delete and delet...
yuki-kimoto authored on 2010-04-28
497
      if !@where_keys && !$allow_delete_all;
packaging one directory
yuki-kimoto authored on 2009-11-16
498
    
499
    # Where clause
500
    my $where_clause = '';
501
    if (@where_keys) {
502
        $where_clause = 'where ';
503
        foreach my $where_key (@where_keys) {
504
            $where_clause .= "{= $where_key} and ";
505
        }
506
        $where_clause =~ s/ and $//;
507
    }
508
    
509
    # Template for delete
510
    my $template = "delete from $table $where_clause";
insert, update, delete appnd...
yuki-kimoto authored on 2009-11-16
511
    $template .= " $append_statement" if $append_statement;
packaging one directory
yuki-kimoto authored on 2009-11-16
512
    
513
    # Execute query
rename query() to execute()
yuki-kimoto authored on 2010-05-01
514
    my $ret_val = $self->execute($template, $where_params, {filter => $filter});
packaging one directory
yuki-kimoto authored on 2009-11-16
515
    
516
    return $ret_val;
517
}
518

            
519
sub delete_all {
refactoring delete and delet...
yuki-kimoto authored on 2010-04-28
520
    my ($self, $table, $args) = @_;
521
    
refactoring select
yuki-kimoto authored on 2010-04-28
522
    # Allow all delete
refactoring delete and delet...
yuki-kimoto authored on 2010-04-28
523
    $args ||= {};
524
    $args->{allow_delete_all} = 1;
insert, update, delete appnd...
yuki-kimoto authored on 2009-11-16
525
    
update document
yuki-kimoto authored on 2010-01-30
526
    # Delete all rows
refactoring delete and delet...
yuki-kimoto authored on 2010-04-28
527
    return $self->delete($table, $args);
packaging one directory
yuki-kimoto authored on 2009-11-16
528
}
529

            
refactoring select
yuki-kimoto authored on 2010-04-28
530
our %VALID_SELECT_ARGS
many many changes
yuki-kimoto authored on 2010-04-30
531
  = map { $_ => 1 } qw/columns where append filter/;
refactoring select
yuki-kimoto authored on 2010-04-28
532

            
packaging one directory
yuki-kimoto authored on 2009-11-16
533
sub select {
refactoring select
yuki-kimoto authored on 2010-04-28
534
    my ($self, $tables, $args) = @_;
packaging one directory
yuki-kimoto authored on 2009-11-16
535
    
refactoring select
yuki-kimoto authored on 2010-04-28
536
    # Table
537
    $tables ||= '';
538
    $tables = [$tables] unless ref $tables;
packaging one directory
yuki-kimoto authored on 2009-11-16
539
    
refactoring select
yuki-kimoto authored on 2010-04-28
540
    # Check arguments
541
    foreach my $name (keys %$args) {
542
        croak "\"$name\" is invalid name"
543
          unless $VALID_SELECT_ARGS{$name};
544
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
545
    
refactoring select
yuki-kimoto authored on 2010-04-28
546
    # Arguments
547
    my $columns          = $args->{columns} || [];
548
    my $where_params     = $args->{where} || {};
549
    my $append_statement = $args->{append} || '';
many many changes
yuki-kimoto authored on 2010-04-30
550
    my $filter    = $args->{filter};
packaging one directory
yuki-kimoto authored on 2009-11-16
551
    
552
    # SQL template for select statement
553
    my $template = 'select ';
554
    
555
    # Join column clause
556
    if (@$columns) {
557
        foreach my $column (@$columns) {
558
            $template .= "$column, ";
559
        }
560
        $template =~ s/, $/ /;
561
    }
562
    else {
563
        $template .= '* ';
564
    }
565
    
566
    # Join table
567
    $template .= 'from ';
568
    foreach my $table (@$tables) {
569
        $template .= "$table, ";
570
    }
571
    $template =~ s/, $/ /;
572
    
573
    # Where clause keys
574
    my @where_keys = keys %$where_params;
575
    
576
    # Join where clause
577
    if (@where_keys) {
578
        $template .= 'where ';
579
        foreach my $where_key (@where_keys) {
compile success
yuki-kimoto authored on 2010-05-01
580
            $template .= "{= $where_key} and ";
packaging one directory
yuki-kimoto authored on 2009-11-16
581
        }
582
    }
583
    $template =~ s/ and $//;
584
    
585
    # Append something to last of statement
586
    if ($append_statement =~ s/^where //) {
587
        if (@where_keys) {
588
            $template .= " and $append_statement";
589
        }
590
        else {
591
            $template .= " where $append_statement";
592
        }
593
    }
594
    else {
595
        $template .= " $append_statement";
596
    }
597
    
598
    # Execute query
rename query() to execute()
yuki-kimoto authored on 2010-05-01
599
    my $result = $self->execute($template, $where_params, {filter => $filter});
packaging one directory
yuki-kimoto authored on 2009-11-16
600
    
601
    return $result;
602
}
603

            
604
sub _add_query_cache {
605
    my ($class, $template, $query) = @_;
update document
yuki-kimoto authored on 2010-01-30
606
    
607
    # Query information
packaging one directory
yuki-kimoto authored on 2009-11-16
608
    my $query_cache_keys = $class->_query_cache_keys;
609
    my $query_caches     = $class->_query_caches;
610
    
update document
yuki-kimoto authored on 2010-01-30
611
    # Already cached
packaging one directory
yuki-kimoto authored on 2009-11-16
612
    return $class if $query_caches->{$template};
613
    
update document
yuki-kimoto authored on 2010-01-30
614
    # Cache
packaging one directory
yuki-kimoto authored on 2009-11-16
615
    $query_caches->{$template} = $query;
616
    push @$query_cache_keys, $template;
617
    
update document
yuki-kimoto authored on 2010-01-30
618
    # Check cache overflow
packaging one directory
yuki-kimoto authored on 2009-11-16
619
    my $overflow = @$query_cache_keys - $class->query_cache_max;
620
    for (my $i = 0; $i < $overflow; $i++) {
621
        my $template = shift @$query_cache_keys;
622
        delete $query_caches->{$template};
623
    }
624
    
625
    return $class;
626
}
627

            
628
=head1 NAME
629

            
renamed fetch_rows to fetch_...
yuki-kimoto authored on 2010-05-01
630
DBIx::Custom - DBI with hash bind and filtering system 
packaging one directory
yuki-kimoto authored on 2009-11-16
631

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

            
renamed fetch_rows to fetch_...
yuki-kimoto authored on 2010-05-01
634
Version 0.1301
catch up with Object::Simple...
yuki-kimoto authored on 2010-01-18
635

            
636
=cut
637

            
renamed fetch_rows to fetch_...
yuki-kimoto authored on 2010-05-01
638
our $VERSION = '0.1301';
packaging one directory
yuki-kimoto authored on 2009-11-16
639

            
cleanup
yuki-kimoto authored on 2010-02-11
640
=head1 STATE
641

            
642
This module is not stable. Method name and functionality will be change.
643

            
version 0.0901
yuki-kimoto authored on 2009-12-17
644
=head1 SYNOPSYS
645
    
646
    # New
647
    my $dbi = DBIx::Custom->new(data_source => "dbi:mysql:database=books"
648
                                user => 'ken', password => '!LFKD%$&');
649
    
650
    # Query
rename query() to execute()
yuki-kimoto authored on 2010-05-01
651
    $dbi->execute("select title from books");
version 0.0901
yuki-kimoto authored on 2009-12-17
652
    
653
    # Query with parameters
rename query() to execute()
yuki-kimoto authored on 2010-05-01
654
    $dbi->execute("select id from books where {= author} && {like title}",
version 0.0901
yuki-kimoto authored on 2009-12-17
655
                {author => 'ken', title => '%Perl%'});
656
    
657
    # Insert 
658
    $dbi->insert('books', {title => 'perl', author => 'Ken'});
659
    
660
    # Update 
renamed fetch_rows to fetch_...
yuki-kimoto authored on 2010-05-01
661
    $dbi->update('books', {title => 'aaa', author => 'Ken'}, {where => {id => 5}});
version 0.0901
yuki-kimoto authored on 2009-12-17
662
    
663
    # Delete
renamed fetch_rows to fetch_...
yuki-kimoto authored on 2010-05-01
664
    $dbi->delete('books', {where => {author => 'Ken'}});
version 0.0901
yuki-kimoto authored on 2009-12-17
665
    
666
    # Select
renamed fetch_rows to fetch_...
yuki-kimoto authored on 2010-05-01
667
    my $result = $dbi->select('books');
668
    my $result = $dbi->select('books', {where => {author => 'taro'}}); 
669
    
670
    my $result = $dbi->select(
671
       'books', 
672
       {
673
           columns => [qw/author title/],
674
           where   => {author => 'Ken'}
675
        }
676
    );
677
    
678
    my $result = $dbi->select(
679
        'books',
680
        {
681
            columns => [qw/author title/],
682
            where   => {author => 'Ken'},
683
            append  => 'order by id limit 1'
684
        }
685
    );
packaging one directory
yuki-kimoto authored on 2009-11-16
686

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

            
689
=head2 user
690

            
update document
yuki-kimoto authored on 2010-01-30
691
Database user name
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
692
    
version 0.0901
yuki-kimoto authored on 2009-12-17
693
    $dbi  = $dbi->user('Ken');
694
    $user = $dbi->user;
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
695
    
packaging one directory
yuki-kimoto authored on 2009-11-16
696
=head2 password
697

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

            
703
=head2 data_source
704

            
update document
yuki-kimoto authored on 2010-01-30
705
Database data source
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
706
    
version 0.0901
yuki-kimoto authored on 2009-12-17
707
    $dbi         = $dbi->data_source("dbi:mysql:dbname=$database");
708
    $data_source = $dbi->data_source;
packaging one directory
yuki-kimoto authored on 2009-11-16
709
    
version 0.0901
yuki-kimoto authored on 2009-12-17
710
If you know data source more, See also L<DBI>.
711

            
packaging one directory
yuki-kimoto authored on 2009-11-16
712
=head2 database
713

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

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

            
add port and host method
yuki-kimoto authored on 2009-11-16
719
=head2 host
720

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

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

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

            
728
=head2 port
729

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

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

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

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

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

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

            
many many changes
yuki-kimoto authored on 2010-04-30
744
SQLTemplate object
packaging one directory
yuki-kimoto authored on 2009-11-16
745

            
many many changes
yuki-kimoto authored on 2010-04-30
746
    $dbi      = $dbi->sql_tmpl(DBIx::Cutom::SQLTemplate->new);
version 0.0901
yuki-kimoto authored on 2009-12-17
747
    $sql_tmpl = $dbi->sql_tmpl;
packaging one directory
yuki-kimoto authored on 2009-11-16
748

            
many many changes
yuki-kimoto authored on 2010-04-30
749
See also L<DBIx::Custom::SQLTemplate>.
packaging one directory
yuki-kimoto authored on 2009-11-16
750

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

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
755
    $dbi     = $dbi->filters({filter1 => sub { }, filter2 => sub {}});
756
    $filters = $dbi->filters;
packaging one directory
yuki-kimoto authored on 2009-11-16
757
    
version 0.0901
yuki-kimoto authored on 2009-12-17
758
This method is generally used to get a filter.
759

            
760
    $filter = $dbi->filters->{encode_utf8};
761

            
many many changes
yuki-kimoto authored on 2010-04-30
762
If you add filter, use resist_filter method.
packaging one directory
yuki-kimoto authored on 2009-11-16
763

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

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

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

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

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

            
many many changes
yuki-kimoto authored on 2010-04-30
775
If you add format, use resist_format method.
packaging one directory
yuki-kimoto authored on 2009-11-16
776

            
rename bind_filter to query_...
yuki-kimoto authored on 2010-04-28
777
=head2 default_query_filter
packaging one directory
yuki-kimoto authored on 2009-11-16
778

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

            
rename bind_filter to query_...
yuki-kimoto authored on 2010-04-28
781
    $dbi                 = $dbi->default_query_filter($default_query_filter);
782
    $default_query_filter = $dbi->default_query_filter
packaging one directory
yuki-kimoto authored on 2009-11-16
783

            
rename query() to execute()
yuki-kimoto authored on 2010-05-01
784
The following is bind filter example
cleanup
yuki-kimoto authored on 2010-04-28
785
    
many many changes
yuki-kimoto authored on 2010-04-30
786
    $dbi->resist_filter(encode_utf8 => sub {
cleanup
yuki-kimoto authored on 2010-04-28
787
        my $value = shift;
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
788
        
cleanup
yuki-kimoto authored on 2010-04-28
789
        require Encode 'encode_utf8';
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
790
        
cleanup
yuki-kimoto authored on 2010-04-28
791
        return encode_utf8($value);
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
792
    });
cleanup
yuki-kimoto authored on 2010-04-28
793
    
rename bind_filter to query_...
yuki-kimoto authored on 2010-04-28
794
    $dbi->default_query_filter('encode_utf8')
packaging one directory
yuki-kimoto authored on 2009-11-16
795

            
version 0.0901
yuki-kimoto authored on 2009-12-17
796
Bind filter arguemts is
797

            
798
    1. $value : Value
799
    2. $key   : Key
800
    3. $dbi   : DBIx::Custom object
801
    4. $infos : {table => $table, column => $column}
802

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

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

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

            
rename query() to execute()
yuki-kimoto authored on 2010-05-01
810
The following is fetch filter example
packaging one directory
yuki-kimoto authored on 2009-11-16
811

            
many many changes
yuki-kimoto authored on 2010-04-30
812
    $dbi->resist_filter(decode_utf8 => sub {
cleanup
yuki-kimoto authored on 2010-04-28
813
        my $value = shift;
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
814
        
cleanup
yuki-kimoto authored on 2010-04-28
815
        require Encode 'decode_utf8';
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
816
        
cleanup
yuki-kimoto authored on 2010-04-28
817
        return decode_utf8($value);
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
818
    });
packaging one directory
yuki-kimoto authored on 2009-11-16
819

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
822
Bind filter arguemts is
823

            
824
    1. $value : Value
825
    2. $key   : Key
826
    3. $dbi   : DBIx::Custom object
827
    4. $infos : {type => $table, sth => $sth, index => $index}
828

            
packaging one directory
yuki-kimoto authored on 2009-11-16
829
=head2 result_class
830

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

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

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

            
packaging one directory
yuki-kimoto authored on 2009-11-16
838
=head2 dbh
839

            
update document
yuki-kimoto authored on 2010-01-30
840
Database handle
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
841
    
version 0.0901
yuki-kimoto authored on 2009-12-17
842
    $dbi = $dbi->dbh($dbh);
843
    $dbh = $dbi->dbh;
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
844
    
845
=head2 query_cache_max
846

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
849
    $class           = DBIx::Custom->query_cache_max(50);
850
    $query_cache_max = DBIx::Custom->query_cache_max;
851

            
852
Default value is 50
853

            
update document
yuki-kimoto authored on 2010-01-30
854
=head1 METHODS
855

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

            
859
=head2 connect
860

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

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

            
865
=head2 disconnect
866

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
867
Disconnect database
868

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

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

            
873
=head2 reconnect
874

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

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

            
879
=head2 connected
880

            
version 0.0901
yuki-kimoto authored on 2009-12-17
881
Check if database is connected.
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
882
    
version 0.0901
yuki-kimoto authored on 2009-12-17
883
    $is_connected = $dbi->connected;
packaging one directory
yuki-kimoto authored on 2009-11-16
884
    
many many changes
yuki-kimoto authored on 2010-04-30
885
=head2 resist_filter
packaging one directory
yuki-kimoto authored on 2009-11-16
886

            
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
887
Resist filter
packaging one directory
yuki-kimoto authored on 2009-11-16
888
    
many many changes
yuki-kimoto authored on 2010-04-30
889
    $dbi->resist_filter($fname1 => $filter1, $fname => $filter2);
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
890
    
rename query() to execute()
yuki-kimoto authored on 2010-05-01
891
The following is resist_filter example
version 0.0901
yuki-kimoto authored on 2009-12-17
892

            
many many changes
yuki-kimoto authored on 2010-04-30
893
    $dbi->resist_filter(
packaging one directory
yuki-kimoto authored on 2009-11-16
894
        encode_utf8 => sub {
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
895
            my ($value, $key, $dbi, $infos) = @_;
896
            utf8::upgrade($value) unless Encode::is_utf8($value);
897
            return encode('UTF-8', $value);
packaging one directory
yuki-kimoto authored on 2009-11-16
898
        },
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
899
        decode_utf8 => sub {
900
            my ($value, $key, $dbi, $infos) = @_;
901
            return decode('UTF-8', $value)
packaging one directory
yuki-kimoto authored on 2009-11-16
902
        }
903
    );
904

            
many many changes
yuki-kimoto authored on 2010-04-30
905
=head2 resist_format
packaging one directory
yuki-kimoto authored on 2009-11-16
906

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

            
many many changes
yuki-kimoto authored on 2010-04-30
909
    $dbi->resist_format($fname1 => $format, $fname2 => $format2);
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
910
    
rename query() to execute()
yuki-kimoto authored on 2010-05-01
911
The following is resist_format example.
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
912

            
many many changes
yuki-kimoto authored on 2010-04-30
913
    $dbi->resist_format(date => '%Y:%m:%d', datetime => '%Y-%m-%d %H:%M:%S');
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
914

            
version 0.0901
yuki-kimoto authored on 2009-12-17
915
=head2 create_query
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
916
    
version 0.0901
yuki-kimoto authored on 2009-12-17
917
Create Query object parsing SQL template
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
918

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

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

            
rename query() to execute()
yuki-kimoto authored on 2010-05-01
923
    $dbi->execute($query, $params);
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
924

            
many many changes
yuki-kimoto authored on 2010-04-30
925
If you know SQL template, see also L<DBIx::Custom::SQLTemplate>.
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
926

            
rename query() to execute()
yuki-kimoto authored on 2010-05-01
927
=head2 execute
packaging one directory
yuki-kimoto authored on 2009-11-16
928

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

            
rename query() to execute()
yuki-kimoto authored on 2010-05-01
931
    $result = $dbi->execute($template, $params);
packaging one directory
yuki-kimoto authored on 2009-11-16
932

            
rename query() to execute()
yuki-kimoto authored on 2010-05-01
933
The following is query example
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
934

            
rename query() to execute()
yuki-kimoto authored on 2010-05-01
935
    $result = $dbi->execute("select * from authors where {= name} and {= age}", 
packaging one directory
yuki-kimoto authored on 2009-11-16
936
                          {author => 'taro', age => 19});
937
    
938
    while (my @row = $result->fetch) {
939
        # do something
940
    }
941

            
many many changes
yuki-kimoto authored on 2010-04-30
942
If you now syntax of template, See also L<DBIx::Custom::SQLTemplate>
version 0.0901
yuki-kimoto authored on 2009-12-17
943

            
rename query() to execute()
yuki-kimoto authored on 2010-05-01
944
execute() return L<DBIx::Custom::Result> object
packaging one directory
yuki-kimoto authored on 2009-11-16
945

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

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

            
remove run_transaction().
yuki-kimoto authored on 2010-01-30
950
    $dbi->transaction->run(sub {
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
951
        my $dbi = shift;
952
        
packaging one directory
yuki-kimoto authored on 2009-11-16
953
        # do something
954
    });
955

            
956
If transaction is success, commit is execute. 
957
If tranzation is died, rollback is execute.
958

            
version 0.0901
yuki-kimoto authored on 2009-12-17
959
=head2 create_table
960

            
961
Create table
962

            
963
    $dbi->create_table(
964
        'books',
965
        'name char(255)',
966
        'age  int'
967
    );
968

            
969
First argument is table name. Rest arguments is column definition.
970

            
971
=head2 drop_table
972

            
973
Drop table
974

            
975
    $dbi->drop_table('books');
976

            
packaging one directory
yuki-kimoto authored on 2009-11-16
977
=head2 insert
978

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

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
984
Retrun value is affected rows count
packaging one directory
yuki-kimoto authored on 2009-11-16
985
    
rename query() to execute()
yuki-kimoto authored on 2010-05-01
986
The following is insert example.
version 0.0901
yuki-kimoto authored on 2009-12-17
987

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
990
You can add statement.
991

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

            
packaging one directory
yuki-kimoto authored on 2009-11-16
994
=head2 update
995

            
update document
yuki-kimoto authored on 2009-11-19
996
Update rows
997

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

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

            
rename query() to execute()
yuki-kimoto authored on 2010-05-01
1003
The following is update example.
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1004

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1007
You can add statement.
1008

            
1009
    $dbi->update('books', {title => 'Perl', author => 'Taro'},
1010
                 {id => 5}, "some statement");
1011

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1012
=head2 update_all
1013

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

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

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

            
rename query() to execute()
yuki-kimoto authored on 2010-05-01
1020
The following is update_all example.
update document
yuki-kimoto authored on 2009-11-19
1021

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

            
1024
=head2 delete
1025

            
update document
yuki-kimoto authored on 2009-11-19
1026
Delete rows
1027

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1031
Retrun value is affected rows count
packaging one directory
yuki-kimoto authored on 2009-11-16
1032
    
rename query() to execute()
yuki-kimoto authored on 2010-05-01
1033
The following is delete example.
version 0.0901
yuki-kimoto authored on 2009-12-17
1034

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1037
You can add statement.
1038

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

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1041
=head2 delete_all
1042

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

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

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

            
rename query() to execute()
yuki-kimoto authored on 2010-05-01
1049
The following is delete_all example.
version 0.0901
yuki-kimoto authored on 2009-12-17
1050

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

            
1053
=head2 select
1054
    
update document
yuki-kimoto authored on 2009-11-19
1055
Select rows
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1056

            
version 0.0901
yuki-kimoto authored on 2009-12-17
1057
    $resut = $dbi->select(
packaging one directory
yuki-kimoto authored on 2009-11-16
1058
        $table,                # must be string or array;
version 0.0901
yuki-kimoto authored on 2009-12-17
1059
        \@$columns,            # must be array reference. this can be ommited
1060
        \%$where_params,       # must be hash reference.  this can be ommited
1061
        $append_statement,     # must be string.          this can be ommited
1062
        $query_edit_callback   # must be code reference.  this can be ommited
packaging one directory
yuki-kimoto authored on 2009-11-16
1063
    );
update document
yuki-kimoto authored on 2009-11-19
1064

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

            
rename query() to execute()
yuki-kimoto authored on 2010-05-01
1067
The following is some select examples
update document
yuki-kimoto authored on 2009-11-19
1068

            
1069
    # select * from books;
1070
    $result = $dbi->select('books');
packaging one directory
yuki-kimoto authored on 2009-11-16
1071
    
update document
yuki-kimoto authored on 2009-11-19
1072
    # select * from books where title = 'Perl';
1073
    $result = $dbi->select('books', {title => 1});
1074
    
1075
    # select title, author from books where id = 1 for update;
1076
    $result = $dbi->select(
1077
        'books',              # table
1078
        ['title', 'author'],  # columns
1079
        {id => 1},            # where clause
1080
        'for update',         # append statement
1081
    );
1082

            
1083
You can join multi tables
1084
    
1085
    $result = $dbi->select(
1086
        ['table1', 'table2'],                # tables
1087
        ['table1.id as table1_id', 'title'], # columns (alias is ok)
1088
        {table1.id => 1},                    # where clase
1089
        "where table1.id = table2.id",       # join clause (must start 'where')
1090
    );
1091

            
1092
You can also edit query
1093
        
packaging one directory
yuki-kimoto authored on 2009-11-16
1094
    $dbi->select(
update document
yuki-kimoto authored on 2009-11-19
1095
        'books',
1096
        # column, where clause, append statement,
packaging one directory
yuki-kimoto authored on 2009-11-16
1097
        sub {
1098
            my $query = shift;
rename bind_filter to query_...
yuki-kimoto authored on 2010-04-28
1099
            $query->query_filter(sub {
packaging one directory
yuki-kimoto authored on 2009-11-16
1100
                # ...
1101
            });
1102
        }
update document
yuki-kimoto authored on 2009-11-19
1103
    }
1104

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

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

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

            
1112
    1. AutoCommit is true
1113
    2. RaiseError is true
1114

            
1115
By default, Both AutoCommit and RaiseError is true.
1116
You must not change these mode not to damage your data.
1117

            
1118
If you change these mode, 
1119
you cannot get correct error message, 
1120
or run_transaction may fail.
1121

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

            
1124
DBIx::Custom is customizable DBI.
1125
You can inherit DBIx::Custom and custumize attributes.
1126

            
1127
    package DBIx::Custom::Yours;
1128
    use base DBIx::Custom;
1129
    
1130
    my $class = __PACKAGE__;
1131
    
1132
    $class->user('your_name');
1133
    $class->password('your_password');
1134

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1135
=head1 AUTHOR
1136

            
1137
Yuki Kimoto, C<< <kimoto.yuki at gmail.com> >>
1138

            
1139
Github L<http://github.com/yuki-kimoto>
1140

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

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

            
1145
Copyright 2009 Yuki Kimoto, all rights reserved.
1146

            
1147
This program is free software; you can redistribute it and/or modify it
1148
under the same terms as Perl itself.
1149

            
1150
=cut