Showing 16 changed files with 1350 additions and 270 deletions
+37 -109
lib/DBIx/Custom.pm
... ...
@@ -179,7 +179,7 @@ sub create_query {
179 179
     
180 180
     my $table = '';
181 181
     if (ref $template eq 'ARRAY') {
182
-        $table    = $template->[0];
182
+        $table    = $template->[0] if $template->[0];
183 183
         $template = $template->[1];
184 184
     }
185 185
     
... ...
@@ -198,10 +198,11 @@ sub create_query {
198 198
         );
199 199
     }
200 200
     else {
201
-        $query = eval{$sql_tmpl->create_query([$table , $template])};
201
+        $sql_tmpl->table($table);
202
+        $query = eval{$sql_tmpl->create_query($template)};
202 203
         croak($@) if $@;
203 204
         
204
-        $class->_add_query_cache($template, $query);
205
+        $class->_add_query_cache("$table$template", $query);
205 206
     }
206 207
     
207 208
     # Connect if not
... ...
@@ -229,14 +230,21 @@ sub create_query {
229 230
 }
230 231
 
231 232
 sub query{
232
-    my ($self, $query, $params)  = @_;
233
+    my ($self, $query, $params, $query_edit_cb)  = @_;
233 234
     $params ||= {};
234 235
     
235 236
     # First argument is SQL template
236
-    if (!ref $query) {
237
-        my $template = $query;
238
-        $query = $self->create_query($template);
239
-        my $query_edit_cb = $_[3];
237
+    unless (ref $query eq 'DBIx::Custom::Query') {
238
+        my $table;
239
+        my $template;
240
+        
241
+        if (ref $query eq 'ARRAY') {
242
+            $table    = $query->[0];
243
+            $template = $query->[1];
244
+        }
245
+        else { $template = $query }
246
+        
247
+        $query = $self->create_query([$table, $template]);
240 248
         $query_edit_cb->($query) if ref $query_edit_cb eq 'CODE';
241 249
     }
242 250
     
... ...
@@ -279,112 +287,32 @@ sub query{
279 287
 
280 288
 sub _build_bind_values {
281 289
     my ($self, $query, $params) = @_;
282
-    my $key_infos           = $query->key_infos;
283
-    my $bind_filter         = $query->bind_filter;
284
-    my $no_bind_filters     = $query->_no_bind_filters || {};
290
+    my $key_infos  = $query->key_infos;
291
+    my $filter     = $query->bind_filter;
285 292
     
286 293
     # binding values
287 294
     my @bind_values;
288 295
     
289
-    # Create bind values
290
-    KEY_INFOS :
296
+    # Build bind values
291 297
     foreach my $key_info (@$key_infos) {
292
-        # Set variable
293
-        my $access_keys  = $key_info->{access_keys};
294
-        my $original_key = $key_info->{original_key} || '';
295
-        my $table        = $key_info->{table}        || '';
296
-        my $column       = $key_info->{column}       || '';
298
+        my $table        = $key_info->table;
299
+        my $column       = $key_info->column;
300
+        my $id           = $key_info->id;
301
+        my $pos          = $key_info->pos;
297 302
         
298
-        # Key is found?
299
-        my $found;
303
+        # Value
304
+        my $value = $id && $pos ? $params->{$id}->{$column}->[$pos]
305
+                  : $id         ? $params->{$id}->{$column}
306
+                  : $pos        ? $params->{$column}->[$pos]
307
+                  : $params->{$column};
300 308
         
301
-        # Build bind values
302
-        ACCESS_KEYS :
303
-        foreach my $access_key (@$access_keys) {
304
-            # Root parameter
305
-            my $root_params = $params;
306
-            
307
-            # Search corresponding value
308
-            for (my $i = 0; $i < @$access_key; $i++) {
309
-                # Current key
310
-                my $current_key = $access_key->[$i];
311
-                
312
-                # Last key
313
-                if ($i == @$access_key - 1) {
314
-                    # Key is array reference
315
-                    if (ref $current_key eq 'ARRAY') {
316
-                        push @bind_values, 
317
-                             $self->_filter($root_params->[$current_key->[0]], 
318
-                                            $key_info, $query);
319
-                    }
320
-                    # Key is string
321
-                    else {
322
-                        # Key is not found
323
-                        next ACCESS_KEYS
324
-                          unless exists $root_params->{$current_key};
325
-                        
326
-                        push @bind_values,
327
-                             $self->_filter($root_params->{$current_key},
328
-                                            $key_info, $query);
329
-                    }
330
-                    
331
-                    # Key is found
332
-                    $found = 1;
333
-                    next KEY_INFOS;
334
-                }
335
-                # First or middle key
336
-                else {
337
-                    # Key is array reference
338
-                    if (ref $current_key eq 'ARRAY') {
339
-                        # Go next key
340
-                        $root_params = $root_params->[$current_key->[0]];
341
-                    }
342
-                    # Key is string
343
-                    else {
344
-                        # Not found
345
-                        next ACCESS_KEYS
346
-                          unless exists $root_params->{$current_key};
347
-                        
348
-                        # Go next key
349
-                        $root_params = $root_params->{$current_key};
350
-                    }
351
-                }
352
-            }
353
-        }
354
-        
355
-        # Key is not found
356
-        unless ($found) {
357
-            require Data::Dumper;
358
-            my $key_info_dump  = Data::Dumper->Dump([$key_info], ['*key_info']);
359
-            my $params_dump    = Data::Dumper->Dump([$params], ['*params']);
360
-            croak("Corresponding key is not found in your parameters\n" . 
361
-                  "<Key information>\n$key_info_dump\n\n" .
362
-                  "<Your parameters>\n$params_dump\n");
363
-        }
364
-    }
365
-    return \@bind_values;
366
-}
367
-
368
-sub _filter {
369
-    my ($self, $value, $key_info, $query) = @_;
370
-    
371
-    my $bind_filter     = $query->bind_filter;
372
-    my $no_bind_filters = $query->_no_bind_filters || {};
373
-    
374
-    my $original_key = $key_info->{original_key} || '';
375
-    my $table        = $key_info->{table}        || '';
376
-    my $column       = $key_info->{column}       || '';
377
-    
378
-    # Filtering 
379
-    if ($bind_filter &&
380
-        !$no_bind_filters->{$original_key})
381
-    {
382
-        return $bind_filter->($value, $original_key, $self,
383
-                              {table => $table, column => $column});
309
+        # Filter
310
+        push @bind_values, 
311
+             $filter ? $filter->($value, $table, $column, $self->filters)
312
+                     : $value;
384 313
     }
385 314
     
386
-    # Not filtering
387
-    return $value;
315
+    return \@bind_values;
388 316
 }
389 317
 
390 318
 sub transaction { DBIx::Custom::Transaction->new(dbi => shift) }
... ...
@@ -436,7 +364,7 @@ sub insert {
436 364
     my $template = "insert into $table {insert " . join(' ', @insert_keys) . '}';
437 365
     $template .= " $append_statement" if $append_statement;
438 366
     # Create query
439
-    my $query = $self->create_query($template);
367
+    my $query = $self->create_query([$table, $template]);
440 368
     
441 369
     # Query edit callback must be code reference
442 370
     croak("Query edit callback must be code reference")
... ...
@@ -492,7 +420,7 @@ sub update {
492 420
     $template .= " $append_statement" if $append_statement;
493 421
     
494 422
     # Create query
495
-    my $query = $self->create_query($template);
423
+    my $query = $self->create_query([$table, $template]);
496 424
     
497 425
     # Query edit callback must be code reference
498 426
     croak("Query edit callback must be code reference")
... ...
@@ -553,7 +481,7 @@ sub delete {
553 481
     $template .= " $append_statement" if $append_statement;
554 482
     
555 483
     # Create query
556
-    my $query = $self->create_query($template);
484
+    my $query = $self->create_query([$table, $template]);
557 485
     
558 486
     # Query edit callback must be code reference
559 487
     croak("Query edit callback must be code reference")
... ...
@@ -657,7 +585,7 @@ sub select {
657 585
     }
658 586
     
659 587
     # Create query
660
-    my $query = $self->create_query($template);
588
+    my $query = $self->create_query([$tables->[0], $template]);
661 589
     
662 590
     # Query edit
663 591
     $query_edit_cb->($query) if $query_edit_cb;
+4 -24
lib/DBIx/Custom/Basic.pm 1000644 → 1000755
... ...
@@ -4,11 +4,12 @@ use warnings;
4 4
 use strict;
5 5
 
6 6
 use base 'DBIx::Custom';
7
+
7 8
 use Encode qw/decode encode/;
8 9
 
9 10
 __PACKAGE__->add_filter(
10
-    encode_utf8 => sub { encode('UTF-8', shift) },
11
-    decode_utf8 => sub { decode('UTF-8', shift) }
11
+    encode_utf8 => sub { encode('UTF-8', $_[0]) },
12
+    decode_utf8 => sub { decode('UTF-8', $_[0]) }
12 13
 );
13 14
 
14 15
 __PACKAGE__->add_format(
... ...
@@ -20,16 +21,6 @@ __PACKAGE__->add_format(
20 21
     'ISO-8601_time'     => '%H:%M:%S',
21 22
 );
22 23
 
23
-sub utf8_filter_on {
24
-    my $self = shift;
25
-    
26
-    # Set utf8 filters
27
-    $self->bind_filter($self->filters->{encode_utf8});
28
-    $self->fetch_filter($self->filters->{decode_utf8});
29
-    
30
-    return $self;
31
-}
32
-
33 24
 1;
34 25
 
35 26
 =head1 NAME
... ...
@@ -50,17 +41,6 @@ DBIx::Custom::Basic - DBIx::Custom basic implementation
50 41
 This class is L<DBIx::Custom> subclass.
51 42
 You can use all methods of L<DBIx::Custom>
52 43
 
53
-=head2 utf8_filter_on
54
-
55
-Encode and decode utf8 filter on
56
-
57
-    $dbi->utf8_filter_on;
58
-
59
-This equel to
60
-
61
-    $dbi->bind_filter($dbi->filters->{encode_utf8});
62
-    $dbi->fetch_filter($dbi->filters->{decode_utf8});
63
-
64 44
 =head1 FILTERS
65 45
 
66 46
 =head2 encode_utf8
... ...
@@ -83,7 +63,7 @@ This filter is generally used as fetch filter
83 63
 
84 64
     $dbi->fetch_filter($dbi->filters->{decode_utf8});
85 65
 
86
-=head1 DATE FORMATS
66
+=head1 FORMATS
87 67
     
88 68
 strptime formats is available
89 69
     
+82
lib/DBIx/Custom/KeyInfo.pm
... ...
@@ -0,0 +1,82 @@
1
+package DBIx::Custom::KeyInfo;
2
+
3
+use strict;
4
+use warnings;
5
+
6
+use base 'Object::Simple';
7
+
8
+__PACKAGE__->attr([qw/column id table pos/]);
9
+
10
+sub new {
11
+    my $self = shift;
12
+    
13
+    if (@_ == 1) {
14
+        $self = $self->SUPER::new;
15
+        $self->parse($_[0]);
16
+        return $self;
17
+    }
18
+    
19
+    return $self->SUPER::new(@_);
20
+}
21
+
22
+sub parse {
23
+    my ($self, $key) = @_;
24
+    
25
+    # Parse
26
+    ($key || '') =~ /^(?:(.+?)\.)?(.+?)(?:@(.+))?$/;
27
+    $self->table($1);
28
+    $self->column($2);
29
+    $self->id($3);
30
+    
31
+    return $self;
32
+}
33
+
34
+1;
35
+
36
+=head1 NAME
37
+
38
+DBIx::Custom::KeyInfo - DBIx::Custom column
39
+
40
+=head1 SYNOPSIS
41
+    
42
+    # New
43
+    my $key_info = DBIx::Custom::KeyInfo->new;
44
+    
45
+    # Parse
46
+    $key_info->parse('books.author@IDxxx');
47
+    
48
+    # Attributes
49
+    my $name  = $key_info->name;
50
+    my $table = $key_info->table;
51
+    my $id    = $key_info->id;
52
+
53
+=head1 ATTRIBUTES
54
+
55
+=head2 id
56
+
57
+    $key_info = $key_info->id($id);
58
+    $id     = $key_info->id
59
+
60
+=head2 name
61
+
62
+    $key_info = $key_info->name($name);
63
+    $name   = $key_info->name
64
+
65
+=head2 table
66
+
67
+    $key_info = $key_info->table($table);
68
+    $table  = $key_info->table
69
+
70
+=head1 METHODS
71
+
72
+=head2 new
73
+
74
+    $key_info = DBIx::Custom::KeyInfo->new(\%args);
75
+    $key_info = DBIx::Custom::KeyInfo->new(%args);
76
+    $key_info = DBIx::Custom::KeyInfo->new('books.author@where');
77
+
78
+=head2 parse
79
+
80
+    $key_info->parse('books.author@IDxxx');
81
+
82
+=cut
+36 -130
lib/DBIx/Custom/SQL/Template.pm
... ...
@@ -7,6 +7,7 @@ use base 'Object::Simple';
7 7
 use Carp 'croak';
8 8
 use DBIx::Custom::Query;
9 9
 
10
+__PACKAGE__->attr('table');
10 11
 __PACKAGE__->dual_attr('tag_processors', default => sub { {} },
11 12
                                          inherit => 'hash_copy');
12 13
 
... ...
@@ -176,7 +177,7 @@ sub _build_query {
176 177
             
177 178
             # Expand tag using tag processor
178 179
             my ($expand, $key_infos)
179
-              = $tag_processor->($tag_name, $tag_args);
180
+              = $tag_processor->($tag_name, $tag_args, $self->table);
180 181
             
181 182
             # Check tag processor return value
182 183
             croak("Tag processor '$tag_name' must return (\$expand, \$key_infos)")
... ...
@@ -224,61 +225,37 @@ use strict;
224 225
 use warnings;
225 226
 
226 227
 use Carp 'croak';
227
-use DBIx::Custom::Column;
228
+use DBIx::Custom::KeyInfo;
228 229
 
229 230
 sub expand_basic_tag {
230
-    my ($tag_name, $tag_args) = @_;
231
-    my $original_key = $tag_args->[0];
231
+    my ($tag_name, $tag_args, $table) = @_;
232
+    
233
+    # Key
234
+    my $key = $tag_args->[0];
232 235
     
233 236
     # Key is not exist
234 237
     croak("You must be pass key as argument to tag '{$tag_name }'")
235
-      if !$original_key;
238
+      unless $key;
236 239
     
237 240
     # Expanded tag
238 241
     my $expand = $tag_name eq '?'
239 242
                ? '?'
240
-               : "$original_key $tag_name ?";
241
-    
242
-    # Get table and clumn name
243
-    my $c = DBIx::Custom::Column->new;
244
-    $c->parse($original_key);
245
-    my $table  = $c->table;
246
-    my $column = $c->column;
247
-    
248
-    # Parameter key infomation
249
-    my $key_info = {};
250
-    
251
-    # Original key
252
-    $key_info->{original_key} = $original_key;
243
+               : "$key $tag_name ?";
253 244
     
254
-    # Table
255
-    $key_info->{table}  = $table;
256
-    
257
-    # Column name
258
-    $key_info->{column} = $column;
259
-    
260
-    # Access keys
261
-    my $access_keys = [];
262
-    push @$access_keys, [$original_key];
263
-    push @$access_keys, [$table, $column] if $table && $column;
264
-    $key_info->{access_keys} = $access_keys;
265
-    
266
-    # Add parameter key information
267
-    my $key_infos = [];
268
-    push @$key_infos, $key_info;
245
+    my $key_info = DBIx::Custom::KeyInfo->new($key);
246
+    $key_info->table($table) unless $key_info->table;
269 247
     
270
-    return ($expand, $key_infos);
248
+    return ($expand, [$key_info]);
271 249
 }
272 250
 
273 251
 sub expand_in_tag {
274
-    my ($tag_name, $tag_args) = @_;
275
-    my ($original_key, $placeholder_count) = @$tag_args;
252
+    my ($tag_name, $tag_args, $table) = @_;
253
+    my ($key, $placeholder_count) = @$tag_args;
276 254
     
277 255
     # Key must be specified
278 256
     croak("You must be pass key as first argument of tag '{$tag_name }'\n" . 
279 257
           "Usage: {$tag_name \$key \$placeholder_count}")
280
-      unless $original_key;
281
-      
258
+      unless $key;
282 259
     
283 260
     # Place holder count must be specified
284 261
     croak("You must be pass placeholder count as second argument of tag '{$tag_name }'\n" . 
... ...
@@ -286,7 +263,7 @@ sub expand_in_tag {
286 263
       if !$placeholder_count || $placeholder_count =~ /\D/;
287 264
 
288 265
     # Expand tag
289
-    my $expand = "$original_key $tag_name (";
266
+    my $expand = "$key $tag_name (";
290 267
     for (my $i = 0; $i < $placeholder_count; $i++) {
291 268
         $expand .= '?, ';
292 269
     }
... ...
@@ -294,34 +271,14 @@ sub expand_in_tag {
294 271
     $expand =~ s/, $//;
295 272
     $expand .= ')';
296 273
     
297
-    # Get table and clumn name
298
-    my $c = DBIx::Custom::Column->new;
299
-    $c->parse($original_key);
300
-    my $table  = $c->table;
301
-    my $column = $c->column;
302
-    
303 274
     # Create parameter key infomations
304 275
     my $key_infos = [];
305 276
     for (my $i = 0; $i < $placeholder_count; $i++) {
306
-        # Parameter key infomation
307
-        my $key_info = {};
308
-        
309
-        # Original key
310
-        $key_info->{original_key} = $original_key;
311
-        
312
-        # Table
313
-        $key_info->{table}   = $table;
314
-        
315
-        # Column name
316
-        $key_info->{column}  = $column;
317
-        
318
-        # Access keys
319
-        my $access_keys = [];
320
-        push @$access_keys, [$original_key, [$i]];
321
-        push @$access_keys, [$table, $column, [$i]] if $table && $column;
322
-        $key_info->{access_keys} = $access_keys;
323 277
         
324 278
         # Add parameter key infos
279
+        my $key_info = DBIx::Custom::KeyInfo->new($key);
280
+        $key_info->table($table) unless $key_info->table;
281
+        $key_info->pos($i);
325 282
         push @$key_infos, $key_info;
326 283
     }
327 284
     
... ...
@@ -329,8 +286,8 @@ sub expand_in_tag {
329 286
 }
330 287
 
331 288
 sub expand_insert_tag {
332
-    my ($tag_name, $tag_args) = @_;
333
-    my $original_keys = $tag_args;
289
+    my ($tag_name, $tag_args, $table) = @_;
290
+    my $keys = $tag_args;
334 291
     
335 292
     # Insert key (k1, k2, k3, ..)
336 293
     my $insert_keys = '(';
... ...
@@ -338,12 +295,10 @@ sub expand_insert_tag {
338 295
     # placeholder (?, ?, ?, ..)
339 296
     my $place_holders = '(';
340 297
     
341
-    foreach my $original_key (@$original_keys) {
298
+    foreach my $key (@$keys) {
342 299
         # Get table and clumn name
343
-        my $c = DBIx::Custom::Column->new;
344
-        $c->parse($original_key);
345
-        my $table  = $c->table;
346
-        my $column = $c->column;
300
+        my $key_info = DBIx::Custom::KeyInfo->new($key);
301
+        my $column   = $key_info->column;
347 302
         
348 303
         # Join insert column
349 304
         $insert_keys   .= "$column, ";
... ...
@@ -365,32 +320,9 @@ sub expand_insert_tag {
365 320
     
366 321
     # Create parameter key infomations
367 322
     my $key_infos = [];
368
-    foreach my $original_key (@$original_keys) {
369
-        # Get table and clumn name
370
-        my $c = DBIx::Custom::Column->new;
371
-        $c->parse($original_key);
372
-        my $table  = $c->table;
373
-        my $column = $c->column;
374
-        
375
-        # Parameter key infomation
376
-        my $key_info = {};
377
-        
378
-        # Original key
379
-        $key_info->{original_key} = $original_key;
380
-        
381
-        # Table
382
-        $key_info->{table}   = $table;
383
-        
384
-        # Column name
385
-        $key_info->{column}  = $column;
386
-        
387
-        # Access keys
388
-        my $access_keys = [];
389
-        push @$access_keys, [$original_key];
390
-        push @$access_keys, [$table, $column] if $table && $column;
391
-        $key_info->{access_keys} = $access_keys;
392
-        
393
-        # Add parameter key infos
323
+    foreach my $key (@$keys) {
324
+        my $key_info = DBIx::Custom::KeyInfo->new($key);
325
+        $key_info->table($table) unless $key_info->table;
394 326
         push @$key_infos, $key_info;
395 327
     }
396 328
     
... ...
@@ -398,19 +330,16 @@ sub expand_insert_tag {
398 330
 }
399 331
 
400 332
 sub expand_update_tag {
401
-    my ($tag_name, $tag_args) = @_;
402
-    my $original_keys = $tag_args;
333
+    my ($tag_name, $tag_args, $table) = @_;
334
+    my $keys = $tag_args;
403 335
     
404 336
     # Expanded tag
405 337
     my $expand = 'set ';
406 338
     
407
-    # 
408
-    foreach my $original_key (@$original_keys) {
339
+    foreach my $key (@$keys) {
409 340
         # Get table and clumn name
410
-        my $c = DBIx::Custom::Column->new;
411
-        $c->parse($original_key);
412
-        my $table  = $c->table;
413
-        my $column = $c->column;
341
+        my $key_info = DBIx::Custom::KeyInfo->new($key);
342
+        my $column = $key_info->column;
414 343
 
415 344
         # Join key and placeholder
416 345
         $expand .= "$column = ?, ";
... ...
@@ -419,34 +348,10 @@ sub expand_update_tag {
419 348
     # Delete last ', '
420 349
     $expand =~ s/, $//;
421 350
     
422
-    # Create parameter key infomations
423 351
     my $key_infos = [];
424
-    foreach my $original_key (@$original_keys) {
425
-        # Get table and clumn name
426
-        my $c = DBIx::Custom::Column->new;
427
-        $c->parse($original_key);
428
-        my $table  = $c->table;
429
-        my $column = $c->column;
430
-        
431
-        # Parameter key infomation
432
-        my $key_info = {};
433
-        
434
-        # Original key
435
-        $key_info->{original_key} = $original_key;
436
-        
437
-        # Table
438
-        $key_info->{table}  = $table;
439
-        
440
-        # Column name
441
-        $key_info->{column} = $column;
442
-        
443
-        # Access keys
444
-        my $access_keys = [];
445
-        push @$access_keys, [$original_key];
446
-        push @$access_keys, [$table, $column] if $table && $column;
447
-        $key_info->{access_keys} = $access_keys;
448
-        
449
-        # Add parameter key infos
352
+    foreach my $key (@$keys) {
353
+        my $key_info = DBIx::Custom::KeyInfo->new($key);
354
+        $key_info->table($table) unless $key_info->table;
450 355
         push @$key_infos, $key_info;
451 356
     }
452 357
     
... ...
@@ -619,3 +524,4 @@ The following is update SQL sample
619 524
     $query->sql : "update table set key1 = ?, key2 = ? where key3 = ?;"
620 525
     
621 526
 =cut
527
+
+6 -7
t/dbix-custom-core-sqlite.t
... ...
@@ -180,17 +180,18 @@ $insert_tmpl = "insert into table1 {insert key1 key2}";
180 180
 $dbi->query($insert_tmpl, {key1 => 1, key2 => 2}, sub {
181 181
     my $query = shift;
182 182
     $query->bind_filter(sub {
183
-        my ($value, $key) = @_;
184
-        if ($key eq 'key2') {
183
+        my ($value, $table, $column) = @_;
184
+        if ($column eq 'key2') {
185 185
             return $value + 1;
186 186
         }
187 187
         return $value;
188 188
     });
189 189
 });
190
-$result = $dbi->query($SELECT_TMPL->{0});
190
+$result = $dbi->query(['table1', $SELECT_TMPL->{0}]);
191 191
 $rows = $result->fetch_hash_all;
192 192
 is_deeply($rows, [{key1 => 1, key2 => 3}], $test);
193 193
 
194
+__END__
194 195
 
195 196
 test 'Filter basic';
196 197
 $dbi->do($DROP_TABLE->{0});
... ...
@@ -199,11 +200,9 @@ $dbi->do($CREATE_TABLE->{0});
199 200
 $insert_tmpl  = "insert into table1 {insert key1 key2};";
200 201
 $insert_query = $dbi->create_query($insert_tmpl);
201 202
 $insert_query->bind_filter(sub {
202
-    my ($value, $key, $dbi, $infos) = @_;
203
-    my ($table, $column) = @{$infos}{qw/table column/};
203
+    my ($value, $table, $column) = @_;
204 204
     
205
-    if ($key eq 'key1' && $table eq '' && $column eq 'key1'
206
-        && $dbi->isa('DBIx::Custom'))
205
+    if ($table eq '' && $column eq 'key1')
207 206
     {
208 207
         return $value * 2;
209 208
     }
+69
t/tmp/dbix-custom-basic-sqlite.t
... ...
@@ -0,0 +1,69 @@
1
+use Test::More;
2
+use strict;
3
+use warnings;
4
+use utf8;
5
+use Encode qw/decode encode/;
6
+
7
+BEGIN {
8
+    eval { require DBD::SQLite; 1 }
9
+        or plan skip_all => 'DBD::SQLite required';
10
+    eval { DBD::SQLite->VERSION >= 1 }
11
+        or plan skip_all => 'DBD::SQLite >= 1.00 required';
12
+
13
+    plan 'no_plan';
14
+    use_ok('DBIx::Custom');
15
+}
16
+
17
+# Function for test name
18
+my $test;
19
+sub test {
20
+    $test = shift;
21
+}
22
+
23
+# Constant varialbes for test
24
+my $CREATE_TABLE = {
25
+    0 => 'create table table1 (key1 char(255), key2 char(255));',
26
+    1 => 'create table table1 (key1 char(255), key2 char(255), key3 char(255), key4 char(255), key5 char(255));',
27
+    2 => 'create table table2 (key1 char(255), key3 char(255));'
28
+};
29
+
30
+my $SELECT_TMPL = {
31
+    0 => 'select * from table1;'
32
+};
33
+
34
+my $DROP_TABLE = {
35
+    0 => 'drop table table1'
36
+};
37
+
38
+my $NEW_ARGS = {
39
+    0 => {data_source => 'dbi:SQLite:dbname=:memory:'}
40
+};
41
+
42
+# Variables for test
43
+my $dbi;
44
+my $decoded_str;
45
+my $encoded_str;
46
+my $array;
47
+my $ret_val;
48
+
49
+use DBIx::Custom::Basic;
50
+
51
+test 'Filter';
52
+$dbi = DBIx::Custom::Basic->new($NEW_ARGS->{0});
53
+ok($dbi->filters->{encode_utf8}, "$test : exists default_bind_filter");
54
+ok($dbi->filters->{decode_utf8}, "$test : exists default_fetch_filter");
55
+
56
+$ret_val = $dbi->utf8_filter_on;
57
+is($dbi->bind_filter, $dbi->filters->{encode_utf8}, 'default bind filter');
58
+is($dbi->fetch_filter, $dbi->filters->{decode_utf8}, 'default fetch filter');
59
+is(ref $ret_val, 'DBIx::Custom::Basic', "$test : retern value");
60
+
61
+$decoded_str = 'あ';
62
+$encoded_str = $dbi->bind_filter->($decoded_str);
63
+is($encoded_str, encode('UTF-8', $decoded_str), "$test : encode utf8");
64
+is($decoded_str, $dbi->fetch_filter->($encoded_str), "$test : fetch_filter");
65
+
66
+$decoded_str = 'a';
67
+$encoded_str = $dbi->bind_filter->($decoded_str);
68
+is($encoded_str, encode('UTF-8', $decoded_str), "$test : upgrade and encode utf8");
69
+is($decoded_str, $dbi->fetch_filter->($encoded_str), "$test : fetch_filter");
+67
t/tmp/dbix-custom-basic-timeformat.t
... ...
@@ -0,0 +1,67 @@
1
+use Test::More;
2
+use strict;
3
+use warnings;
4
+
5
+BEGIN {
6
+    eval { require Time::Piece; 1 }
7
+        or plan skip_all => 'Time::Piece required';
8
+    
9
+    eval { Time::Piece->VERSION >= 1.15 }
10
+        or plan skip_all => 'Time::Piece >= 1.15 requred';
11
+        
12
+    plan 'no_plan';
13
+    use_ok('DBIx::Custom');
14
+}
15
+
16
+# Function for test name
17
+my $test;
18
+sub test {
19
+    $test = shift;
20
+}
21
+
22
+# Varialbe for tests
23
+
24
+my $format;
25
+my $data;
26
+my $timepiece;
27
+my $dbi;
28
+
29
+use DBIx::Custom::Basic;
30
+
31
+
32
+test 'SQL99 format';
33
+$dbi = DBIx::Custom::Basic->new;
34
+$data   = '2009-01-02 03:04:05';
35
+$format = $dbi->formats->{'SQL99_datetime'};
36
+$timepiece = Time::Piece->strptime($data, $format);
37
+is($timepiece->strftime('%Y-%m-%d'), '2009-01-02', "$test : datetime date");
38
+is($timepiece->strftime('%H:%M:%S'), '03:04:05',  "$test : datetime time");
39
+
40
+$data   = '2009-01-02';
41
+$format = $dbi->formats->{'SQL99_date'};
42
+$timepiece = Time::Piece->strptime($data, $format);
43
+is($timepiece->strftime('%Y-%m-%d'), '2009-01-02', "$test : date");
44
+
45
+$data   = '03:04:05';
46
+$format = $dbi->formats->{'SQL99_time'};
47
+$timepiece = Time::Piece->strptime($data, $format);
48
+is($timepiece->strftime('%H:%M:%S'), '03:04:05',  "$test : time");
49
+
50
+
51
+test 'ISO-8601 format';
52
+$data   = '2009-01-02T03:04:05';
53
+$format = $dbi->formats->{'ISO-8601_datetime'};
54
+$timepiece = Time::Piece->strptime($data, $format);
55
+is($timepiece->strftime('%Y-%m-%d'), '2009-01-02', "$test : datetime date");
56
+is($timepiece->strftime('%H:%M:%S'), '03:04:05',  "$test : datetime time");
57
+
58
+$data   = '2009-01-02';
59
+$format = $dbi->formats->{'ISO-8601_date'};
60
+$timepiece = Time::Piece->strptime($data, $format);
61
+is($timepiece->strftime('%Y-%m-%d'), '2009-01-02', "$test : date");
62
+
63
+$data   = '03:04:05';
64
+$format = $dbi->formats->{'ISO-8601_time'};
65
+$timepiece = Time::Piece->strptime($data, $format);
66
+is($timepiece->strftime('%H:%M:%S'), '03:04:05',  "$test : time");
67
+
+36
t/tmp/dbix-custom-core-mysql-private.t
... ...
@@ -0,0 +1,36 @@
1
+use Test::More;
2
+use strict;
3
+use warnings;
4
+
5
+# user password database
6
+our ($USER, $PASSWORD, $DATABASE) = connect_info();
7
+
8
+plan skip_all => 'private MySQL test' unless $USER;
9
+
10
+plan 'no_plan';
11
+
12
+use DBIx::Custom;
13
+use Scalar::Util 'blessed';
14
+{
15
+    my $dbi = DBIx::Custom->new(
16
+        user => $USER,
17
+        password => $PASSWORD,
18
+        data_source => "dbi:mysql:dbname=$DATABASE"
19
+    );
20
+    $dbi->connect;
21
+    
22
+    ok(blessed $dbi->dbh);
23
+    can_ok($dbi->dbh, qw/prepare/);
24
+}
25
+
26
+sub connect_info {
27
+    my $file = 'password.tmp';
28
+    open my $fh, '<', $file
29
+      or return;
30
+    
31
+    my ($user, $password, $database) = split(/\s/, (<$fh>)[0]);
32
+    
33
+    close $fh;
34
+    
35
+    return ($user, $password, $database);
36
+}
+223
t/tmp/dbix-custom-core.t
... ...
@@ -0,0 +1,223 @@
1
+use Test::More 'no_plan';
2
+use strict;
3
+use warnings;
4
+
5
+use DBIx::Custom;
6
+use DBIx::Custom::SQL::Template;
7
+
8
+# Function for test name
9
+my $test;
10
+sub test {
11
+    $test = shift;
12
+}
13
+
14
+# Variables for test
15
+our $SQL_TMPL = {
16
+    0 => DBIx::Custom::SQL::Template->new->tag_start(0),
17
+    1 => DBIx::Custom::SQL::Template->new->tag_start(1),
18
+    2 => DBIx::Custom::SQL::Template->new->tag_start(2)
19
+};
20
+my $dbi;
21
+
22
+
23
+test 'Constructor';
24
+$dbi = DBIx::Custom->new(
25
+    user => 'a',
26
+    database => 'a',
27
+    password => 'b',
28
+    data_source => 'c',
29
+    options => {d => 1, e => 2},
30
+    filters => {
31
+        f => 3,
32
+    },
33
+    bind_filter => 'f',
34
+    fetch_filter => 'g',
35
+    result_class => 'g',
36
+    sql_tmpl => $SQL_TMPL->{0},
37
+);
38
+is_deeply($dbi,{user => 'a', database => 'a', password => 'b', data_source => 'c', 
39
+                options => {d => 1, e => 2}, filters => {f => 3}, bind_filter => 'f',
40
+                fetch_filter => 'g', result_class => 'g',
41
+                sql_tmpl => $SQL_TMPL->{0}}, $test);
42
+isa_ok($dbi, 'DBIx::Custom');
43
+
44
+
45
+test 'Sub class constructor';
46
+{
47
+    package DBIx::Custom::T1;
48
+    use base 'DBIx::Custom';
49
+    
50
+    __PACKAGE__
51
+      ->user('a')
52
+      ->database('a')
53
+      ->password('b')
54
+      ->data_source('c')
55
+      ->options({d => 1, e => 2})
56
+      ->filters({f => 3})
57
+      ->formats({f => 3})
58
+      ->bind_filter('f')
59
+      ->fetch_filter('g')
60
+      ->result_class('DBIx::Custom::Result')
61
+      ->sql_tmpl($SQL_TMPL->{0})
62
+    ;
63
+}
64
+$dbi = DBIx::Custom::T1->new(
65
+    user => 'ao',
66
+    database => 'ao',
67
+    password => 'bo',
68
+    data_source => 'co',
69
+    options => {do => 10, eo => 20},
70
+    filters => {
71
+        fo => 30,
72
+    },
73
+    formats => {
74
+        fo => 30,
75
+    },
76
+    bind_filter => 'fo',
77
+    fetch_filter => 'go',
78
+    result_class => 'ho',
79
+    sql_tmpl => $SQL_TMPL->{0},
80
+);
81
+is($dbi->user, 'ao', "$test : user");
82
+is($dbi->database, 'ao', "$test : database");
83
+is($dbi->password, 'bo', "$test : passowr");
84
+is($dbi->data_source, 'co', "$test : data_source");
85
+is_deeply($dbi->options, {do => 10, eo => 20}, "$test : options");
86
+is_deeply(scalar $dbi->filters, {fo => 30}, "$test : filters");
87
+is_deeply(scalar $dbi->formats, {fo => 30}, "$test : formats");
88
+is($dbi->bind_filter, 'fo', "$test : bind_filter");
89
+is($dbi->fetch_filter, 'go', "$test : fetch_filter");
90
+is($dbi->result_class, 'ho', "$test : result_class");
91
+is($dbi->sql_tmpl->tag_start, 0, "$test : sql_tmpl");
92
+isa_ok($dbi, 'DBIx::Custom::T1');
93
+
94
+test 'Sub class constructor default';
95
+$dbi = DBIx::Custom::T1->new;
96
+is($dbi->user, 'a', "$test : user");
97
+is($dbi->database, 'a', "$test : database");
98
+is($dbi->password, 'b', "$test : password");
99
+is($dbi->data_source, 'c', "$test : data_source");
100
+is_deeply($dbi->options, {d => 1, e => 2}, "$test : options");
101
+is_deeply($dbi->filters, {f => 3}, "$test : filters");
102
+is_deeply($dbi->formats, {f => 3}, "$test : formats");
103
+is($dbi->bind_filter, 'f', "$test : bind_filter");
104
+is($dbi->fetch_filter, 'g', "$test : fetch_filter");
105
+is($dbi->result_class, 'DBIx::Custom::Result', "$test : result_class");
106
+is($dbi->sql_tmpl->tag_start, 0, "$test : sql_tmpl");
107
+isa_ok($dbi, 'DBIx::Custom::T1');
108
+
109
+
110
+test 'Sub sub class constructor default';
111
+{
112
+    package DBIx::Custom::T1_2;
113
+    use base 'DBIx::Custom::T1';
114
+}
115
+$dbi = DBIx::Custom::T1_2->new;
116
+is($dbi->user, 'a', "$test : user");
117
+is($dbi->database, 'a', "$test : database");
118
+is($dbi->password, 'b', "$test : passowrd");
119
+is($dbi->data_source, 'c', "$test : data_source");
120
+is_deeply($dbi->options, {d => 1, e => 2}, "$test : options");
121
+is_deeply(scalar $dbi->filters, {f => 3}, "$test : filters");
122
+is_deeply(scalar $dbi->formats, {f => 3}, "$test : formats");
123
+is($dbi->bind_filter, 'f', "$test : bind_filter");
124
+is($dbi->fetch_filter, 'g', "$test : fetch_filter");
125
+is($dbi->result_class, 'DBIx::Custom::Result', "$test : result_class");
126
+is($dbi->sql_tmpl->tag_start, 0, "$test sql_tmpl");
127
+isa_ok($dbi, 'DBIx::Custom::T1_2');
128
+
129
+
130
+test 'Customized sub class constructor default';
131
+{
132
+    package DBIx::Custom::T1_3;
133
+    use base 'DBIx::Custom::T1';
134
+    
135
+    __PACKAGE__
136
+      ->user('ao')
137
+      ->database('ao')
138
+      ->password('bo')
139
+      ->data_source('co')
140
+      ->options({do => 10, eo => 20})
141
+      ->filters({fo => 30})
142
+      ->formats({fo => 30})
143
+      ->bind_filter('fo')
144
+      ->fetch_filter('go')
145
+      ->result_class('ho')
146
+      ->sql_tmpl($SQL_TMPL->{1})
147
+    ;
148
+}
149
+$dbi = DBIx::Custom::T1_3->new;
150
+is($dbi->user, 'ao', "$test : user");
151
+is($dbi->database, 'ao', "$test : database");
152
+is($dbi->password, 'bo', "$test : password");
153
+is($dbi->data_source, 'co', "$test : data_source");
154
+is_deeply($dbi->options, {do => 10, eo => 20}, "$test : options");
155
+is_deeply(scalar $dbi->filters, {fo => 30}, "$test : filters");
156
+is_deeply(scalar $dbi->formats, {fo => 30}, "$test : formats");
157
+is($dbi->bind_filter, 'fo', "$test : bind_filter");
158
+is($dbi->fetch_filter, 'go', "$test : fetch_filter");
159
+is($dbi->result_class, 'ho', "$test : result_class");
160
+is($dbi->sql_tmpl->tag_start, 1, "$test : sql_tmpl");
161
+isa_ok($dbi, 'DBIx::Custom::T1_3');
162
+
163
+
164
+test 'Customized sub class constructor';
165
+$dbi = DBIx::Custom::T1_3->new(
166
+    user => 'a',
167
+    database => 'a',
168
+    password => 'b',
169
+    data_source => 'c',
170
+    options => {d => 1, e => 2},
171
+    filters => {
172
+        f => 3,
173
+    },
174
+    formats => {
175
+        f => 3,
176
+    },
177
+    bind_filter => 'f',
178
+    fetch_filter => 'g',
179
+    result_class => 'h',
180
+    sql_tmpl => $SQL_TMPL->{2},
181
+);
182
+is($dbi->user, 'a', "$test : user");
183
+is($dbi->database, 'a', "$test : database");
184
+is($dbi->password, 'b', "$test : password");
185
+is($dbi->data_source, 'c', "$test : data_source");
186
+is_deeply($dbi->options, {d => 1, e => 2}, "$test : options");
187
+is_deeply($dbi->filters, {f => 3}, "$test : filters");
188
+is_deeply($dbi->formats, {f => 3}, "$test : formats");
189
+is($dbi->bind_filter, 'f', "$test : bind_filter");
190
+is($dbi->fetch_filter, 'g', "$test : fetch_filter");
191
+is($dbi->result_class, 'h', "$test : result_class");
192
+is($dbi->sql_tmpl->tag_start, 2, "$test : sql_tmpl");
193
+isa_ok($dbi, 'DBIx::Custom');
194
+
195
+
196
+test 'add_filters';
197
+$dbi = DBIx::Custom->new;
198
+$dbi->add_filter(a => sub {1});
199
+is($dbi->filters->{a}->(), 1, $test);
200
+
201
+test 'add_formats';
202
+$dbi = DBIx::Custom->new;
203
+$dbi->add_format(a => sub {1});
204
+is($dbi->formats->{a}->(), 1, $test);
205
+
206
+test 'filter_off';
207
+$dbi = DBIx::Custom->new;
208
+$dbi->bind_filter('a');
209
+$dbi->fetch_filter('b');
210
+$dbi->filter_off;
211
+ok(!$dbi->bind_filter,  "$test : bind_filter  off");
212
+ok(!$dbi->fetch_filter, "$test : fetch_filter off");
213
+
214
+test 'Accessor';
215
+$dbi = DBIx::Custom->new;
216
+$dbi->options({opt1 => 1, opt2 => 2});
217
+is_deeply(scalar $dbi->options, {opt1 => 1, opt2 => 2}, "$test : options");
218
+
219
+$dbi->no_bind_filters(['a', 'b']);
220
+is_deeply(scalar $dbi->no_bind_filters, ['a', 'b'], "$test: no_bind_filters");
221
+
222
+$dbi->no_fetch_filters(['a', 'b']);
223
+is_deeply(scalar $dbi->no_fetch_filters, ['a', 'b'], "$test: no_fetch_filters");
+47
t/tmp/dbix-custom-mysql-private.t
... ...
@@ -0,0 +1,47 @@
1
+use Test::More;
2
+use strict;
3
+use warnings;
4
+
5
+# user password database
6
+our ($USER, $PASSWORD, $DATABASE) = connect_info();
7
+
8
+plan skip_all => 'private MySQL test' unless $USER;
9
+
10
+plan 'no_plan';
11
+
12
+# Function for test name
13
+my $test;
14
+sub test {
15
+    $test = shift;
16
+}
17
+
18
+
19
+# Functions for tests
20
+sub connect_info {
21
+    my $file = 'password.tmp';
22
+    open my $fh, '<', $file
23
+      or return;
24
+    
25
+    my ($user, $password, $database) = split(/\s/, (<$fh>)[0]);
26
+    
27
+    close $fh;
28
+    
29
+    return ($user, $password, $database);
30
+}
31
+
32
+
33
+# Constat variables for tests
34
+my $CLASS = 'DBIx::Custom::MySQL';
35
+
36
+# Varialbes for tests
37
+my $dbi;
38
+
39
+use DBIx::Custom::MySQL;
40
+
41
+test 'connect';
42
+$dbi = $CLASS->new(user => $USER, password => $PASSWORD,
43
+                    database => $DATABASE);
44
+$dbi->connect;
45
+is(ref $dbi->dbh, 'DBI::db', $test);
46
+
47
+
+85
t/tmp/dbix-custom-mysql-timeformat.t
... ...
@@ -0,0 +1,85 @@
1
+use Test::More;
2
+use strict;
3
+use warnings;
4
+
5
+BEGIN {
6
+    eval { require Time::Piece; 1 }
7
+        or plan skip_all => 'Time::Piece required';
8
+    
9
+    eval { Time::Piece->VERSION >= 1.15 }
10
+        or plan skip_all => 'Time::Piece >= 1.15 requred';
11
+        
12
+    plan 'no_plan';
13
+    use_ok('DBIx::Custom');
14
+}
15
+
16
+# Function for test name
17
+my $test;
18
+sub test {
19
+    $test = shift;
20
+}
21
+
22
+# Varialbe for tests
23
+
24
+my $format;
25
+my $data;
26
+my $timepiece;
27
+my $dbi;
28
+
29
+use DBIx::Custom::MySQL;
30
+
31
+
32
+test 'SQL99 format';
33
+$dbi = DBIx::Custom::MySQL->new;
34
+$data   = '2009-01-02 03:04:05';
35
+$format = $dbi->formats->{'SQL99_datetime'};
36
+$timepiece = Time::Piece->strptime($data, $format);
37
+is($timepiece->strftime('%Y-%m-%d'), '2009-01-02', "$test : datetime date");
38
+is($timepiece->strftime('%H:%M:%S'), '03:04:05',  "$test : datetime time");
39
+
40
+$data   = '2009-01-02';
41
+$format = $dbi->formats->{'SQL99_date'};
42
+$timepiece = Time::Piece->strptime($data, $format);
43
+is($timepiece->strftime('%Y-%m-%d'), '2009-01-02', "$test : date");
44
+
45
+$data   = '03:04:05';
46
+$format = $dbi->formats->{'SQL99_time'};
47
+$timepiece = Time::Piece->strptime($data, $format);
48
+is($timepiece->strftime('%H:%M:%S'), '03:04:05',  "$test : time");
49
+
50
+
51
+test 'ISO-8601 format';
52
+$data   = '2009-01-02T03:04:05';
53
+$format = $dbi->formats->{'ISO-8601_datetime'};
54
+$timepiece = Time::Piece->strptime($data, $format);
55
+is($timepiece->strftime('%Y-%m-%d'), '2009-01-02', "$test : datetime date");
56
+is($timepiece->strftime('%H:%M:%S'), '03:04:05',  "$test : datetime time");
57
+
58
+$data   = '2009-01-02';
59
+$format = $dbi->formats->{'ISO-8601_date'};
60
+$timepiece = Time::Piece->strptime($data, $format);
61
+is($timepiece->strftime('%Y-%m-%d'), '2009-01-02', "$test : date");
62
+
63
+$data   = '03:04:05';
64
+$format = $dbi->formats->{'ISO-8601_time'};
65
+$timepiece = Time::Piece->strptime($data, $format);
66
+is($timepiece->strftime('%H:%M:%S'), '03:04:05',  "$test : time");
67
+
68
+
69
+test 'default format';
70
+$data   = '2009-01-02 03:04:05';
71
+$format = $dbi->formats->{'datetime'};
72
+$timepiece = Time::Piece->strptime($data, $format);
73
+is($timepiece->strftime('%Y-%m-%d'), '2009-01-02', "$test : datetime date");
74
+is($timepiece->strftime('%H:%M:%S'), '03:04:05',  "$test : datetime time");
75
+
76
+$data   = '2009-01-02';
77
+$format = $dbi->formats->{'date'};
78
+$timepiece = Time::Piece->strptime($data, $format);
79
+is($timepiece->strftime('%Y-%m-%d'), '2009-01-02', "$test : date");
80
+
81
+$data   = '03:04:05';
82
+$format = $dbi->formats->{'time'};
83
+$timepiece = Time::Piece->strptime($data, $format);
84
+is($timepiece->strftime('%H:%M:%S'), '03:04:05',  "$test : time");
85
+
+37
t/tmp/dbix-custom-query.t
... ...
@@ -0,0 +1,37 @@
1
+use Test::More 'no_plan';
2
+
3
+use strict;
4
+use warnings;
5
+use DBIx::Custom::Query;
6
+
7
+# Function for test name
8
+my $test;
9
+sub test{
10
+    $test = shift;
11
+}
12
+
13
+# Variables for test
14
+my $query;
15
+
16
+test 'Accessors';
17
+$query = DBIx::Custom::Query->new(
18
+    sql              => 'a',
19
+    key_infos        => 'b',
20
+    bind_filter      => 'c',
21
+    no_bind_filters  => [qw/d e/],
22
+    sth              => 'e',
23
+    fetch_filter     => 'f',
24
+    no_fetch_filters => [qw/g h/],
25
+);
26
+
27
+is($query->sql, 'a', "$test : sql");
28
+is($query->key_infos, 'b', "$test : key_infos ");
29
+is($query->bind_filter, 'c', "$test : bind_filter");
30
+is_deeply($query->no_bind_filters, [qw/d e/], "$test : no_bind_filters");
31
+is_deeply($query->_no_bind_filters, {d => 1, e => 1}, "$test : _no_bind_filters");
32
+is_deeply($query->no_fetch_filters, [qw/g h/], "$test : no_fetch_filters");
33
+is($query->sth, 'e', "$test : sth");
34
+
35
+$query->no_bind_filters(undef);
36
+is_deeply(scalar $query->_no_bind_filters, {}, "$test _no_bind_filters undef value");
37
+
+259
t/tmp/dbix-custom-result-sqlite.t
... ...
@@ -0,0 +1,259 @@
1
+use Test::More;
2
+use strict;
3
+use warnings;
4
+use DBI;
5
+
6
+BEGIN {
7
+    eval { require DBD::SQLite; 1 }
8
+        or plan skip_all => 'DBD::SQLite required';
9
+    eval { DBD::SQLite->VERSION >= 1 }
10
+        or plan skip_all => 'DBD::SQLite >= 1.00 required';
11
+
12
+    plan 'no_plan';
13
+    use_ok('DBIx::Custom::Result');
14
+}
15
+
16
+my $test;
17
+sub test {
18
+    $test = shift;
19
+}
20
+
21
+sub query {
22
+    my ($dbh, $sql) = @_;
23
+    my $sth = $dbh->prepare($sql);
24
+    $sth->execute;
25
+    return DBIx::Custom::Result->new(sth => $sth);
26
+}
27
+
28
+my $dbh;
29
+my $sql;
30
+my $sth;
31
+my @row;
32
+my $row;
33
+my @rows;
34
+my $rows;
35
+my $result;
36
+my $fetch_filter;
37
+my @error;
38
+my $error;
39
+
40
+$dbh = DBI->connect('dbi:SQLite:dbname=:memory:', undef, undef, {PrintError => 0, RaiseError => 1});
41
+$dbh->do("create table table1 (key1 char(255), key2 char(255));");
42
+$dbh->do("insert into table1 (key1, key2) values ('1', '2');");
43
+$dbh->do("insert into table1 (key1, key2) values ('3', '4');");
44
+
45
+$sql = "select key1, key2 from table1";
46
+
47
+test 'fetch scalar context';
48
+$result = query($dbh, $sql);
49
+@rows = ();
50
+while (my $row = $result->fetch) {
51
+    push @rows, [@$row];
52
+}
53
+is_deeply(\@rows, [[1, 2], [3, 4]], $test);
54
+
55
+
56
+test 'fetch list context';
57
+$result = query($dbh, $sql);
58
+@rows = ();
59
+while (my @row = $result->fetch) {
60
+    push @rows, [@row];
61
+}
62
+is_deeply(\@rows, [[1, 2], [3, 4]], $test);
63
+
64
+test 'fetch_hash scalar context';
65
+$result = query($dbh, $sql);
66
+@rows = ();
67
+while (my $row = $result->fetch_hash) {
68
+    push @rows, {%$row};
69
+}
70
+is_deeply(\@rows, [{key1 => 1, key2 => 2}, {key1 => 3, key2 => 4}], $test);
71
+
72
+
73
+test 'fetch hash list context';
74
+$result = query($dbh, $sql);
75
+@rows = ();
76
+while (my %row = $result->fetch_hash) {
77
+    push @rows, {%row};
78
+}
79
+is_deeply(\@rows, [{key1 => 1, key2 => 2}, {key1 => 3, key2 => 4}], $test);
80
+
81
+
82
+test 'fetch_single';
83
+$result = query($dbh, $sql);
84
+$row = $result->fetch_single;
85
+is_deeply($row, [1, 2], "$test : row");
86
+$row = $result->fetch;
87
+ok(!$row, "$test : finished");
88
+
89
+
90
+test 'fetch_single list context';
91
+$result = query($dbh, $sql);
92
+@row = $result->fetch_single;
93
+is_deeply([@row], [1, 2], "$test : row");
94
+@row = $result->fetch;
95
+ok(!@row, "$test : finished");
96
+
97
+
98
+test 'fetch_hash_single';
99
+$result = query($dbh, $sql);
100
+$row = $result->fetch_hash_single;
101
+is_deeply($row, {key1 => 1, key2 => 2}, "$test : row");
102
+$row = $result->fetch_hash;
103
+ok(!$row, "$test : finished");
104
+
105
+
106
+test 'fetch_hash_single list context';
107
+$result = query($dbh, $sql);
108
+@row = $result->fetch_hash_single;
109
+is_deeply({@row}, {key1 => 1, key2 => 2}, "$test : row");
110
+@row = $result->fetch_hash;
111
+ok(!@row, "$test : finished");
112
+
113
+
114
+test 'fetch_rows';
115
+$dbh->do("insert into table1 (key1, key2) values ('5', '6');");
116
+$dbh->do("insert into table1 (key1, key2) values ('7', '8');");
117
+$dbh->do("insert into table1 (key1, key2) values ('9', '10');");
118
+$result = query($dbh, $sql);
119
+$rows = $result->fetch_rows(2);
120
+is_deeply($rows, [[1, 2],
121
+                  [3, 4]], "$test : fetch_rows first");
122
+$rows = $result->fetch_rows(2);
123
+is_deeply($rows, [[5, 6],
124
+                  [7, 8]], "$test : fetch_rows secound");
125
+$rows = $result->fetch_rows(2);
126
+is_deeply($rows, [[9, 10]], "$test : fetch_rows third");
127
+$rows = $result->fetch_rows(2);
128
+ok(!$rows);
129
+
130
+
131
+test 'fetch_rows list context';
132
+$result = query($dbh, $sql);
133
+@rows = $result->fetch_rows(2);
134
+is_deeply([@rows], [[1, 2],
135
+                  [3, 4]], "$test : fetch_rows first");
136
+@rows = $result->fetch_rows(2);
137
+is_deeply([@rows], [[5, 6],
138
+                  [7, 8]], "$test : fetch_rows secound");
139
+@rows = $result->fetch_rows(2);
140
+is_deeply([@rows], [[9, 10]], "$test : fetch_rows third");
141
+@rows = $result->fetch_rows(2);
142
+ok(!@rows);
143
+
144
+
145
+test 'fetch_rows error';
146
+$result = query($dbh, $sql);
147
+eval {$result->fetch_rows};
148
+like($@, qr/Row count must be specified/, "$test : Not specified row count");
149
+
150
+
151
+test 'fetch_hash_rows';
152
+$result = query($dbh, $sql);
153
+$rows = $result->fetch_hash_rows(2);
154
+is_deeply($rows, [{key1 => 1, key2 => 2},
155
+                  {key1 => 3, key2 => 4}], "$test : fetch_rows first");
156
+$rows = $result->fetch_hash_rows(2);
157
+is_deeply($rows, [{key1 => 5, key2 => 6},
158
+                  {key1 => 7, key2 => 8}], "$test : fetch_rows secound");
159
+$rows = $result->fetch_hash_rows(2);
160
+is_deeply($rows, [{key1 => 9, key2 => 10}], "$test : fetch_rows third");
161
+$rows = $result->fetch_hash_rows(2);
162
+ok(!$rows);
163
+
164
+
165
+test 'fetch_rows list context';
166
+$result = query($dbh, $sql);
167
+@rows = $result->fetch_hash_rows(2);
168
+is_deeply([@rows], [{key1 => 1, key2 => 2},
169
+                    {key1 => 3, key2 => 4}], "$test : fetch_rows first");
170
+@rows = $result->fetch_hash_rows(2);
171
+is_deeply([@rows], [{key1 => 5, key2 => 6},
172
+                    {key1 => 7, key2 => 8}], "$test : fetch_rows secound");
173
+@rows = $result->fetch_hash_rows(2);
174
+is_deeply([@rows], [{key1 => 9, key2 => 10}], "$test : fetch_rows third");
175
+@rows = $result->fetch_hash_rows(2);
176
+ok(!@rows);
177
+$dbh->do("delete from table1 where key1 = 5 or key1 = 7 or key1 = 9");
178
+
179
+
180
+test 'fetch_rows error';
181
+$result = query($dbh, $sql);
182
+eval {$result->fetch_hash_rows};
183
+like($@, qr/Row count must be specified/, "$test : Not specified row count");
184
+
185
+
186
+test 'fetch_all';
187
+$result = query($dbh, $sql);
188
+$rows = $result->fetch_all;
189
+is_deeply($rows, [[1, 2], [3, 4]], $test);
190
+
191
+test 'fetch_all list context';
192
+$result = query($dbh, $sql);
193
+@rows = $result->fetch_all;
194
+is_deeply(\@rows, [[1, 2], [3, 4]], $test);
195
+
196
+
197
+test 'fetch_hash_all';
198
+$result = query($dbh, $sql);
199
+@rows = $result->fetch_hash_all;
200
+is_deeply($rows, [[1, 2], [3, 4]], $test);
201
+
202
+
203
+test 'fetch_hash_all list context';
204
+$result = query($dbh, $sql);
205
+@rows = $result->fetch_all;
206
+is_deeply(\@rows, [[1, 2], [3, 4]], $test);
207
+
208
+
209
+test 'fetch filter';
210
+$fetch_filter = sub {
211
+    my ($value, $key, $dbi, $infos) = @_;
212
+    my ($type, $sth, $i) = @{$infos}{qw/type sth index/};
213
+    
214
+    if ($key eq 'key1' && $value == 1 && $type =~ /char/i && $i == 0 && $sth->{TYPE}->[$i] eq $type) {
215
+        return $value * 3;
216
+    }
217
+    return $value;
218
+};
219
+
220
+$result = query($dbh, $sql);
221
+$result->fetch_filter($fetch_filter);
222
+$rows = $result->fetch_all;
223
+is_deeply($rows, [[3, 2], [3, 4]], "$test array");
224
+
225
+$result = query($dbh, $sql);
226
+$result->fetch_filter($fetch_filter);
227
+$rows = $result->fetch_hash_all;
228
+is_deeply($rows, [{key1 => 3, key2 => 2}, {key1 => 3, key2 => 4}], "$test hash");
229
+
230
+$result = query($dbh, $sql);
231
+$result->no_fetch_filters(['key1']);
232
+$rows = $result->fetch_all;
233
+is_deeply($rows, [[1, 2], [3, 4]], "$test array no filter keys");
234
+
235
+$result = query($dbh, $sql);
236
+$result->no_fetch_filters(['key1']);
237
+$rows = $result->fetch_hash_all;
238
+is_deeply($rows, [{key1 => 1, key2 => 2}, {key1 => 3, key2 => 4}], "$test hash no filter keys");
239
+
240
+
241
+test 'finish';
242
+$result = query($dbh, $sql);
243
+$result->fetch;
244
+$result->finish;
245
+ok(!$result->fetch, $test);
246
+
247
+test 'error'; # Cannot real test
248
+$result = query($dbh, $sql);
249
+$sth = $result->sth;
250
+
251
+@error = $result->error;
252
+is(scalar @error, 3, "$test list context count");
253
+is($error[0], $sth->errstr, "$test list context errstr");
254
+is($error[1], $sth->err, "$test list context err");
255
+is($error[2], $sth->state, "$test list context state");
256
+
257
+$error = $result->error;
258
+is($error, $sth->errstr, "$test scalar context");
259
+
+198
t/tmp/dbix-custom-sql-template.t
... ...
@@ -0,0 +1,198 @@
1
+use strict;
2
+use warnings;
3
+
4
+use Test::More 'no_plan';
5
+
6
+use DBIx::Custom::SQL::Template;
7
+
8
+# Function for test name
9
+my $test;
10
+sub test{
11
+    $test = shift;
12
+}
13
+
14
+# Variable for test
15
+my $datas;
16
+my $sql_tmpl;
17
+my $query;
18
+my $ret_val;
19
+my $clone;
20
+
21
+test "Various template pattern";
22
+$datas = [
23
+    # Basic tests
24
+    {   name            => 'placeholder basic',
25
+        tmpl            => "a {?  k1} b {=  k2} {<> k3} {>  k4} {<  k5} {>= k6} {<= k7} {like k8}", ,
26
+        sql_expected    => "a ? b k2 = ? k3 <> ? k4 > ? k5 < ? k6 >= ? k7 <= ? k8 like ?;",
27
+        key_infos_expected   => [
28
+            {original_key => 'k1', table => '', column => 'k1', access_keys => [['k1']]},
29
+            {original_key => 'k2', table => '', column => 'k2', access_keys => [['k2']]},
30
+            {original_key => 'k3', table => '', column => 'k3', access_keys => [['k3']]},
31
+            {original_key => 'k4', table => '', column => 'k4', access_keys => [['k4']]},
32
+            {original_key => 'k5', table => '', column => 'k5', access_keys => [['k5']]},
33
+            {original_key => 'k6', table => '', column => 'k6', access_keys => [['k6']]},
34
+            {original_key => 'k7', table => '', column => 'k7', access_keys => [['k7']]},
35
+            {original_key => 'k8', table => '', column => 'k8', access_keys => [['k8']]},
36
+        ],
37
+    },
38
+    {
39
+        name            => 'placeholder in',
40
+        tmpl            => "{in k1 3};",
41
+        sql_expected    => "k1 in (?, ?, ?);",
42
+        key_infos_expected   => [
43
+            {original_key => 'k1', table => '', column => 'k1', access_keys => [['k1', [0]]]},
44
+            {original_key => 'k1', table => '', column => 'k1', access_keys => [['k1', [1]]]},
45
+            {original_key => 'k1', table => '', column => 'k1', access_keys => [['k1', [2]]]},
46
+        ],
47
+    },
48
+    
49
+    # Table name
50
+    {
51
+        name            => 'placeholder with table name',
52
+        tmpl            => "{= a.k1} {= a.k2}",
53
+        sql_expected    => "a.k1 = ? a.k2 = ?;",
54
+        key_infos_expected  => [
55
+            {original_key => 'a.k1', table => 'a', column => 'k1', access_keys => [['a.k1'], ['a', 'k1']]},
56
+            {original_key => 'a.k2', table => 'a', column => 'k2', access_keys => [['a.k2'], ['a', 'k2']]},
57
+        ],
58
+    },
59
+    {   
60
+        name            => 'placeholder in with table name',
61
+        tmpl            => "{in a.k1 2} {in b.k2 2}",
62
+        sql_expected    => "a.k1 in (?, ?) b.k2 in (?, ?);",
63
+        key_infos_expected  => [
64
+            {original_key => 'a.k1', table => 'a', column => 'k1', access_keys => [['a.k1', [0]], ['a', 'k1', [0]]]},
65
+            {original_key => 'a.k1', table => 'a', column => 'k1', access_keys => [['a.k1', [1]], ['a', 'k1', [1]]]},
66
+            {original_key => 'b.k2', table => 'b', column => 'k2', access_keys => [['b.k2', [0]], ['b', 'k2', [0]]]},
67
+            {original_key => 'b.k2', table => 'b', column => 'k2', access_keys => [['b.k2', [1]], ['b', 'k2', [1]]]},
68
+        ],
69
+    },
70
+    {
71
+        name            => 'not contain tag',
72
+        tmpl            => "aaa",
73
+        sql_expected    => "aaa;",
74
+        key_infos_expected  => [],
75
+    }
76
+];
77
+
78
+for (my $i = 0; $i < @$datas; $i++) {
79
+    my $data = $datas->[$i];
80
+    my $sql_tmpl = DBIx::Custom::SQL::Template->new;
81
+    my $query = $sql_tmpl->create_query($data->{tmpl});
82
+    is($query->{sql}, $data->{sql_expected}, "$test : $data->{name} : sql");
83
+    is_deeply($query->{key_infos}, $data->{key_infos_expected}, "$test : $data->{name} : key_infos");
84
+}
85
+
86
+
87
+test 'Original tag processor';
88
+$sql_tmpl = DBIx::Custom::SQL::Template->new;
89
+
90
+$ret_val = $sql_tmpl->add_tag_processor(
91
+    p => sub {
92
+        my ($tag_name, $args) = @_;
93
+        
94
+        my $expand    = "$tag_name ? $args->[0] $args->[1]";
95
+        my $key_infos = [2];
96
+        return ($expand, $key_infos);
97
+    }
98
+);
99
+
100
+$query = $sql_tmpl->create_query("{p a b}");
101
+is($query->{sql}, "p ? a b;", "$test : add_tag_processor sql");
102
+is_deeply($query->{key_infos}, [2], "$test : add_tag_processor key_infos");
103
+isa_ok($ret_val, 'DBIx::Custom::SQL::Template');
104
+
105
+
106
+test "Tag processor error case";
107
+$sql_tmpl = DBIx::Custom::SQL::Template->new;
108
+
109
+
110
+eval{$sql_tmpl->create_query("{a }")};
111
+like($@, qr/Tag '{a }' in SQL template is not exist/, "$test : tag_processor not exist");
112
+
113
+$sql_tmpl->add_tag_processor({
114
+    q => 'string'
115
+});
116
+
117
+eval{$sql_tmpl->create_query("{q}", {})};
118
+like($@, qr/Tag processor 'q' must be code reference/, "$test : tag_processor not code ref");
119
+
120
+$sql_tmpl->add_tag_processor({
121
+   r => sub {} 
122
+});
123
+
124
+eval{$sql_tmpl->create_query("{r}")};
125
+like($@, qr/\QTag processor 'r' must return (\E\$expand\Q, \E\$key_infos\Q)/, "$test : tag processor return noting");
126
+
127
+$sql_tmpl->add_tag_processor({
128
+   s => sub { return ("a", "")} 
129
+});
130
+
131
+eval{$sql_tmpl->create_query("{s}")};
132
+like($@, qr/\QTag processor 's' must return (\E\$expand\Q, \E\$key_infos\Q)/, "$test : tag processor return not array key_infos");
133
+
134
+$sql_tmpl->add_tag_processor(
135
+    t => sub {return ("a", [])}
136
+);
137
+
138
+eval{$sql_tmpl->create_query("{t ???}")};
139
+like($@, qr/Tag '{t }' arguments cannot contain '?'/, "$test : cannot contain '?' in tag argument");
140
+
141
+
142
+test 'General error case';
143
+$sql_tmpl = DBIx::Custom::SQL::Template->new;
144
+$sql_tmpl->add_tag_processor(
145
+    a => sub {
146
+        return ("? ? ?", [[],[]]);
147
+    }
148
+);
149
+eval{$sql_tmpl->create_query("{a}")};
150
+like($@, qr/Placeholder count in SQL created by tag processor 'a' must be same as key informations count/, "$test placeholder count is invalid");
151
+
152
+
153
+test 'Default tag processor Error case';
154
+eval{$sql_tmpl->create_query("{= }")};
155
+like($@, qr/You must be pass key as argument to tag '{= }'/, "$test : basic '=' : key not exist");
156
+
157
+eval{$sql_tmpl->create_query("{in }")};
158
+like($@, qr/You must be pass key as first argument of tag '{in }'/, "$test : in : key not exist");
159
+
160
+eval{$sql_tmpl->create_query("{in a}")};
161
+like($@, qr/\QYou must be pass placeholder count as second argument of tag '{in }'\E\n\QUsage: {in \E\$key\Q \E\$placeholder_count\Q}/,
162
+     "$test : in : key not exist");
163
+
164
+eval{$sql_tmpl->create_query("{in a r}")};
165
+like($@, qr/\QYou must be pass placeholder count as second argument of tag '{in }'\E\n\QUsage: {in \E\$key\Q \E\$placeholder_count\Q}/,
166
+     "$test : in : key not exist");
167
+
168
+
169
+test 'Clone';
170
+$sql_tmpl = DBIx::Custom::SQL::Template->new;
171
+$sql_tmpl
172
+  ->tag_start('[')
173
+  ->tag_end(']')
174
+  ->tag_syntax('syntax')
175
+  ->tag_processors({a => 1, b => 2});
176
+
177
+$clone = $sql_tmpl->clone;
178
+is($clone->tag_start, $sql_tmpl->tag_start, "$test : tag_start");
179
+is($clone->tag_end, $sql_tmpl->tag_end, "$test : tag_end");
180
+is($clone->tag_syntax, $sql_tmpl->tag_syntax, "$test : tag_syntax");
181
+
182
+is_deeply( scalar $clone->tag_processors, scalar $sql_tmpl->tag_processors,
183
+          "$test : tag_processors deep clone");
184
+
185
+isnt($clone->tag_processors, $sql_tmpl->tag_processors, 
186
+     "$test : tag_processors reference not copy");
187
+
188
+$sql_tmpl->tag_processors(undef);
189
+
190
+$clone = $sql_tmpl->clone;
191
+is_deeply(scalar $clone->tag_processors, {}, "$test tag_processor undef copy");
192
+
193
+
194
+
195
+__END__
196
+
197
+
198
+
+85
t/tmp/dbix-custom-sqlite-timeformat.t
... ...
@@ -0,0 +1,85 @@
1
+use Test::More;
2
+use strict;
3
+use warnings;
4
+
5
+BEGIN {
6
+    eval { require Time::Piece; 1 }
7
+        or plan skip_all => 'Time::Piece required';
8
+    
9
+    eval { Time::Piece->VERSION >= 1.15 }
10
+        or plan skip_all => 'Time::Piece >= 1.15 requred';
11
+        
12
+    plan 'no_plan';
13
+    use_ok('DBIx::Custom');
14
+}
15
+
16
+# Function for test name
17
+my $test;
18
+sub test {
19
+    $test = shift;
20
+}
21
+
22
+# Varialbe for tests
23
+
24
+my $format;
25
+my $data;
26
+my $timepiece;
27
+my $dbi;
28
+
29
+use DBIx::Custom::SQLite;
30
+
31
+
32
+test 'SQL99 format';
33
+$dbi = DBIx::Custom::SQLite->new;
34
+$data   = '2009-01-02 03:04:05';
35
+$format = $dbi->formats->{'SQL99_datetime'};
36
+$timepiece = Time::Piece->strptime($data, $format);
37
+is($timepiece->strftime('%Y-%m-%d'), '2009-01-02', "$test : datetime date");
38
+is($timepiece->strftime('%H:%M:%S'), '03:04:05',  "$test : datetime time");
39
+
40
+$data   = '2009-01-02';
41
+$format = $dbi->formats->{'SQL99_date'};
42
+$timepiece = Time::Piece->strptime($data, $format);
43
+is($timepiece->strftime('%Y-%m-%d'), '2009-01-02', "$test : date");
44
+
45
+$data   = '03:04:05';
46
+$format = $dbi->formats->{'SQL99_time'};
47
+$timepiece = Time::Piece->strptime($data, $format);
48
+is($timepiece->strftime('%H:%M:%S'), '03:04:05',  "$test : time");
49
+
50
+
51
+test 'ISO-8601 format';
52
+$data   = '2009-01-02T03:04:05';
53
+$format = $dbi->formats->{'ISO-8601_datetime'};
54
+$timepiece = Time::Piece->strptime($data, $format);
55
+is($timepiece->strftime('%Y-%m-%d'), '2009-01-02', "$test : datetime date");
56
+is($timepiece->strftime('%H:%M:%S'), '03:04:05',  "$test : datetime time");
57
+
58
+$data   = '2009-01-02';
59
+$format = $dbi->formats->{'ISO-8601_date'};
60
+$timepiece = Time::Piece->strptime($data, $format);
61
+is($timepiece->strftime('%Y-%m-%d'), '2009-01-02', "$test : date");
62
+
63
+$data   = '03:04:05';
64
+$format = $dbi->formats->{'ISO-8601_time'};
65
+$timepiece = Time::Piece->strptime($data, $format);
66
+is($timepiece->strftime('%H:%M:%S'), '03:04:05',  "$test : time");
67
+
68
+
69
+test 'default format';
70
+$data   = '2009-01-02 03:04:05';
71
+$format = $dbi->formats->{'datetime'};
72
+$timepiece = Time::Piece->strptime($data, $format);
73
+is($timepiece->strftime('%Y-%m-%d'), '2009-01-02', "$test : datetime date");
74
+is($timepiece->strftime('%H:%M:%S'), '03:04:05',  "$test : datetime time");
75
+
76
+$data   = '2009-01-02';
77
+$format = $dbi->formats->{'date'};
78
+$timepiece = Time::Piece->strptime($data, $format);
79
+is($timepiece->strftime('%Y-%m-%d'), '2009-01-02', "$test : date");
80
+
81
+$data   = '03:04:05';
82
+$format = $dbi->formats->{'time'};
83
+$timepiece = Time::Piece->strptime($data, $format);
84
+is($timepiece->strftime('%H:%M:%S'), '03:04:05',  "$test : time");
85
+
+79
t/tmp/dbix-custom-sqlite.t
... ...
@@ -0,0 +1,79 @@
1
+use Test::More;
2
+use strict;
3
+use warnings;
4
+use utf8;
5
+
6
+BEGIN {
7
+    eval { require DBD::SQLite; 1 }
8
+        or plan skip_all => 'DBD::SQLite required';
9
+    eval { DBD::SQLite->VERSION >= 1.25 }
10
+        or plan skip_all => 'DBD::SQLite >= 1.25 required';
11
+
12
+    plan 'no_plan';
13
+    use_ok('DBIx::Custom::SQLite');
14
+}
15
+
16
+# Function for test name
17
+my $test;
18
+sub test {
19
+    $test = shift;
20
+}
21
+
22
+# Constant varialbes for test
23
+my $CREATE_TABLE = {
24
+    0 => 'create table table1 (key1 char(255), key2 char(255));',
25
+    1 => 'create table table1 (key1 char(255), key2 char(255), key3 char(255), key4 char(255), key5 char(255));',
26
+    2 => 'create table table2 (key1 char(255), key3 char(255));'
27
+};
28
+
29
+
30
+# Variables for tests
31
+my $dbi;
32
+my $ret_val;
33
+my $rows;
34
+my $db_file;
35
+my $id;
36
+
37
+test 'connect_memory';
38
+$dbi = DBIx::Custom::SQLite->new;
39
+$dbi->connect_memory;
40
+$ret_val = $dbi->do($CREATE_TABLE->{0});
41
+ok(defined $ret_val, $test);
42
+$dbi->utf8_filter_on;
43
+$dbi->insert('table1', {key1 => 'あ', key2 => 2});
44
+$rows = $dbi->select('table1', {key1 => 'あ'})->fetch_hash_all;
45
+is_deeply($rows, [{key1 => 'あ', key2 => 2}], "$test : select rows");
46
+
47
+test 'connect_memory error';
48
+eval{$dbi->connect_memory};
49
+like($@, qr/Already connected/, "$test : already connected");
50
+
51
+test 'reconnect_memory';
52
+$dbi = DBIx::Custom::SQLite->new;
53
+$dbi->reconnect_memory;
54
+$ret_val = $dbi->do($CREATE_TABLE->{0});
55
+ok(defined $ret_val, "$test : connect first");
56
+$dbi->reconnect_memory;
57
+$ret_val = $dbi->do($CREATE_TABLE->{2});
58
+ok(defined $ret_val, "$test : connect first");
59
+
60
+test 'connect';
61
+$db_file  = 't/test.db';
62
+unlink $db_file if -f $db_file;
63
+$dbi = DBIx::Custom::SQLite->new(database => $db_file);
64
+$dbi->connect;
65
+ok(-f $db_file, "$test : database file");
66
+$ret_val = $dbi->do($CREATE_TABLE->{0});
67
+ok(defined $ret_val, "$test : database");
68
+$dbi->disconnect;
69
+unlink $db_file if -f $db_file;
70
+
71
+test 'last_insert_rowid';
72
+$dbi = DBIx::Custom::SQLite->new;
73
+$dbi->connect_memory;
74
+$ret_val = $dbi->do($CREATE_TABLE->{0});
75
+$dbi->insert('table1', {key1 => 1, key2 => 2});
76
+is($dbi->last_insert_rowid, 1, "$test: first");
77
+$dbi->insert('table1', {key1 => 1, key2 => 2});
78
+is($dbi->last_insert_rowid, 2, "$test: second");
79
+$dbi->disconnect;