DBIx-Custom / lib / DBI / Custom.pm /
Newer Older
1104 lines | 28.417kb
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 { {} } } }
add database method
yuki-kimoto authored on 2009-11-06
19
sub database    : ClassObjectAttr { initialize => {clone => 'scalar'} }
catch up Object::Simple upda...
yuki-kimoto authored on 2009-10-26
20

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

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

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

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

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

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

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

            
62

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
726
=head1 VERSION
727

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

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

            
732
This module is now experimental stage.
733

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

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

            
739
=head1 SYNOPSIS
740

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

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

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

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

            
757
=head2 password
758

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

            
766
=head2 data_source
767

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

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

            
add database method
yuki-kimoto authored on 2009-11-06
787
This method will be used in subclass connect method.
788

            
cleanup
yuki-kimoto authored on 2009-10-29
789
=head2 dbi_options
update document
yuki-kimoto authored on 2009-10-27
790

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

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

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

            
add prepare
yuki-kimoto authored on 2009-10-31
800
=head2 prepare
801

            
802
    $sth = $dbi->prepare($sql);
803

            
804
This method is same as DBI::prepare
805

            
806
=head2 do
807

            
808
    $dbi->do($sql, @bind_values);
809

            
810
This method is same as DBI::do
811

            
update document
yuki-kimoto authored on 2009-10-27
812
=head2 sql_template
813

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

            
821
=head2 filters
822

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

            
add formats add_format
yuki-kimoto authored on 2009-11-06
827
=head2 formats
828

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

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

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

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

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

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

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

            
add no_bind_filters
yuki-kimoto authored on 2009-10-30
854
=head2 no_bind_filters
855

            
856
    # Set and get no filter keys when binding
857
    $self            = $dbi->no_bind_filters($no_bind_filters);
858
    $no_bind_filters = $dbi->no_bind_filters;
859

            
860
=head2 no_fetch_filters
cleanup
yuki-kimoto authored on 2009-10-29
861

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

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

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

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

            
update document
yuki-kimoto authored on 2009-10-27
877
    # Get database handle
878
    $dbh = $self->dbh;
add test
yuki-kimoto authored on 2009-10-17
879

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

            
update document
yuki-kimoto authored on 2009-10-27
882
=head2 connect
883

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

            
892
=head2 disconnect
893

            
update document
yuki-kimoto authored on 2009-10-27
894
    # Disconnect database
895
    $dbi->disconnect;
896

            
897
If database is already disconnected, this method do noting.
898

            
add tests
yuki-kimoto authored on 2009-10-18
899
=head2 reconnect
900

            
update document
yuki-kimoto authored on 2009-10-27
901
    # Reconnect
902
    $dbi->reconnect;
903

            
904
=head2 connected
905

            
906
    # Check connected
907
    $dbi->connected
908

            
909
=head2 add_filter
910

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

            
954
add_filter add filter to filters
add tests
yuki-kimoto authored on 2009-10-18
955

            
add formats add_format
yuki-kimoto authored on 2009-11-06
956
=head2 add_format
957

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

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

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

            
979
See also L<DBI::Custom::SQL::Template>
980

            
cleanup
yuki-kimoto authored on 2009-10-22
981
=head2 run_tranzaction
first commit
yuki-kimoto authored on 2009-10-13
982

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

            
update document
yuki-kimoto authored on 2009-10-27
988
If tranzaction is success, commit is execute. 
989
If tranzation is died, rollback is execute.
first commit
yuki-kimoto authored on 2009-10-13
990

            
add methods
yuki-kimoto authored on 2009-11-02
991
=head2 insert
992

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

            
999
=head2 update
1000

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

            
1007
=head2 update_all
1008

            
1009
    # Update all rows
1010
    $dbi->update($table, $updat_values);
1011

            
1012
=head2 delete
1013

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

            
1020
=head2 delete_all
1021

            
1022
    # Delete all rows
1023
    $dbi->delete_all($table);
1024

            
1025
=head2 last_insert_id
1026

            
1027
    # Get last insert id
1028
    $last_insert_id = $dbi->last_insert_id;
1029
    
1030
This method is same as DBI last_insert_id;
1031

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

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

            
1067
=head2 query_cache_max
1068

            
1069
    # Max query cache count
1070
    $class           = $class->query_cache_max($query_cache_max);
1071
    $query_cache_max = $class->query_cache_max;
1072
    
1073
    # Sample
1074
    DBI::Custom->query_cache_max(50);
1075

            
add tests
yuki-kimoto authored on 2009-10-31
1076
=head1 CAUTION
1077

            
1078
DBI::Custom have DIB object internal.
1079
This module is work well in the following DBI condition.
1080

            
1081
    1. AutoCommit is true
1082
    2. RaiseError is true
1083

            
1084
By default, Both AutoCommit and RaiseError is true.
1085
You must not change these mode not to damage your data.
1086

            
1087
If you change these mode, 
1088
you cannot get correct error message, 
1089
or run_tranzaction may fail.
1090

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

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

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

            
first commit
yuki-kimoto authored on 2009-10-13
1097
=head1 COPYRIGHT & LICENSE
1098

            
1099
Copyright 2009 Yuki Kimoto, all rights reserved.
1100

            
1101
This program is free software; you can redistribute it and/or modify it
1102
under the same terms as Perl itself.
1103

            
1104
=cut