DBIx-Custom / lib / DBI / Custom.pm /
Newer Older
1101 lines | 28.291kb
first commit
yuki-kimoto authored on 2009-10-13
1
package DBI::Custom;
2
use Object::Simple;
add test
yuki-kimoto authored on 2009-10-16
3

            
4
our $VERSION = '0.0101';
5

            
6
use Carp 'croak';
add some method
yuki-kimoto authored on 2009-10-14
7
use DBI;
cleanup
yuki-kimoto authored on 2009-10-29
8
use DBI::Custom::Query;
add tests
yuki-kimoto authored on 2009-10-31
9
use DBI::Custom::Result;
10
use DBI::Custom::SQL::Template;
11

            
add tests
yuki-kimoto authored on 2009-10-25
12

            
13
### Class-Object Accessors
update document
yuki-kimoto authored on 2009-10-27
14
sub user        : ClassObjectAttr { initialize => {clone => 'scalar'} }
15
sub password    : ClassObjectAttr { initialize => {clone => 'scalar'} }
16
sub data_source : ClassObjectAttr { initialize => {clone => 'scalar'} }
cleanup
yuki-kimoto authored on 2009-10-29
17
sub dbi_options : ClassObjectAttr { initialize => {clone => 'hash', 
add tests
yuki-kimoto authored on 2009-10-31
18
                                                   default => sub { {} } } }
catch up Object::Simple upda...
yuki-kimoto authored on 2009-10-26
19

            
update document
yuki-kimoto authored on 2009-10-27
20
sub bind_filter  : ClassObjectAttr { initialize => {clone => 'scalar'} }
21
sub fetch_filter : ClassObjectAttr { initialize => {clone => 'scalar'} }
catch up Object::Simple upda...
yuki-kimoto authored on 2009-10-26
22

            
add no_bind_filters
yuki-kimoto authored on 2009-10-30
23
sub no_bind_filters   : ClassObjectAttr { initialize => {clone => 'array'} }
24
sub no_fetch_filters  : ClassObjectAttr { initialize => {clone => 'array'} }
add various thins
yuki-kimoto authored on 2009-10-29
25

            
catch up Object::Simple upda...
yuki-kimoto authored on 2009-10-26
26
sub filters : ClassObjectAttr {
27
    type => 'hash',
28
    deref => 1,
29
    initialize => {
add tests
yuki-kimoto authored on 2009-10-25
30
        clone   => 'hash',
31
        default => sub { {} }
catch up Object::Simple upda...
yuki-kimoto authored on 2009-10-26
32
    }
33
}
first commit
yuki-kimoto authored on 2009-10-13
34

            
add formats add_format
yuki-kimoto authored on 2009-11-06
35
sub formats : ClassObjectAttr {
36
    type => 'hash',
37
    deref => 1,
38
    initialize => {
39
        clone   => 'hash',
40
        default => sub { {} }
41
    }
42
}
43

            
catch up Object::Simple upda...
yuki-kimoto authored on 2009-10-26
44
sub result_class : ClassObjectAttr {
45
    initialize => {
add tests
yuki-kimoto authored on 2009-10-25
46
        clone   => 'scalar',
47
        default => 'DBI::Custom::Result'
catch up Object::Simple upda...
yuki-kimoto authored on 2009-10-26
48
    }
49
}
cleanup
yuki-kimoto authored on 2009-10-14
50

            
catch up Object::Simple upda...
yuki-kimoto authored on 2009-10-26
51
sub sql_template : ClassObjectAttr {
52
    initialize => {
update document
yuki-kimoto authored on 2009-10-27
53
        clone   => sub {$_[0] ? $_[0]->clone : undef},
catch up Object::Simple upda...
yuki-kimoto authored on 2009-10-26
54
        default => sub {DBI::Custom::SQL::Template->new}
55
    }
56
}
cleanup
yuki-kimoto authored on 2009-10-15
57

            
add tests
yuki-kimoto authored on 2009-10-25
58
### Object Accessor
add tests
yuki-kimoto authored on 2009-10-18
59
sub dbh          : Attr {}
add tests
yuki-kimoto authored on 2009-10-25
60

            
61

            
62
### Methods
add various thins
yuki-kimoto authored on 2009-10-29
63

            
add tests
yuki-kimoto authored on 2009-10-25
64
# Add filter
65
sub add_filter {
66
    my $invocant = shift;
67
    
68
    my %old_filters = $invocant->filters;
69
    my %new_filters = ref $_[0] eq 'HASH' ? %{$_[0]} : @_;
70
    $invocant->filters(%old_filters, %new_filters);
update document
yuki-kimoto authored on 2009-10-27
71
    return $invocant;
add tests
yuki-kimoto authored on 2009-10-25
72
}
add various
yuki-kimoto authored on 2009-10-18
73

            
add formats add_format
yuki-kimoto authored on 2009-11-06
74
# Add format
75
sub add_format{
76
    my $invocant = shift;
77
    
78
    my %old_formats = $invocant->formats;
79
    my %new_formats = ref $_[0] eq 'HASH' ? %{$_[0]} : @_;
80
    $invocant->formats(%old_formats, %new_formats);
81
    return $invocant;
82
}
83

            
add various
yuki-kimoto authored on 2009-10-18
84
# Auto commit
update document
yuki-kimoto authored on 2009-10-27
85
sub _auto_commit {
add various
yuki-kimoto authored on 2009-10-18
86
    my $self = shift;
87
    
add tests
yuki-kimoto authored on 2009-10-31
88
    croak("Not yet connect to database") unless $self->dbh;
add various
yuki-kimoto authored on 2009-10-18
89
    
90
    if (@_) {
91
        $self->dbh->{AutoCommit} = $_[0];
92
        return $self;
93
    }
94
    return $self->dbh->{AutoCommit};
95
}
add test
yuki-kimoto authored on 2009-10-16
96

            
add various things
yuki-kimoto authored on 2009-10-17
97
# Connect
add some method
yuki-kimoto authored on 2009-10-14
98
sub connect {
99
    my $self = shift;
update document
yuki-kimoto authored on 2009-10-27
100
    my $data_source = $self->data_source;
101
    my $user        = $self->user;
102
    my $password    = $self->password;
cleanup
yuki-kimoto authored on 2009-10-29
103
    my $dbi_options  = $self->dbi_options;
add test
yuki-kimoto authored on 2009-10-16
104
    
add tests
yuki-kimoto authored on 2009-10-31
105
    my $dbh = eval{DBI->connect(
update document
yuki-kimoto authored on 2009-10-27
106
        $data_source,
107
        $user,
108
        $password,
add some method
yuki-kimoto authored on 2009-10-14
109
        {
110
            RaiseError => 1,
111
            PrintError => 0,
112
            AutoCommit => 1,
cleanup
yuki-kimoto authored on 2009-10-29
113
            %{$dbi_options || {} }
add some method
yuki-kimoto authored on 2009-10-14
114
        }
add tests
yuki-kimoto authored on 2009-10-31
115
    )};
116
    
117
    croak $@ if $@;
add some method
yuki-kimoto authored on 2009-10-14
118
    
119
    $self->dbh($dbh);
add various
yuki-kimoto authored on 2009-10-18
120
    return $self;
add some method
yuki-kimoto authored on 2009-10-14
121
}
first commit
yuki-kimoto authored on 2009-10-13
122

            
add tests
yuki-kimoto authored on 2009-10-25
123
# DESTROY
add tests
yuki-kimoto authored on 2009-10-18
124
sub DESTROY {
125
    my $self = shift;
add tests
yuki-kimoto authored on 2009-10-18
126
    $self->disconnect if $self->connected;
add tests
yuki-kimoto authored on 2009-10-18
127
}
128

            
add various things
yuki-kimoto authored on 2009-10-17
129
# Is connected?
130
sub connected {
131
    my $self = shift;
cleanup
yuki-kimoto authored on 2009-10-31
132
    return ref $self->{dbh} eq 'DBI::db';
add various things
yuki-kimoto authored on 2009-10-17
133
}
134

            
135
# Disconnect
136
sub disconnect {
137
    my $self = shift;
add tests
yuki-kimoto authored on 2009-10-18
138
    if ($self->connected) {
add various things
yuki-kimoto authored on 2009-10-17
139
        $self->dbh->disconnect;
140
        delete $self->{dbh};
141
    }
142
}
143

            
144
# Reconnect
145
sub reconnect {
146
    my $self = shift;
add tests
yuki-kimoto authored on 2009-10-18
147
    $self->disconnect if $self->connected;
add various things
yuki-kimoto authored on 2009-10-17
148
    $self->connect;
149
}
150

            
cleanup
yuki-kimoto authored on 2009-10-31
151
# Prepare statement handle
add prepare
yuki-kimoto authored on 2009-10-31
152
sub prepare {
153
    my ($self, $sql) = @_;
cleanup
yuki-kimoto authored on 2009-10-31
154
    
155
    # Connect if not
add tests
yuki-kimoto authored on 2009-10-31
156
    $self->connect unless $self->connected;
add prepare
yuki-kimoto authored on 2009-10-31
157
    
cleanup
yuki-kimoto authored on 2009-10-31
158
    # Prepare
add prepare
yuki-kimoto authored on 2009-10-31
159
    my $sth = eval{$self->dbh->prepare($sql)};
add tests
yuki-kimoto authored on 2009-10-31
160
    
161
    # Error
162
    croak("$@<Your SQL>\n$sql") if $@;
163
    
add prepare
yuki-kimoto authored on 2009-10-31
164
    return $sth;
165
}
166

            
cleanup
yuki-kimoto authored on 2009-10-31
167
# Execute SQL directly
add prepare
yuki-kimoto authored on 2009-10-31
168
sub do{
169
    my ($self, $sql, @bind_values) = @_;
cleanup
yuki-kimoto authored on 2009-10-31
170
    
171
    # Connect if not
add tests
yuki-kimoto authored on 2009-10-31
172
    $self->connect unless $self->connected;
add prepare
yuki-kimoto authored on 2009-10-31
173
    
cleanup
yuki-kimoto authored on 2009-10-31
174
    # Do
add tests
yuki-kimoto authored on 2009-10-31
175
    my $ret_val = eval{$self->dbh->do($sql, @bind_values)};
176
    
177
    # Error
178
    if ($@) {
179
        my $error = $@;
180
        require Data::Dumper;
181
        
182
        my $bind_value_dump
183
          = Data::Dumper->Dump([\@bind_values], ['*bind_valuds']);
184
        
185
        croak("$error<Your SQL>\n$sql\n<Your bind values>\n$bind_value_dump\n");
186
    }
add prepare
yuki-kimoto authored on 2009-10-31
187
}
188

            
cleanup
yuki-kimoto authored on 2009-10-31
189
# Create query
add various thins
yuki-kimoto authored on 2009-10-29
190
sub create_query {
191
    my ($self, $template) = @_;
add query cache system
yuki-kimoto authored on 2009-11-02
192
    my $class = ref $self;
add test
yuki-kimoto authored on 2009-10-17
193
    
add various thins
yuki-kimoto authored on 2009-10-29
194
    # Create query from SQL template
add prepare
yuki-kimoto authored on 2009-10-31
195
    my $sql_template = $self->sql_template;
add test
yuki-kimoto authored on 2009-10-17
196
    
add query cache system
yuki-kimoto authored on 2009-11-02
197
    # Try to get cached query
198
    my $query = $class->_query_caches->{$template};
199
    
200
    # Create query
201
    unless ($query) {
202
        $query = eval{$sql_template->create_query($template)};
203
        croak($@) if $@;
204
        
205
        $query = DBI::Custom::Query->new($query);
206
        
207
        $class->_add_query_cache($template, $query);
208
    }
add various thins
yuki-kimoto authored on 2009-10-29
209
    
cleanup
yuki-kimoto authored on 2009-10-31
210
    # Connect if not
add tests
yuki-kimoto authored on 2009-10-31
211
    $self->connect unless $self->connected;
try varioud way
yuki-kimoto authored on 2009-10-17
212
    
add various thins
yuki-kimoto authored on 2009-10-29
213
    # Prepare statement handle
add tests
yuki-kimoto authored on 2009-10-31
214
    my $sth = $self->prepare($query->{sql});
add tests
yuki-kimoto authored on 2009-10-18
215
    
add no_bind_filters
yuki-kimoto authored on 2009-10-30
216
    # Set statement handle
add various thins
yuki-kimoto authored on 2009-10-29
217
    $query->sth($sth);
add tests
yuki-kimoto authored on 2009-10-18
218
    
add no_bind_filters
yuki-kimoto authored on 2009-10-30
219
    # Set bind filter
220
    $query->bind_filter($self->bind_filter);
221
    
222
    # Set no filter keys when binding
223
    $query->no_bind_filters($self->no_bind_filters);
add tests
yuki-kimoto authored on 2009-10-31
224
    
add no_bind_filters
yuki-kimoto authored on 2009-10-30
225
    # Set fetch filter
226
    $query->fetch_filter($self->fetch_filter);
227
    
228
    # Set no filter keys when fetching
229
    $query->no_fetch_filters($self->no_fetch_filters);
230
    
add various thins
yuki-kimoto authored on 2009-10-29
231
    return $query;
232
}
233

            
cleanup
yuki-kimoto authored on 2009-10-31
234
# Execute query
add various thins
yuki-kimoto authored on 2009-10-29
235
sub execute {
236
    my ($self, $query, $params)  = @_;
add tests
yuki-kimoto authored on 2009-10-29
237
    $params ||= {};
try varioud way
yuki-kimoto authored on 2009-10-17
238
    
add tests
yuki-kimoto authored on 2009-10-31
239
    # First argument is SQL template
240
    if (!ref $query) {
241
        my $template = $query;
242
        $query = $self->create_query($template);
243
        my $query_edit_cb = $_[3];
244
        $query_edit_cb->($query) if ref $query_edit_cb eq 'CODE';
245
    }
246
    
add various thins
yuki-kimoto authored on 2009-10-29
247
    # Create bind value
248
    my $bind_values = $self->_build_bind_values($query, $params);
add tests
yuki-kimoto authored on 2009-10-18
249
    
cleanup
yuki-kimoto authored on 2009-10-18
250
    # Execute
cleanup
yuki-kimoto authored on 2009-10-29
251
    my $sth = $query->sth;
add tests
yuki-kimoto authored on 2009-10-31
252
    my $ret_val = eval{$sth->execute(@$bind_values)};
cleanup
yuki-kimoto authored on 2009-10-31
253
    
254
    # Execute error
add tests
yuki-kimoto authored on 2009-10-31
255
    if (my $execute_error = $@) {
add tests
yuki-kimoto authored on 2009-10-31
256
        require Data::Dumper;
add tests
yuki-kimoto authored on 2009-11-03
257
        my $sql              = $query->{sql} || '';
258
        my $key_infos_dump   = Data::Dumper->Dump([$query->key_infos], ['*key_infos']);
259
        my $params_dump      = Data::Dumper->Dump([$params], ['*params']);
add tests
yuki-kimoto authored on 2009-10-31
260
        
add tests
yuki-kimoto authored on 2009-11-03
261
        croak("$execute_error" . 
262
              "<Your SQL>\n$sql\n" . 
263
              "<Your parameters>\n$params_dump");
add tests
yuki-kimoto authored on 2009-10-31
264
    }
add various things
yuki-kimoto authored on 2009-10-17
265
    
cleanup
yuki-kimoto authored on 2009-10-18
266
    # Return resultset if select statement is executed
add various things
yuki-kimoto authored on 2009-10-17
267
    if ($sth->{NUM_OF_FIELDS}) {
cleanup
yuki-kimoto authored on 2009-10-31
268
        
269
        # Get result class
add various things
yuki-kimoto authored on 2009-10-17
270
        my $result_class = $self->result_class;
cleanup
yuki-kimoto authored on 2009-10-31
271
        
272
        # Create result
add various
yuki-kimoto authored on 2009-10-18
273
        my $result = $result_class->new({
add no_bind_filters
yuki-kimoto authored on 2009-10-30
274
            sth              => $sth,
275
            fetch_filter     => $query->fetch_filter,
276
            no_fetch_filters => $query->no_fetch_filters
add various
yuki-kimoto authored on 2009-10-18
277
        });
add various things
yuki-kimoto authored on 2009-10-17
278
        return $result;
279
    }
add tests
yuki-kimoto authored on 2009-10-18
280
    return $ret_val;
add test
yuki-kimoto authored on 2009-10-17
281
}
282

            
cleanup
yuki-kimoto authored on 2009-10-31
283
# Build binding values
add various thins
yuki-kimoto authored on 2009-10-29
284
sub _build_bind_values {
285
    my ($self, $query, $params) = @_;
add no_bind_filters
yuki-kimoto authored on 2009-10-30
286
    my $key_infos           = $query->key_infos;
287
    my $bind_filter         = $query->bind_filter;
288
    my $no_bind_filters_map = $query->_no_bind_filters_map || {};
cleanup
yuki-kimoto authored on 2009-10-18
289
    
add various thins
yuki-kimoto authored on 2009-10-29
290
    # binding values
291
    my @bind_values;
cleanup
yuki-kimoto authored on 2009-10-18
292
    
add tests
yuki-kimoto authored on 2009-10-31
293
    # Create bind values
add tests
yuki-kimoto authored on 2009-11-03
294
    KEY_INFOS :
cleanup
yuki-kimoto authored on 2009-10-29
295
    foreach my $key_info (@$key_infos) {
cleanup
yuki-kimoto authored on 2009-10-31
296
        # Set variable
297
        my $access_keys  = $key_info->{access_keys};
cleanup
yuki-kimoto authored on 2009-10-29
298
        my $original_key = $key_info->{original_key} || '';
299
        my $table        = $key_info->{table}        || '';
300
        my $column       = $key_info->{column}       || '';
add various thins
yuki-kimoto authored on 2009-10-29
301
        
cleanup
yuki-kimoto authored on 2009-10-31
302
        # Key is found?
add tests
yuki-kimoto authored on 2009-10-31
303
        my $found;
cleanup
yuki-kimoto authored on 2009-10-31
304
        
305
        # Build bind values
add various thins
yuki-kimoto authored on 2009-10-29
306
        ACCESS_KEYS :
307
        foreach my $access_key (@$access_keys) {
cleanup
yuki-kimoto authored on 2009-10-31
308
            # Root parameter
add various thins
yuki-kimoto authored on 2009-10-29
309
            my $root_params = $params;
cleanup
yuki-kimoto authored on 2009-10-31
310
            
311
            # Search corresponding value
add various thins
yuki-kimoto authored on 2009-10-29
312
            for (my $i = 0; $i < @$access_key; $i++) {
cleanup
yuki-kimoto authored on 2009-10-31
313
                # Current key
314
                my $current_key = $access_key->[$i];
add various thins
yuki-kimoto authored on 2009-10-29
315
                
cleanup
yuki-kimoto authored on 2009-10-31
316
                # Last key
add various thins
yuki-kimoto authored on 2009-10-29
317
                if ($i == @$access_key - 1) {
cleanup
yuki-kimoto authored on 2009-10-31
318
                    # Key is array reference
319
                    if (ref $current_key eq 'ARRAY') {
320
                        # Filtering 
321
                        if ($bind_filter &&
322
                            !$no_bind_filters_map->{$original_key})
323
                        {
add no_bind_filters
yuki-kimoto authored on 2009-10-30
324
                            push @bind_values, 
cleanup
yuki-kimoto authored on 2009-10-31
325
                                 $bind_filter->($original_key, 
326
                                                $root_params->[$current_key->[0]],
cleanup
yuki-kimoto authored on 2009-10-30
327
                                                $table, $column);
add various thins
yuki-kimoto authored on 2009-10-29
328
                        }
cleanup
yuki-kimoto authored on 2009-10-31
329
                        # Not filtering
add various thins
yuki-kimoto authored on 2009-10-29
330
                        else {
cleanup
yuki-kimoto authored on 2009-10-31
331
                            push @bind_values,
332
                                 scalar $root_params->[$current_key->[0]];
add various thins
yuki-kimoto authored on 2009-10-29
333
                        }
334
                    }
cleanup
yuki-kimoto authored on 2009-10-31
335
                    # Key is string
add various thins
yuki-kimoto authored on 2009-10-29
336
                    else {
cleanup
yuki-kimoto authored on 2009-10-31
337
                        # Key is not found
338
                        next ACCESS_KEYS
339
                          unless exists $root_params->{$current_key};
340
                        
341
                        # Filtering
342
                        if ($bind_filter &&
343
                            !$no_bind_filters_map->{$original_key}) 
344
                        {
add no_bind_filters
yuki-kimoto authored on 2009-10-30
345
                            push @bind_values,
cleanup
yuki-kimoto authored on 2009-10-31
346
                                 $bind_filter->($original_key,
347
                                                $root_params->{$current_key}, 
cleanup
yuki-kimoto authored on 2009-10-30
348
                                                $table, $column);
add various thins
yuki-kimoto authored on 2009-10-29
349
                        }
cleanup
yuki-kimoto authored on 2009-10-31
350
                        # Not filtering
add various thins
yuki-kimoto authored on 2009-10-29
351
                        else {
cleanup
yuki-kimoto authored on 2009-10-31
352
                            push @bind_values,
353
                                 scalar $root_params->{$current_key};
add various thins
yuki-kimoto authored on 2009-10-29
354
                        }
355
                    }
cleanup
yuki-kimoto authored on 2009-10-31
356
                    
357
                    # Key is found
add tests
yuki-kimoto authored on 2009-10-31
358
                    $found = 1;
add tests
yuki-kimoto authored on 2009-11-03
359
                    next KEY_INFOS;
add various thins
yuki-kimoto authored on 2009-10-29
360
                }
cleanup
yuki-kimoto authored on 2009-10-31
361
                # First or middle key
add various thins
yuki-kimoto authored on 2009-10-29
362
                else {
cleanup
yuki-kimoto authored on 2009-10-31
363
                    # Key is array reference
364
                    if (ref $current_key eq 'ARRAY') {
365
                        # Go next key
366
                        $root_params = $root_params->[$current_key->[0]];
367
                    }
368
                    # Key is string
369
                    else {
370
                        # Not found
371
                        next ACCESS_KEYS
372
                          unless exists $root_params->{$current_key};
373
                        
374
                        # Go next key
375
                        $root_params = $root_params->{$current_key};
376
                    }
add various thins
yuki-kimoto authored on 2009-10-29
377
                }
378
            }
379
        }
add tests
yuki-kimoto authored on 2009-10-31
380
        
cleanup
yuki-kimoto authored on 2009-10-31
381
        # Key is not found
add tests
yuki-kimoto authored on 2009-10-31
382
        unless ($found) {
383
            require Data::Dumper;
add tests
yuki-kimoto authored on 2009-10-31
384
            my $key_info_dump  = Data::Dumper->Dump([$key_info], ['*key_info']);
add tests
yuki-kimoto authored on 2009-10-31
385
            my $params_dump    = Data::Dumper->Dump([$params], ['*params']);
add tests
yuki-kimoto authored on 2009-10-31
386
            croak("Corresponding key is not found in your parameters\n" . 
add tests
yuki-kimoto authored on 2009-10-31
387
                  "<Key information>\n$key_info_dump\n\n" .
388
                  "<Your parameters>\n$params_dump\n");
389
        }
update document
yuki-kimoto authored on 2009-10-27
390
    }
add tests
yuki-kimoto authored on 2009-10-31
391
    return \@bind_values;
add test
yuki-kimoto authored on 2009-10-17
392
}
393

            
add tests
yuki-kimoto authored on 2009-10-31
394
# Run tranzaction
395
sub run_tranzaction {
396
    my ($self, $tranzaction) = @_;
397
    
398
    # Check auto commit
399
    croak("AutoCommit must be true before tranzaction start")
400
      unless $self->_auto_commit;
401
    
402
    # Auto commit off
403
    $self->_auto_commit(0);
404
    
405
    # Run tranzaction
406
    eval {$tranzaction->()};
407
    
408
    # Tranzaction error
409
    my $tranzaction_error = $@;
410
    
411
    # Tranzaction is failed.
412
    if ($tranzaction_error) {
413
        # Rollback
414
        eval{$self->dbh->rollback};
415
        
416
        # Rollback error
417
        my $rollback_error = $@;
418
        
419
        # Auto commit on
420
        $self->_auto_commit(1);
421
        
422
        if ($rollback_error) {
423
            # Rollback is failed
424
            croak("${tranzaction_error}Rollback is failed : $rollback_error");
425
        }
426
        else {
427
            # Rollback is success
428
            croak("${tranzaction_error}Rollback is success");
429
        }
430
    }
431
    # Tranzaction is success
432
    else {
433
        # Commit
434
        eval{$self->dbh->commit};
435
        my $commit_error = $@;
436
        
437
        # Auto commit on
438
        $self->_auto_commit(1);
439
        
440
        # Commit is failed
441
        croak($commit_error) if $commit_error;
442
    }
443
}
add various thins
yuki-kimoto authored on 2009-10-29
444

            
add methods
yuki-kimoto authored on 2009-11-02
445
# Get last insert id
446
sub last_insert_id {
447
    my $self = shift;
448
    
449
    # Not connected
450
    croak("Not yet connect to database")
451
      unless $self->connected;
452
    
453
    return $self->dbh->last_insert_id(@_);
454
}
455

            
456
# Insert
457
sub insert {
add tests
yuki-kimoto authored on 2009-11-02
458
    my ($self, $table, $insert_params, $query_edit_cb) = @_;
add tests
yuki-kimoto authored on 2009-11-03
459
    $table         ||= '';
add methods
yuki-kimoto authored on 2009-11-02
460
    $insert_params ||= {};
461
    
462
    # Insert keys
463
    my @insert_keys = keys %$insert_params;
464
    
465
    # Not exists insert keys
add tests
yuki-kimoto authored on 2009-11-03
466
    croak("Key-value pairs for insert must be specified to 'insert' second argument")
add methods
yuki-kimoto authored on 2009-11-02
467
      unless @insert_keys;
468
    
469
    # Templte for insert
470
    my $template = "insert into $table {insert " . join(' ', @insert_keys) . '}';
471
    
472
    # Create query
473
    my $query = $self->create_query($template);
474
    
add tests
yuki-kimoto authored on 2009-11-02
475
    # Query edit callback must be code reference
476
    croak("Query edit callback must be code reference")
477
      if $query_edit_cb && ref $query_edit_cb ne 'CODE';
add methods
yuki-kimoto authored on 2009-11-02
478
    
add tests
yuki-kimoto authored on 2009-11-02
479
    # Query edit if need
480
    $query_edit_cb->($query) if $query_edit_cb;
add methods
yuki-kimoto authored on 2009-11-02
481
    
482
    # Execute query
483
    my $ret_val = $self->execute($query, $insert_params);
484
    
485
    return $ret_val;
486
}
487

            
add tests
yuki-kimoto authored on 2009-11-03
488
# Update
add methods
yuki-kimoto authored on 2009-11-02
489
sub update {
490
    my ($self, $table, $update_params,
add tests
yuki-kimoto authored on 2009-11-02
491
        $where_params, $query_edit_cb, $options) = @_;
add methods
yuki-kimoto authored on 2009-11-02
492
    
add tests
yuki-kimoto authored on 2009-11-03
493
    $table         ||= '';
add methods
yuki-kimoto authored on 2009-11-02
494
    $update_params ||= {};
495
    $where_params  ||= {};
496
    
497
    # Update keys
add tests
yuki-kimoto authored on 2009-11-03
498
    my @update_keys = keys %$update_params;
add methods
yuki-kimoto authored on 2009-11-02
499
    
500
    # Not exists update kyes
add tests
yuki-kimoto authored on 2009-11-03
501
    croak("Key-value pairs for update must be specified to 'update' second argument")
add methods
yuki-kimoto authored on 2009-11-02
502
      unless @update_keys;
503
    
504
    # Where keys
505
    my @where_keys = keys %$where_params;
506
    
507
    # Not exists where keys
add tests
yuki-kimoto authored on 2009-11-03
508
    croak("Key-value pairs for where clause must be specified to 'update' third argument")
add methods
yuki-kimoto authored on 2009-11-02
509
      if !@where_keys && !$options->{allow_update_all};
510
    
511
    # Update clause
512
    my $update_clause = '{update ' . join(' ', @update_keys) . '}';
513
    
514
    # Where clause
add tests
yuki-kimoto authored on 2009-11-03
515
    my $where_clause = '';
516
    if (@where_keys) {
517
        $where_clause = 'where ';
518
        foreach my $where_key (@where_keys) {
add tests
yuki-kimoto authored on 2009-11-05
519
            $where_clause .= "{= $where_key} and ";
add tests
yuki-kimoto authored on 2009-11-03
520
        }
add tests
yuki-kimoto authored on 2009-11-05
521
        $where_clause =~ s/ and $//;
add methods
yuki-kimoto authored on 2009-11-02
522
    }
523
    
524
    # Template for update
525
    my $template = "update $table $update_clause $where_clause";
526
    
527
    # Create query
528
    my $query = $self->create_query($template);
529
    
add tests
yuki-kimoto authored on 2009-11-02
530
    # Query edit callback must be code reference
531
    croak("Query edit callback must be code reference")
532
      if $query_edit_cb && ref $query_edit_cb ne 'CODE';
add methods
yuki-kimoto authored on 2009-11-02
533
    
add tests
yuki-kimoto authored on 2009-11-02
534
    # Query edit if need
535
    $query_edit_cb->($query) if $query_edit_cb;
add methods
yuki-kimoto authored on 2009-11-02
536
    
537
    # Rearrange parammeters
538
    my $params = {'#update' => $update_params, %$where_params};
539
    
540
    # Execute query
541
    my $ret_val = $self->execute($query, $params);
542
    
543
    return $ret_val;
544
}
545

            
546
# Update all rows
547
sub update_all {
add tests
yuki-kimoto authored on 2009-11-02
548
    my ($self, $table, $update_params, $query_edit_cb) = @_;
add methods
yuki-kimoto authored on 2009-11-02
549
    
add tests
yuki-kimoto authored on 2009-11-02
550
    return $self->update($table, $update_params, {}, $query_edit_cb,
add methods
yuki-kimoto authored on 2009-11-02
551
                         {allow_update_all => 1});
552
}
553

            
554
# Delete
555
sub delete {
add tests
yuki-kimoto authored on 2009-11-02
556
    my ($self, $table, $where_params, $query_edit_cb, $options) = @_;
add tests
yuki-kimoto authored on 2009-11-03
557
    $table        ||= '';
add methods
yuki-kimoto authored on 2009-11-02
558
    $where_params ||= {};
559
    
560
    # Where keys
561
    my @where_keys = keys %$where_params;
562
    
563
    # Not exists where keys
add tests
yuki-kimoto authored on 2009-11-03
564
    croak("Key-value pairs for where clause must be specified to 'delete' second argument")
565
      if !@where_keys && !$options->{allow_delete_all};
add methods
yuki-kimoto authored on 2009-11-02
566
    
567
    # Where clause
add tests
yuki-kimoto authored on 2009-11-03
568
    my $where_clause = '';
569
    if (@where_keys) {
570
        $where_clause = 'where ';
571
        foreach my $where_key (@where_keys) {
add tests
yuki-kimoto authored on 2009-11-05
572
            $where_clause .= "{= $where_key} and ";
add tests
yuki-kimoto authored on 2009-11-03
573
        }
add tests
yuki-kimoto authored on 2009-11-05
574
        $where_clause =~ s/ and $//;
add methods
yuki-kimoto authored on 2009-11-02
575
    }
576
    
577
    # Template for delete
578
    my $template = "delete from $table $where_clause";
579
    
580
    # Create query
581
    my $query = $self->create_query($template);
582
    
add tests
yuki-kimoto authored on 2009-11-02
583
    # Query edit callback must be code reference
584
    croak("Query edit callback must be code reference")
585
      if $query_edit_cb && ref $query_edit_cb ne 'CODE';
add methods
yuki-kimoto authored on 2009-11-02
586
    
add tests
yuki-kimoto authored on 2009-11-02
587
    # Query edit if need
588
    $query_edit_cb->($query) if $query_edit_cb;
add methods
yuki-kimoto authored on 2009-11-02
589
    
590
    # Execute query
591
    my $ret_val = $self->execute($query, $where_params);
592
    
593
    return $ret_val;
594
}
595

            
596
# Delete all rows
597
sub delete_all {
add tests
yuki-kimoto authored on 2009-11-03
598
    my ($self, $table) = @_;
599
    return $self->delete($table, {}, undef, {allow_delete_all => 1});
add methods
yuki-kimoto authored on 2009-11-02
600
}
601

            
add select
yuki-kimoto authored on 2009-11-05
602
sub _select_usage { return << 'EOS' }
add select
yuki-kimoto authored on 2009-11-05
603
Your select arguments is wrong.
604
select usage:
add select
yuki-kimoto authored on 2009-11-05
605
$dbi->select(
add select
yuki-kimoto authored on 2009-11-05
606
    $table,                # must be string or array ref
add select
yuki-kimoto authored on 2009-11-05
607
    [@$columns],           # must be array reference. this is optional
608
    {%$where_params},      # must be hash reference.  this is optional
609
    $append_statement,     # must be string.          this is optional
610
    $query_edit_callback   # must be code reference.  this is optional
611
);
612
EOS
613

            
614
sub select {
615
    my $self = shift;
616
    
617
    # Check argument
618
    croak($self->_select_usage) unless @_;
619
    
620
    # Arguments
621
    my $tables = shift || '';
622
    $tables    = [$tables] unless ref $tables;
623
    
624
    my $columns          = ref $_[0] eq 'ARRAY' ? shift : [];
625
    my $where_params     = ref $_[0] eq 'HASH'  ? shift : {};
add tests
yuki-kimoto authored on 2009-11-05
626
    my $append_statement = $_[0] && !ref $_[0]  ? shift : '';
add select
yuki-kimoto authored on 2009-11-05
627
    my $query_edit_cb    = shift if ref $_[0] eq 'CODE';
628
    
629
    # Check rest argument
add tests
yuki-kimoto authored on 2009-11-05
630
    croak($self->_select_usage) if @_;
add select
yuki-kimoto authored on 2009-11-05
631
    
632
    # SQL template for select statement
633
    my $template = 'select ';
634
    
635
    # Join column clause
636
    if (@$columns) {
637
        foreach my $column (@$columns) {
638
            $template .= "$column, ";
639
        }
add tests
yuki-kimoto authored on 2009-11-05
640
        $template =~ s/, $/ /;
add select
yuki-kimoto authored on 2009-11-05
641
    }
642
    else {
643
        $template .= '* ';
644
    }
645
    
646
    # Join table
add tests
yuki-kimoto authored on 2009-11-05
647
    $template .= 'from ';
add select
yuki-kimoto authored on 2009-11-05
648
    foreach my $table (@$tables) {
649
        $template .= "$table, ";
650
    }
add tests
yuki-kimoto authored on 2009-11-05
651
    $template =~ s/, $/ /;
add select
yuki-kimoto authored on 2009-11-05
652
    
653
    # Where clause keys
654
    my @where_keys = keys %$where_params;
655
    
656
    # Join where clause
657
    if (@where_keys) {
658
        $template .= 'where ';
659
        foreach my $where_key (@where_keys) {
add tests
yuki-kimoto authored on 2009-11-05
660
            $template .= "{= $where_key} and ";
add select
yuki-kimoto authored on 2009-11-05
661
        }
662
    }
add tests
yuki-kimoto authored on 2009-11-05
663
    $template =~ s/ and $//;
add select
yuki-kimoto authored on 2009-11-05
664
    
665
    # Append something to last of statement
666
    if ($append_statement =~ s/^where //) {
667
        if (@where_keys) {
add tests
yuki-kimoto authored on 2009-11-05
668
            $template .= " and $append_statement";
add select
yuki-kimoto authored on 2009-11-05
669
        }
670
        else {
671
            $template .= " where $append_statement";
672
        }
673
    }
674
    else {
675
        $template .= " $append_statement";
676
    }
677
    
678
    # Create query
679
    my $query = $self->create_query($template);
680
    
681
    # Query edit
682
    $query_edit_cb->($query) if $query_edit_cb;
683
    
684
    # Execute query
685
    my $result = $self->execute($query, $where_params);
686
    
687
    return $result;
688
}
689

            
add query cache system
yuki-kimoto authored on 2009-11-02
690
sub _query_caches     : ClassAttr { type => 'hash',
691
                                    auto_build => sub {shift->_query_caches({}) } }
692
                                    
693
sub _query_cache_keys : ClassAttr { type => 'array',
694
                                    auto_build => sub {shift->_query_cache_keys([])} }
695
                                    
696
sub query_cache_max   : ClassAttr { auto_build => sub {shift->query_cache_max(50)} }
697

            
698
# Add query cahce
699
sub _add_query_cache {
700
    my ($class, $template, $query) = @_;
701
    my $query_cache_keys = $class->_query_cache_keys;
702
    my $query_caches     = $class->_query_caches;
703
    
704
    return $class if $query_caches->{$template};
705
    
706
    $query_caches->{$template} = $query;
707
    push @$query_cache_keys, $template;
708
    
709
    my $overflow = @$query_cache_keys - $class->query_cache_max;
710
    
711
    for (my $i = 0; $i < $overflow; $i++) {
712
        my $template = shift @$query_cache_keys;
713
        delete $query_caches->{$template};
714
    }
715
    
716
    return $class;
717
}
add methods
yuki-kimoto authored on 2009-11-02
718

            
add test
yuki-kimoto authored on 2009-10-17
719
Object::Simple->build_class;
720

            
first commit
yuki-kimoto authored on 2009-10-13
721
=head1 NAME
722

            
add test
yuki-kimoto authored on 2009-10-17
723
DBI::Custom - Customizable simple DBI
first commit
yuki-kimoto authored on 2009-10-13
724

            
725
=head1 VERSION
726

            
add test
yuki-kimoto authored on 2009-10-16
727
Version 0.0101
first commit
yuki-kimoto authored on 2009-10-13
728

            
cleanup
yuki-kimoto authored on 2009-10-31
729
=head1 CAUTION
730

            
731
This module is now experimental stage.
732

            
733
I want you to try this module
734
because I want this module stable, and not to damage your DB data by this module bug.
735

            
736
Please tell me bug if you find
first commit
yuki-kimoto authored on 2009-10-13
737

            
738
=head1 SYNOPSIS
739

            
add test
yuki-kimoto authored on 2009-10-16
740
  my $dbi = DBI::Custom->new;
add various thins
yuki-kimoto authored on 2009-10-29
741
  
742
  my $query = $dbi->create_query($template);
743
  $dbi->execute($query);
first commit
yuki-kimoto authored on 2009-10-13
744

            
update document
yuki-kimoto authored on 2009-10-27
745
=head1 CLASS-OBJECT ACCESSORS
first commit
yuki-kimoto authored on 2009-10-13
746

            
update document
yuki-kimoto authored on 2009-10-27
747
=head2 user
748

            
749
    # Set and get database user name
750
    $self = $dbi->user($user);
751
    $user = $dbi->user;
752
    
753
    # Sample
754
    $dbi->user('taro');
755

            
756
=head2 password
757

            
758
    # Set and get database password
759
    $self     = $dbi->password($password);
760
    $password = $dbi->password;
761
    
762
    # Sample
763
    $dbi->password('lkj&le`@s');
764

            
765
=head2 data_source
766

            
767
    # Set and get database data source
768
    $self        = $dbi->data_source($data_soruce);
769
    $data_source = $dbi->data_source;
770
    
771
    # Sample(SQLite)
772
    $dbi->data_source(dbi:SQLite:dbname=$database);
773
    
774
    # Sample(MySQL);
775
    $dbi->data_source("dbi:mysql:dbname=$database");
776
    
777
    # Sample(PostgreSQL)
778
    $dbi->data_source("dbi:Pg:dbname=$database");
cleanup
yuki-kimoto authored on 2009-10-29
779
    
780
=head2 database
781

            
782
    # Set and get database name
783
    $self     = $dbi->database($database);
784
    $database = $dbi->database;
update document
yuki-kimoto authored on 2009-10-27
785

            
cleanup
yuki-kimoto authored on 2009-10-29
786
=head2 dbi_options
update document
yuki-kimoto authored on 2009-10-27
787

            
788
    # Set and get DBI option
cleanup
yuki-kimoto authored on 2009-10-29
789
    $self       = $dbi->dbi_options({$options => $value, ...});
790
    $dbi_options = $dbi->dbi_options;
update document
yuki-kimoto authored on 2009-10-27
791

            
792
    # Sample
cleanup
yuki-kimoto authored on 2009-10-29
793
    $dbi->dbi_options({PrintError => 0, RaiseError => 1});
update document
yuki-kimoto authored on 2009-10-27
794

            
cleanup
yuki-kimoto authored on 2009-10-29
795
dbi_options is used when you connect database by using connect.
update document
yuki-kimoto authored on 2009-10-27
796

            
add prepare
yuki-kimoto authored on 2009-10-31
797
=head2 prepare
798

            
799
    $sth = $dbi->prepare($sql);
800

            
801
This method is same as DBI::prepare
802

            
803
=head2 do
804

            
805
    $dbi->do($sql, @bind_values);
806

            
807
This method is same as DBI::do
808

            
update document
yuki-kimoto authored on 2009-10-27
809
=head2 sql_template
810

            
811
    # Set and get SQL::Template object
812
    $self         = $dbi->sql_template($sql_template);
813
    $sql_template = $dbi->sql_template;
814
    
815
    # Sample
816
    $dbi->sql_template(DBI::Cutom::SQL::Template->new);
817

            
818
=head2 filters
819

            
820
    # Set and get filters
821
    $self    = $dbi->filters($filters);
822
    $filters = $dbi->filters;
first commit
yuki-kimoto authored on 2009-10-13
823

            
add formats add_format
yuki-kimoto authored on 2009-11-06
824
=head2 formats
825

            
826
    # Set and get formats
827
    $self    = $dbi->formats($formats);
828
    $formats = $dbi->formats;
829
    
add test
yuki-kimoto authored on 2009-10-16
830
=head2 bind_filter
first commit
yuki-kimoto authored on 2009-10-13
831

            
update document
yuki-kimoto authored on 2009-10-27
832
    # Set and get binding filter
833
    $self        = $dbi->bind_filter($bind_filter);
834
    $bind_filter = $dbi->bind_filter
first commit
yuki-kimoto authored on 2009-10-13
835

            
update document
yuki-kimoto authored on 2009-10-27
836
    # Sample
837
    $dbi->bind_filter($self->filters->{default_bind_filter});
838
    
first commit
yuki-kimoto authored on 2009-10-13
839

            
update document
yuki-kimoto authored on 2009-10-27
840
you can get DBI database handle if you need.
first commit
yuki-kimoto authored on 2009-10-13
841

            
add test
yuki-kimoto authored on 2009-10-16
842
=head2 fetch_filter
first commit
yuki-kimoto authored on 2009-10-13
843

            
update document
yuki-kimoto authored on 2009-10-27
844
    # Set and get Fetch filter
845
    $self         = $dbi->fetch_filter($fetch_filter);
846
    $fetch_filter = $dbi->fetch_filter;
first commit
yuki-kimoto authored on 2009-10-13
847

            
update document
yuki-kimoto authored on 2009-10-27
848
    # Sample
849
    $dbi->fetch_filter($self->filters->{default_fetch_filter});
add test
yuki-kimoto authored on 2009-10-16
850

            
add no_bind_filters
yuki-kimoto authored on 2009-10-30
851
=head2 no_bind_filters
852

            
853
    # Set and get no filter keys when binding
854
    $self            = $dbi->no_bind_filters($no_bind_filters);
855
    $no_bind_filters = $dbi->no_bind_filters;
856

            
857
=head2 no_fetch_filters
cleanup
yuki-kimoto authored on 2009-10-29
858

            
add no_bind_filters
yuki-kimoto authored on 2009-10-30
859
    # Set and get no filter keys when fetching
860
    $self             = $dbi->no_fetch_filters($no_fetch_filters);
861
    $no_fetch_filters = $dbi->no_fetch_filters;
cleanup
yuki-kimoto authored on 2009-10-29
862

            
update document
yuki-kimoto authored on 2009-10-27
863
=head2 result_class
first commit
yuki-kimoto authored on 2009-10-13
864

            
update document
yuki-kimoto authored on 2009-10-27
865
    # Set and get resultset class
866
    $self         = $dbi->result_class($result_class);
867
    $result_class = $dbi->result_class;
868
    
869
    # Sample
870
    $dbi->result_class('DBI::Custom::Result');
add test
yuki-kimoto authored on 2009-10-17
871

            
update document
yuki-kimoto authored on 2009-10-27
872
=head2 dbh
add test
yuki-kimoto authored on 2009-10-17
873

            
update document
yuki-kimoto authored on 2009-10-27
874
    # Get database handle
875
    $dbh = $self->dbh;
add test
yuki-kimoto authored on 2009-10-17
876

            
update document
yuki-kimoto authored on 2009-10-27
877
=head1 METHODS
add tests
yuki-kimoto authored on 2009-10-18
878

            
update document
yuki-kimoto authored on 2009-10-27
879
=head2 connect
880

            
881
    # Connect to database
882
    $self = $dbi->connect;
883
    
884
    # Sample
885
    $dbi = DBI::Custom->new(user => 'taro', password => 'lji8(', 
886
                            data_soruce => "dbi:mysql:dbname=$database");
887
    $dbi->connect;
add tests
yuki-kimoto authored on 2009-10-18
888

            
889
=head2 disconnect
890

            
update document
yuki-kimoto authored on 2009-10-27
891
    # Disconnect database
892
    $dbi->disconnect;
893

            
894
If database is already disconnected, this method do noting.
895

            
add tests
yuki-kimoto authored on 2009-10-18
896
=head2 reconnect
897

            
update document
yuki-kimoto authored on 2009-10-27
898
    # Reconnect
899
    $dbi->reconnect;
900

            
901
=head2 connected
902

            
903
    # Check connected
904
    $dbi->connected
905

            
906
=head2 add_filter
907

            
908
    # Add filter (hash ref or hash can be recieve)
909
    $self = $dbi->add_filter({$filter_name => $filter, ...});
910
    $self = $dbi->add_filter($filetr_name => $filter, ...);
911
    
912
    # Sample
913
    $dbi->add_filter(
914
        decode_utf8 => sub {
cleanup
yuki-kimoto authored on 2009-10-30
915
            my ($key, $value, $table, $column) = @_;
update document
yuki-kimoto authored on 2009-10-27
916
            return Encode::decode('UTF-8', $value);
917
        },
918
        datetime_to_string => sub {
cleanup
yuki-kimoto authored on 2009-10-30
919
            my ($key, $value, $table, $column) = @_;
update document
yuki-kimoto authored on 2009-10-27
920
            return $value->strftime('%Y-%m-%d %H:%M:%S')
921
        },
922
        default_bind_filter => sub {
cleanup
yuki-kimoto authored on 2009-10-30
923
            my ($key, $value, $table, $column) = @_;
update document
yuki-kimoto authored on 2009-10-27
924
            if (ref $value eq 'Time::Piece') {
cleanup
yuki-kimoto authored on 2009-10-30
925
                return $dbi->filters->{datetime_to_string}->($value);
update document
yuki-kimoto authored on 2009-10-27
926
            }
927
            else {
cleanup
yuki-kimoto authored on 2009-10-30
928
                return $dbi->filters->{decode_utf8}->($value);
update document
yuki-kimoto authored on 2009-10-27
929
            }
930
        },
931
        
932
        encode_utf8 => sub {
cleanup
yuki-kimoto authored on 2009-10-30
933
            my ($key, $value) = @_;
update document
yuki-kimoto authored on 2009-10-27
934
            return Encode::encode('UTF-8', $value);
935
        },
936
        string_to_datetime => sub {
cleanup
yuki-kimoto authored on 2009-10-30
937
            my ($key, $value) = @_;
update document
yuki-kimoto authored on 2009-10-27
938
            return DateTime::Format::MySQL->parse_datetime($value);
939
        },
940
        default_fetch_filter => sub {
cleanup
yuki-kimoto authored on 2009-10-30
941
            my ($key, $value, $type, $sth, $i) = @_;
update document
yuki-kimoto authored on 2009-10-27
942
            if ($type eq 'DATETIME') {
cleanup
yuki-kimoto authored on 2009-10-30
943
                return $dbi->filters->{string_to_datetime}->($value);
update document
yuki-kimoto authored on 2009-10-27
944
            }
945
            else {
cleanup
yuki-kimoto authored on 2009-10-30
946
                return $dbi->filters->{encode_utf8}->($value);
update document
yuki-kimoto authored on 2009-10-27
947
            }
948
        }
949
    );
950

            
951
add_filter add filter to filters
add tests
yuki-kimoto authored on 2009-10-18
952

            
add formats add_format
yuki-kimoto authored on 2009-11-06
953
=head2 add_format
954

            
955
    $dbi->add_format(date => '%Y:%m:%d');
956

            
cleanup
yuki-kimoto authored on 2009-10-29
957
=head2 create_query
958
    
959
    # Create Query object from SQL template
960
    my $query = $dbi->create_query($template);
961
    
962
=head2 execute
update document
yuki-kimoto authored on 2009-10-27
963

            
964
    # Parse SQL template and execute SQL
cleanup
yuki-kimoto authored on 2009-10-29
965
    $result = $dbi->query($query, $params);
966
    $result = $dbi->query($template, $params); # Shorcut
update document
yuki-kimoto authored on 2009-10-27
967
    
968
    # Sample
add tests
yuki-kimoto authored on 2009-11-05
969
    $result = $dbi->query("select * from authors where {= name} and {= age}", 
update document
yuki-kimoto authored on 2009-10-27
970
                          {author => 'taro', age => 19});
971
    
972
    while (my @row = $result->fetch) {
973
        # do something
974
    }
975

            
976
See also L<DBI::Custom::SQL::Template>
977

            
cleanup
yuki-kimoto authored on 2009-10-22
978
=head2 run_tranzaction
first commit
yuki-kimoto authored on 2009-10-13
979

            
update document
yuki-kimoto authored on 2009-10-27
980
    # Run tranzaction
981
    $dbi->run_tranzaction(sub {
982
        # do something
983
    });
first commit
yuki-kimoto authored on 2009-10-13
984

            
update document
yuki-kimoto authored on 2009-10-27
985
If tranzaction is success, commit is execute. 
986
If tranzation is died, rollback is execute.
first commit
yuki-kimoto authored on 2009-10-13
987

            
add methods
yuki-kimoto authored on 2009-11-02
988
=head2 insert
989

            
990
    # Insert
991
    $dbi->insert($table, $insert_values);
992
    
993
    # Sample
994
    $dbi->insert('books', {title => 'Perl', author => 'Taro'});
995

            
996
=head2 update
997

            
998
    # Update
999
    $dbi->update($table, $update_values, $where);
1000
    
1001
    # Sample
1002
    $dbi->update('books', {title => 'Perl', author => 'Taro'}, {id => 5});
1003

            
1004
=head2 update_all
1005

            
1006
    # Update all rows
1007
    $dbi->update($table, $updat_values);
1008

            
1009
=head2 delete
1010

            
1011
    # Delete
1012
    $dbi->delete($table, $where);
1013
    
1014
    # Sample
1015
    $dbi->delete('Books', {id => 5});
1016

            
1017
=head2 delete_all
1018

            
1019
    # Delete all rows
1020
    $dbi->delete_all($table);
1021

            
1022
=head2 last_insert_id
1023

            
1024
    # Get last insert id
1025
    $last_insert_id = $dbi->last_insert_id;
1026
    
1027
This method is same as DBI last_insert_id;
1028

            
add select
yuki-kimoto authored on 2009-11-05
1029
=head2 select
1030
    
1031
    # Select
1032
    $dbi->select(
1033
        $table,                # must be string or array;
1034
        [@$columns],           # must be array reference. this is optional
1035
        {%$where_params},      # must be hash reference.  this is optional
1036
        $append_statement,     # must be string.          this is optional
1037
        $query_edit_callback   # must be code reference.  this is optional
1038
    );
1039
    
1040
    # Sample
1041
    $dbi->select(
1042
        'Books',
1043
        ['title', 'author'],
1044
        {id => 1},
1045
        "for update",
1046
        sub {
1047
            my $query = shift;
1048
            $query->bind_filter(sub {
1049
                # ...
1050
            });
1051
        }
1052
    );
1053
    
1054
    # The way to join multi tables
1055
    $dbi->select(
1056
        ['table1', 'table2'],
1057
        ['table1.id as table1_id', 'title'],
1058
        {table1.id => 1},
1059
        "where table1.id = table2.id",
1060
    );
1061

            
add query cache system
yuki-kimoto authored on 2009-11-02
1062
=head1 Class Accessors
1063

            
1064
=head2 query_cache_max
1065

            
1066
    # Max query cache count
1067
    $class           = $class->query_cache_max($query_cache_max);
1068
    $query_cache_max = $class->query_cache_max;
1069
    
1070
    # Sample
1071
    DBI::Custom->query_cache_max(50);
1072

            
add tests
yuki-kimoto authored on 2009-10-31
1073
=head1 CAUTION
1074

            
1075
DBI::Custom have DIB object internal.
1076
This module is work well in the following DBI condition.
1077

            
1078
    1. AutoCommit is true
1079
    2. RaiseError is true
1080

            
1081
By default, Both AutoCommit and RaiseError is true.
1082
You must not change these mode not to damage your data.
1083

            
1084
If you change these mode, 
1085
you cannot get correct error message, 
1086
or run_tranzaction may fail.
1087

            
add various
yuki-kimoto authored on 2009-10-18
1088
=head1 AUTHOR
first commit
yuki-kimoto authored on 2009-10-13
1089

            
add various
yuki-kimoto authored on 2009-10-18
1090
Yuki Kimoto, C<< <kimoto.yuki at gmail.com> >>
first commit
yuki-kimoto authored on 2009-10-13
1091

            
add tests
yuki-kimoto authored on 2009-10-31
1092
Github L<http://github.com/yuki-kimoto>
1093

            
first commit
yuki-kimoto authored on 2009-10-13
1094
=head1 COPYRIGHT & LICENSE
1095

            
1096
Copyright 2009 Yuki Kimoto, all rights reserved.
1097

            
1098
This program is free software; you can redistribute it and/or modify it
1099
under the same terms as Perl itself.
1100

            
1101
=cut