Showing 11 changed files with 711 additions and 1305 deletions
+236 -353
lib/DBIx/Custom.pm
... ...
@@ -23,11 +23,17 @@ __PACKAGE__->attr([qw/user password data_source/]);
23 23
 __PACKAGE__->attr([qw/database host port/]);
24 24
 __PACKAGE__->attr([qw/default_query_filter default_fetch_filter options/]);
25 25
 
26
-__PACKAGE__->dual_attr([qw/ filters formats/],
27
-                       default => sub { {} }, inherit => 'hash_copy');
26
+__PACKAGE__->dual_attr('filters', default => sub { {} },
27
+                                  inherit => 'hash_copy');
28
+__PACKAGE__->register_filter(
29
+    encode_utf8 => sub { encode('UTF-8', $_[0]) },
30
+    decode_utf8 => sub { decode('UTF-8', $_[0]) }
31
+);
28 32
 
29 33
 __PACKAGE__->attr(result_class => 'DBIx::Custom::Result');
30
-__PACKAGE__->attr(sql_tmpl => sub { DBIx::Custom::SQLTemplate->new });
34
+__PACKAGE__->attr(sql_template => sub { DBIx::Custom::SQLTemplate->new });
35
+
36
+
31 37
 
32 38
 sub register_filter {
33 39
     my $invocant = shift;
... ...
@@ -39,21 +45,11 @@ sub register_filter {
39 45
     return $invocant;
40 46
 }
41 47
 
42
-sub register_format{
43
-    my $invocant = shift;
44
-    
45
-    # Add format
46
-    my $formats = ref $_[0] eq 'HASH' ? $_[0] : {@_};
47
-    $invocant->formats({%{$invocant->formats}, %$formats});
48
-
49
-    return $invocant;
50
-}
51
-
52
-sub _auto_commit {
48
+sub auto_commit {
53 49
     my $self = shift;
54 50
     
55 51
     # Not connected
56
-    croak("Not yet connect to database") unless $self->dbh;
52
+    croak("Not yet connect to database") unless $self->connected;
57 53
     
58 54
     if (@_) {
59 55
         
... ...
@@ -66,7 +62,10 @@ sub _auto_commit {
66 62
 }
67 63
 
68 64
 sub connect {
69
-    my $self = shift;
65
+    my $proto = shift;
66
+    
67
+    # Create
68
+    my $self = ref $proto ? $proto : $proto->new(@_);
70 69
     
71 70
     # Information
72 71
     my $data_source = $self->data_source;
... ...
@@ -138,7 +137,7 @@ sub create_query {
138 137
     }
139 138
     
140 139
     # Create query from SQL template
141
-    my $sql_tmpl = $self->sql_tmpl;
140
+    my $sql_template = $self->sql_template;
142 141
     
143 142
     # Try to get cached query
144 143
     my $cached_query = $class->_query_caches->{"$template"};
... ...
@@ -152,7 +151,7 @@ sub create_query {
152 151
         );
153 152
     }
154 153
     else {
155
-        $query = eval{$sql_tmpl->create_query($template)};
154
+        $query = eval{$sql_template->create_query($template)};
156 155
         croak($@) if $@;
157 156
         
158 157
         $class->_add_query_cache("$template", $query);
... ...
@@ -170,9 +169,22 @@ sub create_query {
170 169
     return $query;
171 170
 }
172 171
 
172
+our %VALID_EXECUTE_ARGS = map { $_ => 1 } qw/param filter/;
173
+
173 174
 sub execute{
174
-    my ($self, $query, $params, $args)  = @_;
175
-    $params ||= {};
175
+    my $self  = shift;
176
+    my $query = shift;
177
+    
178
+    # Arguments
179
+    my $args = ref $_[0] eq 'HASH' ? $_[0] : {@_};
180
+    
181
+    # Check arguments
182
+    foreach my $name (keys %$args) {
183
+        croak "\"$name\" is invalid name"
184
+          unless $VALID_EXECUTE_ARGS{$name};
185
+    }
186
+    
187
+    my $params = $args->{param} || {};
176 188
     
177 189
     # First argument is SQL template
178 190
     unless (ref $query eq 'DBIx::Custom::Query') {
... ...
@@ -185,10 +197,9 @@ sub execute{
185 197
         
186 198
         $query = $self->create_query($template);
187 199
     }
188
-
189
-    # Filter
200
+    
190 201
     my $filter = $args->{filter} || $query->filter || {};
191
-
202
+    
192 203
     # Create bind value
193 204
     my $bind_values = $self->_build_bind_values($query, $params, $filter);
194 205
     
... ...
@@ -272,119 +283,28 @@ sub _build_bind_values {
272 283
     return \@bind_values;
273 284
 }
274 285
 
275
-sub run_transaction {
276
-    my ($self, $transaction) = @_;
277
-    
278
-    # Shorcut
279
-    return unless $self;
280
-    
281
-    # Check auto commit
282
-    croak("AutoCommit must be true before transaction start")
283
-      unless $self->_auto_commit;
284
-    
285
-    # Auto commit off
286
-    $self->_auto_commit(0);
287
-    
288
-    # Run transaction
289
-    eval {$transaction->()};
290
-    
291
-    # Tranzaction error
292
-    my $transaction_error = $@;
293
-    
294
-    # Tranzaction is failed.
295
-    if ($transaction_error) {
296
-        # Rollback
297
-        eval{$self->dbh->rollback};
298
-        
299
-        # Rollback error
300
-        my $rollback_error = $@;
301
-        
302
-        # Auto commit on
303
-        $self->_auto_commit(1);
304
-        
305
-        if ($rollback_error) {
306
-            # Rollback is failed
307
-            croak("${transaction_error}Rollback is failed : $rollback_error");
308
-        }
309
-        else {
310
-            # Rollback is success
311
-            croak("${transaction_error}Rollback is success");
312
-        }
313
-    }
314
-    # Tranzaction is success
315
-    else {
316
-        # Commit
317
-        eval{$self->dbh->commit};
318
-        my $commit_error = $@;
319
-        
320
-        # Auto commit on
321
-        $self->_auto_commit(1);
322
-        
323
-        # Commit is failed
324
-        croak($commit_error) if $commit_error;
325
-    }
326
-}
327
-
328
-sub create_table {
329
-    my ($self, $table, @column_definitions) = @_;
330
-    
331
-    # Create table
332
-    my $sql = "create table $table (";
333
-    
334
-    # Column definitions
335
-    foreach my $column_definition (@column_definitions) {
336
-        $sql .= "$column_definition,";
337
-    }
338
-    $sql =~ s/,$//;
339
-    
340
-    # End
341
-    $sql .= ");";
342
-    
343
-    # Connect
344
-    $self->connect unless $self->connected;
345
-    
346
-    # Do query
347
-    return $self->dbh->do($sql);
348
-}
349
-
350
-sub drop_table {
351
-    my ($self, $table) = @_;
352
-    
353
-    # Drop table
354
-    my $sql = "drop table $table;";
355
-
356
-    # Connect
357
-    $self->connect unless $self->connected;
358
-
359
-    # Do query
360
-    return $self->dbh->do($sql);
361
-}
362
-
363
-our %VALID_INSERT_ARGS = map { $_ => 1 } qw/append filter/;
286
+our %VALID_INSERT_ARGS = map { $_ => 1 } qw/table param append filter/;
364 287
 
365 288
 sub insert {
366
-    my ($self, $table, $insert_params, $args) = @_;
367
-    
368
-    # Table
369
-    $table ||= '';
370
-    
371
-    # Insert params
372
-    $insert_params ||= {};
289
+    my $self = shift;
373 290
     
374 291
     # Arguments
375
-    $args ||= {};
376
-    
292
+    my $args = ref $_[0] eq 'HASH' ? $_[0] : {@_};
293
+
377 294
     # Check arguments
378 295
     foreach my $name (keys %$args) {
379 296
         croak "\"$name\" is invalid name"
380 297
           unless $VALID_INSERT_ARGS{$name};
381 298
     }
382 299
     
383
-    my $append_statement = $args->{append} || '';
384
-    my $filter           = $args->{filter};
300
+    # Arguments
301
+    my $table  = $args->{table} || '';
302
+    my $param  = $args->{param} || {};
303
+    my $append = $args->{append} || '';
304
+    my $filter = $args->{filter};
385 305
     
386 306
     # Insert keys
387
-    my @insert_keys = keys %$insert_params;
307
+    my @insert_keys = keys %$param;
388 308
     
389 309
     # Not exists insert keys
390 310
     croak("Key-value pairs for insert must be specified to 'insert' second argument")
... ...
@@ -392,19 +312,22 @@ sub insert {
392 312
     
393 313
     # Templte for insert
394 314
     my $template = "insert into $table {insert " . join(' ', @insert_keys) . '}';
395
-    $template .= " $append_statement" if $append_statement;
315
+    $template .= " $append" if $append;
396 316
     
397 317
     # Execute query
398
-    my $ret_val = $self->execute($template, $insert_params, {filter => $filter});
318
+    my $ret_val = $self->execute($template, param  => $param, 
319
+                                            filter => $filter);
399 320
     
400 321
     return $ret_val;
401 322
 }
402 323
 
403 324
 our %VALID_UPDATE_ARGS
404
-  = map { $_ => 1 } qw/where append filter allow_update_all/;
325
+  = map { $_ => 1 } qw/table param where append filter allow_update_all/;
405 326
 
406 327
 sub update {
407
-    my ($self, $table, $params, $args) = @_;
328
+    my $self = shift;
329
+
330
+    my $args = ref $_[0] eq 'HASH' ? $_[0] : {@_};
408 331
     
409 332
     # Check arguments
410 333
     foreach my $name (keys %$args) {
... ...
@@ -413,20 +336,22 @@ sub update {
413 336
     }
414 337
     
415 338
     # Arguments
416
-    my $where_params     = $args->{where} || {};
339
+    my $table            = $args->{table} || '';
340
+    my $param            = $args->{param} || {};
341
+    my $where            = $args->{where} || {};
417 342
     my $append_statement = $args->{append} || '';
418 343
     my $filter           = $args->{filter};
419 344
     my $allow_update_all = $args->{allow_update_all};
420 345
     
421 346
     # Update keys
422
-    my @update_keys = keys %$params;
347
+    my @update_keys = keys %$param;
423 348
     
424 349
     # Not exists update kyes
425 350
     croak("Key-value pairs for update must be specified to 'update' second argument")
426 351
       unless @update_keys;
427 352
     
428 353
     # Where keys
429
-    my @where_keys = keys %$where_params;
354
+    my @where_keys = keys %$where;
430 355
     
431 356
     # Not exists where keys
432 357
     croak("Key-value pairs for where clause must be specified to 'update' third argument")
... ...
@@ -453,45 +378,48 @@ sub update {
453 378
     $template .= " $append_statement" if $append_statement;
454 379
     
455 380
     # Rearrange parammeters
456
-    foreach my $where_key (@where_keys) {
381
+    foreach my $wkey (@where_keys) {
457 382
         
458
-        if (exists $params->{$where_key}) {
459
-            $params->{$where_key} = [$params->{$where_key}]
460
-              unless ref $params->{$where_key} eq 'ARRAY';
383
+        if (exists $param->{$wkey}) {
384
+            $param->{$wkey} = [$param->{$wkey}]
385
+              unless ref $param->{$wkey} eq 'ARRAY';
461 386
             
462
-            push @{$params->{$where_key}}, $where_params->{$where_key};
387
+            push @{$param->{$wkey}}, $where->{$wkey};
463 388
         }
464 389
         else {
465
-            $params->{$where_key} = $where_params->{$where_key};
390
+            $param->{$wkey} = $where->{$wkey};
466 391
         }
467 392
     }
468 393
     
469 394
     # Execute query
470
-    my $ret_val = $self->execute($template, $params, {filter => $filter});
395
+    my $ret_val = $self->execute($template, param  => $param, 
396
+                                            filter => $filter);
471 397
     
472 398
     return $ret_val;
473 399
 }
474 400
 
475 401
 sub update_all {
476
-    my ($self, $table, $update_params, $args) = @_;
402
+    my $self = shift;;
477 403
     
404
+    # Arguments
405
+    my $args = ref $_[0] eq 'HASH' ? $_[0] : {@_};
406
+        
478 407
     # Allow all update
479
-    $args ||= {};
480 408
     $args->{allow_update_all} = 1;
481 409
     
482 410
     # Update all rows
483
-    return $self->update($table, $update_params, $args);
411
+    return $self->update($args);
484 412
 }
485 413
 
486 414
 our %VALID_DELETE_ARGS
487
-  = map { $_ => 1 } qw/where append filter allow_delete_all/;
415
+  = map { $_ => 1 } qw/table where append filter allow_delete_all/;
488 416
 
489 417
 sub delete {
490
-    my ($self, $table, $args) = @_;
418
+    my $self = shift;
419
+    
420
+    # Arguments
421
+    my $args = ref $_[0] eq 'HASH' ? $_[0] : {@_};
491 422
     
492
-    # Table
493
-    $table            ||= '';
494
-
495 423
     # Check arguments
496 424
     foreach my $name (keys %$args) {
497 425
         croak "\"$name\" is invalid name"
... ...
@@ -499,13 +427,14 @@ sub delete {
499 427
     }
500 428
     
501 429
     # Arguments
502
-    my $where_params     = $args->{where} || {};
430
+    my $table            = $args->{table} || '';
431
+    my $where            = $args->{where} || {};
503 432
     my $append_statement = $args->{append};
504
-    my $filter    = $args->{filter};
433
+    my $filter           = $args->{filter};
505 434
     my $allow_delete_all = $args->{allow_delete_all};
506 435
     
507 436
     # Where keys
508
-    my @where_keys = keys %$where_params;
437
+    my @where_keys = keys %$where;
509 438
     
510 439
     # Not exists where keys
511 440
     croak("Key-value pairs for where clause must be specified to 'delete' second argument")
... ...
@@ -515,8 +444,8 @@ sub delete {
515 444
     my $where_clause = '';
516 445
     if (@where_keys) {
517 446
         $where_clause = 'where ';
518
-        foreach my $where_key (@where_keys) {
519
-            $where_clause .= "{= $where_key} and ";
447
+        foreach my $wkey (@where_keys) {
448
+            $where_clause .= "{= $wkey} and ";
520 449
         }
521 450
         $where_clause =~ s/ and $//;
522 451
     }
... ...
@@ -526,31 +455,32 @@ sub delete {
526 455
     $template .= " $append_statement" if $append_statement;
527 456
     
528 457
     # Execute query
529
-    my $ret_val = $self->execute($template, $where_params, {filter => $filter});
458
+    my $ret_val = $self->execute($template, param  => $where, 
459
+                                            filter => $filter);
530 460
     
531 461
     return $ret_val;
532 462
 }
533 463
 
534 464
 sub delete_all {
535
-    my ($self, $table, $args) = @_;
465
+    my $self = shift;
466
+    
467
+    # Arguments
468
+    my $args = ref $_[0] eq 'HASH' ? $_[0] : {@_};
536 469
     
537 470
     # Allow all delete
538
-    $args ||= {};
539 471
     $args->{allow_delete_all} = 1;
540 472
     
541 473
     # Delete all rows
542
-    return $self->delete($table, $args);
474
+    return $self->delete($args);
543 475
 }
544 476
 
545 477
 our %VALID_SELECT_ARGS
546
-  = map { $_ => 1 } qw/columns where append filter/;
478
+  = map { $_ => 1 } qw/table column where append filter/;
547 479
 
548 480
 sub select {
549
-    my ($self, $tables, $args) = @_;
481
+    my $self = shift;;
550 482
     
551
-    # Table
552
-    $tables ||= '';
553
-    $tables = [$tables] unless ref $tables;
483
+    my $args = ref $_[0] eq 'HASH' ? $_[0] : {@_};
554 484
     
555 485
     # Check arguments
556 486
     foreach my $name (keys %$args) {
... ...
@@ -559,7 +489,9 @@ sub select {
559 489
     }
560 490
     
561 491
     # Arguments
562
-    my $columns          = $args->{columns} || [];
492
+    my $tables = $args->{table} || [];
493
+    $tables = [$tables] unless ref $tables eq 'ARRAY';
494
+    my $columns          = $args->{column} || [];
563 495
     my $where_params     = $args->{where} || {};
564 496
     my $append_statement = $args->{append} || '';
565 497
     my $filter    = $args->{filter};
... ...
@@ -611,7 +543,8 @@ sub select {
611 543
     }
612 544
     
613 545
     # Execute query
614
-    my $result = $self->execute($template, $where_params, {filter => $filter});
546
+    my $result = $self->execute($template, param  => $where_params, 
547
+                                           filter => $filter);
615 548
     
616 549
     return $result;
617 550
 }
... ...
@@ -646,11 +579,11 @@ DBIx::Custom - DBI with hash bind and filtering system
646 579
 
647 580
 =head1 VERSION
648 581
 
649
-Version 0.1402
582
+Version 0.1501
650 583
 
651 584
 =cut
652 585
 
653
-our $VERSION = '0.1402';
586
+our $VERSION = '0.1501';
654 587
 $VERSION = eval $VERSION;
655 588
 
656 589
 =head1 STATE
... ...
@@ -659,49 +592,71 @@ This module is not stable. Method name and functionality will be change.
659 592
 
660 593
 =head1 SYNOPSYS
661 594
     
662
-    # New
663
-    my $dbi = DBIx::Custom->new(data_source => "dbi:mysql:database=books"
664
-                                user => 'ken', password => '!LFKD%$&');
665
-    
666
-    # Query
667
-    $dbi->execute("select title from books");
668
-    
669
-    # Query with parameters
670
-    $dbi->execute("select id from books where {= author} && {like title}",
671
-                {author => 'ken', title => '%Perl%'});
672
-    
673
-    
595
+    # Connect
596
+    my $dbi = DBIx::Custom->connect(data_source => "dbi:mysql:database=books",
597
+                                    user => 'ken', password => '!LFKD%$&');
674 598
     
675 599
     # Insert 
676
-    $dbi->insert('books', {title => 'perl', author => 'Ken'});
600
+    $dbi->insert(table  => 'books',
601
+                 param  => {title => 'perl', author => 'Ken'}
602
+                 filter => {title => 'encode_utf8'});
677 603
     
678 604
     # Update 
679
-    $dbi->update('books', {title => 'aaa', author => 'Ken'}, {where => {id => 5}});
605
+    $dbi->update(table  => 'books', 
606
+                 param  => {title => 'aaa', author => 'Ken'}, 
607
+                 where  => {id => 5}
608
+                 filter => {title => 'encode_utf8');
609
+    
610
+    # Update all
611
+    $dbi->update_all(table  => 'books',
612
+                     param  => {title => 'aaa'}
613
+                     filter => {title => 'encode_utf8'});
680 614
     
681 615
     # Delete
682
-    $dbi->delete('books', {where => {author => 'Ken'}});
616
+    $dbi->delete(table  => 'books',
617
+                 where  => {author => 'Ken'}
618
+                 filter => {title => 'encode_utf8'});
683 619
     
684
-    # Select
685
-    my $result = $dbi->select('books');
686
-    my $result = $dbi->select('books', {where => {author => 'taro'}}); 
620
+    # Delete all
621
+    $dbi->delete_all(table => 'books');
687 622
     
688
-    my $result = $dbi->select(
689
-       'books', 
690
-       {
691
-           columns => [qw/author title/],
692
-           where   => {author => 'Ken'}
693
-        }
694
-    );
623
+    # Select
624
+    my $result = $dbi->select(table => 'books');
695 625
     
626
+    # Select(more complex)
696 627
     my $result = $dbi->select(
697 628
         'books',
698 629
         {
699 630
             columns => [qw/author title/],
700 631
             where   => {author => 'Ken'},
701
-            append  => 'order by id limit 1'
632
+            append  => 'order by id limit 1',
633
+            filter  => {tilte => 'encode_utf8'}
702 634
         }
703 635
     );
704 636
 
637
+    # Execute SQL
638
+    $dbi->execute("select title from books");
639
+    
640
+    # Execute SQL with parameters and filter
641
+    $dbi->execute("select id from books where {= author} && {like title}",
642
+                  param  => {author => 'ken', title => '%Perl%'},
643
+                  filter => {tilte => 'encode_utf8'});
644
+    
645
+    # Default filter
646
+    $dbi->default_query_filter('encode_utf8');
647
+    $dbi->default_fetch_filter('decode_utf8');
648
+    
649
+    # Fetch
650
+    while (my $row = $result->fetch) {
651
+        # ...
652
+    }
653
+    
654
+    # Fetch hash
655
+    while (my $row = $result->fetch_hash) {
656
+        
657
+    }
658
+    
659
+    
705 660
 =head1 ATTRIBUTES
706 661
 
707 662
 =head2 user
... ...
@@ -757,12 +712,12 @@ DBI options
757 712
     $dbi     = $dbi->options({PrintError => 0, RaiseError => 1});
758 713
     $options = $dbi->options;
759 714
 
760
-=head2 sql_tmpl
715
+=head2 sql_template
761 716
 
762 717
 SQLTemplate object
763 718
 
764
-    $dbi      = $dbi->sql_tmpl(DBIx::Cutom::SQLTemplate->new);
765
-    $sql_tmpl = $dbi->sql_tmpl;
719
+    $dbi          = $dbi->sql_template(DBIx::Cutom::SQLTemplate->new);
720
+    $sql_template = $dbi->sql_template;
766 721
 
767 722
 See also L<DBIx::Custom::SQLTemplate>.
768 723
 
... ...
@@ -779,27 +734,14 @@ This method is generally used to get a filter.
779 734
 
780 735
 If you add filter, use register_filter method.
781 736
 
782
-=head2 formats
783
-
784
-Formats
785
-
786
-    $dbi     = $dbi->formats({format1 => sub { }, format2 => sub {}});
787
-    $formats = $dbi->formats;
788
-
789
-This method is generally used to get a format.
790
-
791
-    $filter = $dbi->formats->{datetime};
792
-
793
-If you add format, use register_format method.
794
-
795 737
 =head2 default_query_filter
796 738
 
797
-Binding filter
739
+Default query filter
798 740
 
799
-    $dbi                 = $dbi->default_query_filter($default_query_filter);
741
+    $dbi                  = $dbi->default_query_filter($default_query_filter);
800 742
     $default_query_filter = $dbi->default_query_filter
801 743
 
802
-The following is bind filter example
744
+Query filter example
803 745
     
804 746
     $dbi->register_filter(encode_utf8 => sub {
805 747
         my $value = shift;
... ...
@@ -814,9 +756,7 @@ The following is bind filter example
814 756
 Bind filter arguemts is
815 757
 
816 758
     1. $value : Value
817
-    2. $key   : Key
818
-    3. $dbi   : DBIx::Custom object
819
-    4. $infos : {table => $table, column => $column}
759
+    3. $dbi   : DBIx::Custom instance
820 760
 
821 761
 =head2 default_fetch_filter
822 762
 
... ...
@@ -825,7 +765,7 @@ Fetching filter
825 765
     $dbi                  = $dbi->default_fetch_filter($default_fetch_filter);
826 766
     $default_fetch_filter = $dbi->default_fetch_filter;
827 767
 
828
-The following is fetch filter example
768
+Fetch filter example
829 769
 
830 770
     $dbi->register_filter(decode_utf8 => sub {
831 771
         my $value = shift;
... ...
@@ -837,12 +777,10 @@ The following is fetch filter example
837 777
 
838 778
     $dbi->default_fetch_filter('decode_utf8');
839 779
 
840
-Bind filter arguemts is
780
+Fetching filter arguemts is
841 781
 
842
-    1. $value : Value
843
-    2. $key   : Key
844
-    3. $dbi   : DBIx::Custom object
845
-    4. $infos : {type => $table, sth => $sth, index => $index}
782
+    1. Value
783
+    2. DBIx::Custom instance
846 784
 
847 785
 =head2 result_class
848 786
 
... ...
@@ -874,6 +812,13 @@ Default value is 50
874 812
 This class is L<Object::Simple> subclass.
875 813
 You can use all methods of L<Object::Simple>
876 814
 
815
+=head2 auto_commit
816
+
817
+Set and Get auto commit
818
+
819
+    $self        = $dbi->auto_commit($auto_commit);
820
+    $auto_commit = $dbi->auto_commit;
821
+    
877 822
 =head2 connect
878 823
 
879 824
 Connect to database
... ...
@@ -902,41 +847,36 @@ Check if database is connected.
902 847
     
903 848
 =head2 register_filter
904 849
 
905
-Resist filter
850
+Resister filter
906 851
     
907 852
     $dbi->register_filter($fname1 => $filter1, $fname => $filter2);
908 853
     
909
-The following is register_filter example
854
+register_filter example
910 855
 
911 856
     $dbi->register_filter(
912 857
         encode_utf8 => sub {
913
-            my ($value, $key, $dbi, $infos) = @_;
914
-            utf8::upgrade($value) unless Encode::is_utf8($value);
915
-            return encode('UTF-8', $value);
858
+            my $value = shift;
859
+            
860
+            require Encode;
861
+            
862
+            return Encode::encode('UTF-8', $value);
916 863
         },
917 864
         decode_utf8 => sub {
918
-            my ($value, $key, $dbi, $infos) = @_;
919
-            return decode('UTF-8', $value)
865
+            my $value = shift;
866
+            
867
+            require Encode;
868
+            
869
+            return Encode::decode('UTF-8', $value)
920 870
         }
921 871
     );
922 872
 
923
-=head2 register_format
924
-
925
-Add format
926
-
927
-    $dbi->register_format($fname1 => $format, $fname2 => $format2);
928
-    
929
-The following is register_format example.
930
-
931
-    $dbi->register_format(date => '%Y:%m:%d', datetime => '%Y-%m-%d %H:%M:%S');
932
-
933 873
 =head2 create_query
934 874
     
935 875
 Create Query object parsing SQL template
936 876
 
937 877
     my $query = $dbi->create_query("select * from authors where {= name} and {= age}");
938 878
 
939
-$query is <DBIx::Query> object. This is executed by query method as the following
879
+$query is <DBIx::Query> instance. This is executed by query method as the following
940 880
 
941 881
     $dbi->execute($query, $params);
942 882
 
... ...
@@ -951,7 +891,7 @@ Query
951 891
 The following is query example
952 892
 
953 893
     $result = $dbi->execute("select * from authors where {= name} and {= age}", 
954
-                          {author => 'taro', age => 19});
894
+                            {name => 'taro', age => 19});
955 895
     
956 896
     while (my @row = $result->fetch) {
957 897
         # do something
... ...
@@ -959,132 +899,114 @@ The following is query example
959 899
 
960 900
 If you now syntax of template, See also L<DBIx::Custom::SQLTemplate>
961 901
 
962
-execute() return L<DBIx::Custom::Result> object
963
-
964
-=head2 transaction
965
-
966
-Get L<DBIx::Custom::Transaction> object, and you run a transaction.
967
-
968
-    $dbi->transaction->run(sub {
969
-        my $dbi = shift;
970
-        
971
-        # do something
972
-    });
973
-
974
-If transaction is success, commit is execute. 
975
-If tranzation is died, rollback is execute.
976
-
977
-=head2 create_table
978
-
979
-Create table
980
-
981
-    $dbi->create_table(
982
-        'books',
983
-        'name char(255)',
984
-        'age  int'
985
-    );
986
-
987
-First argument is table name. Rest arguments is column definition.
988
-
989
-=head2 drop_table
990
-
991
-Drop table
992
-
993
-    $dbi->drop_table('books');
902
+execute() return L<DBIx::Custom::Result> instance
994 903
 
995 904
 =head2 insert
996 905
 
997 906
 Insert row
998 907
 
999
-    $affected = $dbi->insert($table, \%$insert_params);
1000
-    $affected = $dbi->insert($table, \%$insert_params, $append);
908
+    $affected = $dbi->insert(table  => $table, 
909
+                             param  => {%param},
910
+                             append => $append,
911
+                             filter => {%filter});
1001 912
 
1002 913
 Retrun value is affected rows count
1003 914
     
1004
-The following is insert example.
1005
-
1006
-    $dbi->insert('books', {title => 'Perl', author => 'Taro'});
1007
-
1008
-You can add statement.
915
+Example
1009 916
 
1010
-    $dbi->insert('books', {title => 'Perl', author => 'Taro'}, "some statement");
917
+    # insert
918
+    $dbi->insert(table  => 'books', 
919
+                 param  => {title => 'Perl', author => 'Taro'},
920
+                 append => "some statement",
921
+                 filter => {title => 'encode_utf8'})
1011 922
 
1012 923
 =head2 update
1013 924
 
1014 925
 Update rows
1015 926
 
1016
-    $affected = $dbi->update($table, \%update_params, \%where);
1017
-    $affected = $dbi->update($table, \%update_params, \%where, $append);
927
+    $affected = $dbi->update(table  => $table, 
928
+                             param  => {%params},
929
+                             where  => {%where},
930
+                             append => $append,
931
+                             filter => {%filter})
1018 932
 
1019 933
 Retrun value is affected rows count
1020 934
 
1021
-The following is update example.
935
+Example
1022 936
 
1023
-    $dbi->update('books', {title => 'Perl', author => 'Taro'}, {id => 5});
1024
-
1025
-You can add statement.
1026
-
1027
-    $dbi->update('books', {title => 'Perl', author => 'Taro'},
1028
-                 {id => 5}, "some statement");
937
+    #update
938
+    $dbi->update(table  => 'books',
939
+                 param  => {title => 'Perl', author => 'Taro'},
940
+                 where  => {id => 5},
941
+                 append => "some statement",
942
+                 filter => {title => 'encode_utf8'})
1029 943
 
1030 944
 =head2 update_all
1031 945
 
1032 946
 Update all rows
1033 947
 
1034
-    $affected = $dbi->update_all($table, \%updat_params);
948
+    $affected = $dbi->update_all(table  => $table, 
949
+                                 param  => {%params},
950
+                                 filter => {%filter},
951
+                                 append => $append);
1035 952
 
1036 953
 Retrun value is affected rows count
1037 954
 
1038
-The following is update_all example.
955
+Example
1039 956
 
1040
-    $dbi->update_all('books', {author => 'taro'});
957
+    # update_all
958
+    $dbi->update_all(table  => 'books', 
959
+                     param  => {author => 'taro'},
960
+                     filter => {author => 'encode_utf8'});
1041 961
 
1042 962
 =head2 delete
1043 963
 
1044 964
 Delete rows
1045 965
 
1046
-    $affected = $dbi->delete($table, \%where);
1047
-    $affected = $dbi->delete($table, \%where, $append);
966
+    # delete
967
+    $affected = $dbi->delete(table  => $table,
968
+                             where  => {%where},
969
+                             append => $append
970
+                             filter => {%filter});
1048 971
 
1049 972
 Retrun value is affected rows count
1050 973
     
1051
-The following is delete example.
1052
-
1053
-    $dbi->delete('books', {id => 5});
974
+Example
1054 975
 
1055
-You can add statement.
1056
-
1057
-    $dbi->delete('books', {id => 5}, "some statement");
976
+    # delete
977
+    $dbi->delete(table  => 'books',
978
+                 where  => {id => 5},
979
+                 append => 'some statement',
980
+                 filter => {id => 'encode_utf8');
1058 981
 
1059 982
 =head2 delete_all
1060 983
 
1061 984
 Delete all rows
1062 985
 
1063
-    $affected = $dbi->delete_all($table);
986
+    $affected = $dbi->delete_all(table => $table);
1064 987
 
1065 988
 Retrun value is affected rows count
1066 989
 
1067
-The following is delete_all example.
1068
-
990
+Example
991
+    
992
+    # delete_all
1069 993
     $dbi->delete_all('books');
1070 994
 
1071 995
 =head2 select
1072 996
     
1073 997
 Select rows
1074 998
 
1075
-    $resut = $dbi->select(
1076
-        $table,                # must be string or array;
1077
-        \@$columns,            # must be array reference. this can be ommited
1078
-        \%$where_params,       # must be hash reference.  this can be ommited
1079
-        $append_statement,     # must be string.          this can be ommited
1080
-        $query_edit_callback   # must be code reference.  this can be ommited
1081
-    );
999
+    $result = $dbi->select(table  => $table,
1000
+                           column => [@column],
1001
+                           where  => {%where},
1002
+                           append => $append,
1003
+                           filter => {%filter});
1082 1004
 
1083
-$reslt is L<DBIx::Custom::Result> object
1005
+$reslt is L<DBIx::Custom::Result> instance
1084 1006
 
1085 1007
 The following is some select examples
1086 1008
 
1087
-    # select * from books;
1009
+    # select
1088 1010
     $result = $dbi->select('books');
1089 1011
     
1090 1012
     # select * from books where title = 'Perl';
... ...
@@ -1092,10 +1014,10 @@ The following is some select examples
1092 1014
     
1093 1015
     # select title, author from books where id = 1 for update;
1094 1016
     $result = $dbi->select(
1095
-        'books',              # table
1096
-        ['title', 'author'],  # columns
1097
-        {id => 1},            # where clause
1098
-        'for update',         # append statement
1017
+        table  => 'books',
1018
+        where  => ['title', 'author'],
1019
+        where  => {id => 1},
1020
+        appned => 'for update'
1099 1021
     );
1100 1022
 
1101 1023
 You can join multi tables
... ...
@@ -1107,48 +1029,9 @@ You can join multi tables
1107 1029
         "where table1.id = table2.id",       # join clause (must start 'where')
1108 1030
     );
1109 1031
 
1110
-You can also edit query
1111
-        
1112
-    $dbi->select(
1113
-        'books',
1114
-        # column, where clause, append statement,
1115
-        sub {
1116
-            my $query = shift;
1117
-            $query->query_filter(sub {
1118
-                # ...
1119
-            });
1120
-        }
1121
-    }
1122
-
1123
-=head2 run_transaction
1124
-
1125 1032
 =head1 DBIx::Custom default configuration
1126 1033
 
1127
-DBIx::Custom have DBI object.
1128
-This module is work well in the following DBI condition.
1129
-
1130
-    1. AutoCommit is true
1131
-    2. RaiseError is true
1132
-
1133
-By default, Both AutoCommit and RaiseError is true.
1134
-You must not change these mode not to damage your data.
1135
-
1136
-If you change these mode, 
1137
-you cannot get correct error message, 
1138
-or run_transaction may fail.
1139
-
1140
-=head1 Inheritance of DBIx::Custom
1141
-
1142
-DBIx::Custom is customizable DBI.
1143
-You can inherit DBIx::Custom and custumize attributes.
1144
-
1145
-    package DBIx::Custom::Yours;
1146
-    use base DBIx::Custom;
1147
-    
1148
-    my $class = __PACKAGE__;
1149
-    
1150
-    $class->user('your_name');
1151
-    $class->password('your_password');
1034
+By default, "AutoCommit" and "RaiseError" is true.
1152 1035
 
1153 1036
 =head1 AUTHOR
1154 1037
 
-83
lib/DBIx/Custom/Basic.pm
... ...
@@ -1,83 +0,0 @@
1
-package DBIx::Custom::Basic;
2
-
3
-use warnings;
4
-use strict;
5
-
6
-use base 'DBIx::Custom';
7
-
8
-use Encode qw/decode encode/;
9
-
10
-__PACKAGE__->register_filter(
11
-    none        => sub { $_[0] },
12
-    encode_utf8 => sub { encode('UTF-8', $_[0]) },
13
-    decode_utf8 => sub { decode('UTF-8', $_[0]) }
14
-);
15
-
16
-__PACKAGE__->register_format(
17
-    'SQL99_date'        => '%Y-%m-%d',
18
-    'SQL99_datetime'    => '%Y-%m-%d %H:%M:%S',
19
-    'SQL99_time'        => '%H:%M:%S',
20
-    'ISO-8601_date'     => '%Y-%m-%d',
21
-    'ISO-8601_datetime' => '%Y-%m-%dT%H:%M:%S',
22
-    'ISO-8601_time'     => '%H:%M:%S',
23
-);
24
-
25
-1;
26
-
27
-=head1 NAME
28
-
29
-DBIx::Custom::Basic - DBIx::Custom basic implementation
30
-
31
-=head1 SYNOPSYS
32
-
33
-    # New
34
-    my $dbi = DBIx::Custom::Basic->new(
35
-        data_source => "dbi:mysql:database=books",
36
-        user        => 'ken',
37
-        password    => '!LFKD%$&'
38
-    );
39
-
40
-=head1 METHODS
41
-
42
-This class is L<DBIx::Custom> subclass.
43
-You can use all methods of L<DBIx::Custom>
44
-
45
-=head1 FILTERS
46
-
47
-=head2 encode_utf8
48
-
49
-Encode internal string to UTF-8 byte stream
50
-If need, utf8::upgrade is also done.
51
-
52
-    $dbi->filters->{encode_utf8}->($value);
53
-    
54
-This filter is generally used as bind filter
55
-
56
-    $dbi->bind_filter($dbi->filters->{encode_utf8});
57
-
58
-=head2 decode_utf8
59
-
60
-Decode UTF-8 byte stream to internal string
61
-    $dbi->filters->{decode_utf8}->($value);
62
-    
63
-This filter is generally used as fetch filter
64
-
65
-    $dbi->fetch_filter($dbi->filters->{decode_utf8});
66
-
67
-=head1 FORMATS
68
-    
69
-strptime formats is available
70
-    
71
-    # format name        format
72
-    'SQL99_date'         '%Y-%m-%d',
73
-    'SQL99_datetime'     '%Y-%m-%d %H:%M:%S',
74
-    'SQL99_time'         '%H:%M:%S',
75
-    'ISO-8601_date'      '%Y-%m-%d',
76
-    'ISO-8601_datetime'  '%Y-%m-%dT%H:%M:%S',
77
-    'ISO-8601_time'      '%H:%M:%S',
78
-
79
-You get format as the following
80
-
81
-    my $format = $dbi->formats->{$format_name};
82
-
83
-=cut
+2 -6
lib/DBIx/Custom/MySQL.pm
... ...
@@ -6,12 +6,6 @@ use strict;
6 6
 use base 'DBIx::Custom::Basic';
7 7
 use Carp 'croak';
8 8
 
9
-__PACKAGE__->register_format(
10
-    datetime => __PACKAGE__->formats->{SQL99_datetime},
11
-    date     => __PACKAGE__->formats->{SQL99_date},
12
-    time     => __PACKAGE__->formats->{SQL99_time},
13
-);
14
-
15 9
 sub connect {
16 10
     my $self = shift;
17 11
     
... ...
@@ -44,6 +38,8 @@ sub last_insert_id {
44 38
     return $last_insert_id;
45 39
 }
46 40
 
41
+1;
42
+
47 43
 =head1 NAME
48 44
 
49 45
 DBIx::Custom::MySQL - DBIx::Custom MySQL implementation
+2 -7
lib/DBIx/Custom/SQLite.pm
... ...
@@ -6,13 +6,6 @@ use warnings;
6 6
 use base 'DBIx::Custom::Basic';
7 7
 use Carp 'croak';
8 8
 
9
-# Add format
10
-__PACKAGE__->register_format(
11
-    datetime => __PACKAGE__->formats->{SQL99_datetime},
12
-    date     => __PACKAGE__->formats->{SQL99_date},
13
-    time     => __PACKAGE__->formats->{SQL99_time},
14
-);
15
-
16 9
 sub connect {
17 10
     my $self = shift;
18 11
     
... ...
@@ -63,6 +56,8 @@ sub last_insert_rowid {
63 56
     return $last_insert_rowid;
64 57
 }
65 58
 
59
+1;
60
+
66 61
 =head1 NAME
67 62
 
68 63
 DBIx::Custom::SQLite - DBIx::Custom SQLite implementation
-55
t/dbix-custom-basic-sqlite.t
... ...
@@ -1,55 +0,0 @@
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
-
-67
t/dbix-custom-basic-timeformat.t
... ...
@@ -1,67 +0,0 @@
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
-
+465 -540
t/dbix-custom-core-sqlite.t
... ...
@@ -1,540 +1,465 @@
1
-use Test::More;
2
-use strict;
3
-use warnings;
4
-
5
-BEGIN {
6
-    eval { require DBD::SQLite; 1 }
7
-        or plan skip_all => 'DBD::SQLite required';
8
-    eval { DBD::SQLite->VERSION >= 1.25 }
9
-        or plan skip_all => 'DBD::SQLite >= 1.25 required';
10
-
11
-    plan 'no_plan';
12
-    use_ok('DBIx::Custom');
13
-}
14
-
15
-# Function for test name
16
-my $test;
17
-sub test {
18
-    $test = shift;
19
-}
20
-
21
-# Constant varialbes for test
22
-my $CREATE_TABLE = {
23
-    0 => 'create table table1 (key1 char(255), key2 char(255));',
24
-    1 => 'create table table1 (key1 char(255), key2 char(255), key3 char(255), key4 char(255), key5 char(255));',
25
-    2 => 'create table table2 (key1 char(255), key3 char(255));'
26
-};
27
-
28
-my $SELECT_TMPLS = {
29
-    0 => 'select * from table1;'
30
-};
31
-
32
-my $DROP_TABLE = {
33
-    0 => 'drop table table1'
34
-};
35
-
36
-my $NEW_ARGS = {
37
-    0 => {data_source => 'dbi:SQLite:dbname=:memory:'}
38
-};
39
-
40
-# Variables
41
-my $dbi;
42
-my $sth;
43
-my $tmpl;
44
-my @tmpls;
45
-my $select_tmpl;
46
-my $insert_tmpl;
47
-my $update_tmpl;
48
-my $params;
49
-my $sql;
50
-my $result;
51
-my $row;
52
-my @rows;
53
-my $rows;
54
-my $query;
55
-my @queries;
56
-my $select_query;
57
-my $insert_query;
58
-my $update_query;
59
-my $ret_val;
60
-
61
-
62
-test 'disconnect';
63
-$dbi = DBIx::Custom->new($NEW_ARGS->{0});
64
-$dbi->connect;
65
-$dbi->disconnect;
66
-ok(!$dbi->dbh, $test);
67
-
68
-
69
-test 'connected';
70
-$dbi = DBIx::Custom->new($NEW_ARGS->{0});
71
-ok(!$dbi->connected, "$test : not connected");
72
-$dbi->connect;
73
-ok($dbi->connected, "$test : connected");
74
-
75
-
76
-test 'create_table';
77
-$dbi = DBIx::Custom->new($NEW_ARGS->{0});
78
-$ret_val = $dbi->create_table(
79
-                   'table1',
80
-                   'key1 char(255)',
81
-                   'key2 char(255)'
82
-                 );
83
-ok(defined $ret_val, "$test : create_table");
84
-
85
-$dbi->insert('table1', {key1 => 1, key2 => 2});
86
-ok(!$@, "$test : table exist");
87
-
88
-$ret_val = $dbi->drop_table('table1');
89
-ok(defined $ret_val, "$test : drop table");
90
-
91
-eval{$dbi->select('table1')};
92
-ok($@, "$test : table not exist");
93
-
94
-# Prepare table
95
-$dbi = DBIx::Custom->new($NEW_ARGS->{0});
96
-$dbi->connect;
97
-$dbi->execute($CREATE_TABLE->{0});
98
-$dbi->insert('table1', {key1 => 1, key2 => 2});
99
-$dbi->insert('table1', {key1 => 3, key2 => 4});
100
-
101
-test 'DBIx::Custom::Result test';
102
-$tmpl = "select key1, key2 from table1";
103
-$query = $dbi->create_query($tmpl);
104
-$result = $dbi->execute($query);
105
-
106
-@rows = ();
107
-while (my $row = $result->fetch) {
108
-    push @rows, [@$row];
109
-}
110
-is_deeply(\@rows, [[1, 2], [3, 4]], "$test : fetch scalar context");
111
-
112
-$result = $dbi->execute($query);
113
-@rows = ();
114
-while (my @row = $result->fetch) {
115
-    push @rows, [@row];
116
-}
117
-is_deeply(\@rows, [[1, 2], [3, 4]], "$test : fetch list context");
118
-
119
-$result = $dbi->execute($query);
120
-@rows = ();
121
-while (my $row = $result->fetch_hash) {
122
-    push @rows, {%$row};
123
-}
124
-is_deeply(\@rows, [{key1 => 1, key2 => 2}, {key1 => 3, key2 => 4}], "$test : fetch_hash scalar context");
125
-
126
-$result = $dbi->execute($query);
127
-@rows = ();
128
-while (my %row = $result->fetch_hash) {
129
-    push @rows, {%row};
130
-}
131
-is_deeply(\@rows, [{key1 => 1, key2 => 2}, {key1 => 3, key2 => 4}], "$test : fetch hash list context");
132
-
133
-$result = $dbi->execute($query);
134
-$rows = $result->fetch_all;
135
-is_deeply($rows, [[1, 2], [3, 4]], "$test : fetch_all scalar context");
136
-
137
-$result = $dbi->execute($query);
138
-@rows = $result->fetch_all;
139
-is_deeply(\@rows, [[1, 2], [3, 4]], "$test : fetch_all list context");
140
-
141
-$result = $dbi->execute($query);
142
-@rows = $result->fetch_hash_all;
143
-is_deeply($rows, [[1, 2], [3, 4]], "$test : fetch_hash_all scalar context");
144
-
145
-$result = $dbi->execute($query);
146
-@rows = $result->fetch_all;
147
-is_deeply(\@rows, [[1, 2], [3, 4]], "$test : fetch_hash_all list context");
148
-
149
-
150
-test 'Insert query return value';
151
-$dbi->execute($DROP_TABLE->{0});
152
-$dbi->execute($CREATE_TABLE->{0});
153
-$tmpl = "insert into table1 {insert key1 key2}";
154
-$query = $dbi->create_query($tmpl);
155
-$ret_val = $dbi->execute($query, {key1 => 1, key2 => 2});
156
-ok($ret_val, $test);
157
-
158
-
159
-test 'Direct query';
160
-$dbi->execute($DROP_TABLE->{0});
161
-$dbi->execute($CREATE_TABLE->{0});
162
-$insert_tmpl = "insert into table1 {insert key1 key2}";
163
-$dbi->execute($insert_tmpl, {key1 => 1, key2 => 2});
164
-$result = $dbi->execute($SELECT_TMPLS->{0});
165
-$rows = $result->fetch_hash_all;
166
-is_deeply($rows, [{key1 => 1, key2 => 2}], $test);
167
-
168
-test 'Filter basic';
169
-$dbi->execute($DROP_TABLE->{0});
170
-$dbi->execute($CREATE_TABLE->{0});
171
-$dbi->register_filter(twice       => sub { $_[0] * 2}, 
172
-                    three_times => sub { $_[0] * 3});
173
-
174
-$insert_tmpl  = "insert into table1 {insert key1 key2};";
175
-$insert_query = $dbi->create_query($insert_tmpl);
176
-$insert_query->filter({key1 => 'twice'});
177
-$dbi->execute($insert_query, {key1 => 1, key2 => 2});
178
-$result = $dbi->execute($SELECT_TMPLS->{0});
179
-$rows = $result->filter({key2 => 'three_times'})->fetch_hash_all;
180
-is_deeply($rows, [{key1 => 2, key2 => 6}], "$test : filter fetch_filter");
181
-$dbi->execute($DROP_TABLE->{0});
182
-
183
-test 'Filter in';
184
-$dbi->execute($CREATE_TABLE->{0});
185
-$insert_tmpl  = "insert into table1 {insert key1 key2};";
186
-$insert_query = $dbi->create_query($insert_tmpl);
187
-$dbi->execute($insert_query, {key1 => 2, key2 => 4});
188
-$select_tmpl = "select * from table1 where {in table1.key1 2} and {in table1.key2 2}";
189
-$select_query = $dbi->create_query($select_tmpl);
190
-$select_query->filter({'table1.key1' => 'twice'});
191
-$result = $dbi->execute($select_query, {'table1.key1' => [1,5], 'table1.key2' => [2,4]});
192
-$rows = $result->fetch_hash_all;
193
-is_deeply($rows, [{key1 => 2, key2 => 4}], "$test : filter");
194
-
195
-test 'DBIx::Custom::SQLTemplate basic tag';
196
-$dbi->execute($DROP_TABLE->{0});
197
-$dbi->execute($CREATE_TABLE->{1});
198
-$dbi->insert('table1', {key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5});
199
-$dbi->insert('table1', {key1 => 6, key2 => 7, key3 => 8, key4 => 9, key5 => 10});
200
-
201
-$tmpl = "select * from table1 where {= key1} and {<> key2} and {< key3} and {> key4} and {>= key5};";
202
-$query = $dbi->create_query($tmpl);
203
-$result = $dbi->execute($query, {key1 => 1, key2 => 3, key3 => 4, key4 => 3, key5 => 5});
204
-$rows = $result->fetch_hash_all;
205
-is_deeply($rows, [{key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5}], "$test : basic tag1");
206
-
207
-$tmpl = "select * from table1 where {<= key1} and {like key2};";
208
-$query = $dbi->create_query($tmpl);
209
-$result = $dbi->execute($query, {key1 => 1, key2 => '%2%'});
210
-$rows = $result->fetch_hash_all;
211
-is_deeply($rows, [{key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5}], "$test : basic tag2");
212
-
213
-test 'DIB::Custom::SQLTemplate in tag';
214
-$dbi->execute($DROP_TABLE->{0});
215
-$dbi->execute($CREATE_TABLE->{1});
216
-$dbi->insert('table1', {key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5});
217
-$dbi->insert('table1', {key1 => 6, key2 => 7, key3 => 8, key4 => 9, key5 => 10});
218
-
219
-$tmpl = "select * from table1 where {in key1 2};";
220
-$query = $dbi->create_query($tmpl);
221
-$result = $dbi->execute($query, {key1 => [9, 1]});
222
-$rows = $result->fetch_hash_all;
223
-is_deeply($rows, [{key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5}], "$test : basic");
224
-
225
-test 'DBIx::Custom::SQLTemplate insert tag';
226
-$dbi->execute("delete from table1");
227
-$insert_tmpl = 'insert into table1 {insert key1 key2 key3 key4 key5}';
228
-$dbi->execute($insert_tmpl, {key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5});
229
-
230
-$result = $dbi->execute($SELECT_TMPLS->{0});
231
-$rows = $result->fetch_hash_all;
232
-is_deeply($rows, [{key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5}], "$test : basic");
233
-
234
-test 'DBIx::Custom::SQLTemplate update tag';
235
-$dbi->execute("delete from table1");
236
-$insert_tmpl = "insert into table1 {insert key1 key2 key3 key4 key5}";
237
-$dbi->execute($insert_tmpl, {key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5});
238
-$dbi->execute($insert_tmpl, {key1 => 6, key2 => 7, key3 => 8, key4 => 9, key5 => 10});
239
-
240
-$update_tmpl = 'update table1 {update key1 key2 key3 key4} where {= key5}';
241
-$dbi->execute($update_tmpl, {key1 => 1, key2 => 1, key3 => 1, key4 => 1, key5 => 5});
242
-
243
-$result = $dbi->execute($SELECT_TMPLS->{0});
244
-$rows = $result->fetch_hash_all;
245
-is_deeply($rows, [{key1 => 1, key2 => 1, key3 => 1, key4 => 1, key5 => 5},
246
-                  {key1 => 6, key2 => 7, key3 => 8, key4 => 9, key5 => 10}], "$test : basic");
247
-
248
-test 'transaction';
249
-$dbi->execute($DROP_TABLE->{0});
250
-$dbi->execute($CREATE_TABLE->{0});
251
-$dbi->run_transaction(sub {
252
-    $insert_tmpl = 'insert into table1 {insert key1 key2}';
253
-    $dbi->execute($insert_tmpl, {key1 => 1, key2 => 2});
254
-    $dbi->execute($insert_tmpl, {key1 => 3, key2 => 4});
255
-});
256
-$result = $dbi->execute($SELECT_TMPLS->{0});
257
-$rows   = $result->fetch_hash_all;
258
-is_deeply($rows, [{key1 => 1, key2 => 2}, {key1 => 3, key2 => 4}], "$test : commit");
259
-
260
-$dbi->execute($DROP_TABLE->{0});
261
-$dbi->execute($CREATE_TABLE->{0});
262
-$dbi->dbh->{RaiseError} = 0;
263
-eval{
264
-    $dbi->run_transaction(sub {
265
-        $insert_tmpl = 'insert into table1 {insert key1 key2}';
266
-        $dbi->execute($insert_tmpl, {key1 => 1, key2 => 2});
267
-        die "Fatal Error";
268
-        $dbi->execute($insert_tmpl, {key1 => 3, key2 => 4});
269
-    })
270
-};
271
-like($@, qr/Fatal Error.*Rollback is success/ms, "$test : Rollback success message");
272
-ok(!$dbi->dbh->{RaiseError}, "$test : restore RaiseError value");
273
-$result = $dbi->execute($SELECT_TMPLS->{0});
274
-$rows   = $result->fetch_hash_all;
275
-is_deeply($rows, [], "$test : rollback");
276
-
277
-
278
-
279
-test 'Error case';
280
-$dbi = DBIx::Custom->new;
281
-eval{$dbi->run_transaction};
282
-like($@, qr/Not yet connect to database/, "$test : Yet Connected");
283
-
284
-$dbi = DBIx::Custom->new(data_source => 'dbi:SQLit');
285
-eval{$dbi->connect;};
286
-ok($@, "$test : connect error");
287
-
288
-$dbi = DBIx::Custom->new($NEW_ARGS->{0});
289
-$dbi->connect;
290
-$dbi->dbh->{AutoCommit} = 0;
291
-eval{$dbi->run_transaction};
292
-like($@, qr/AutoCommit must be true before transaction start/,
293
-         "$test : transaction auto commit is false");
294
-
295
-$dbi = DBIx::Custom->new($NEW_ARGS->{0});
296
-$sql = 'laksjdf';
297
-eval{$dbi->execute($sql, qw/1 2 3/)};
298
-like($@, qr/$sql/, "$test : query fail");
299
-
300
-$dbi = DBIx::Custom->new($NEW_ARGS->{0});
301
-eval{$dbi->create_query("{p }")};
302
-ok($@, "$test : create_query invalid SQL template");
303
-
304
-test 'insert';
305
-$dbi = DBIx::Custom->new($NEW_ARGS->{0});
306
-$dbi->execute($CREATE_TABLE->{0});
307
-$dbi->insert('table1', {key1 => 1, key2 => 2});
308
-$dbi->insert('table1', {key1 => 3, key2 => 4});
309
-$result = $dbi->execute($SELECT_TMPLS->{0});
310
-$rows   = $result->fetch_hash_all;
311
-is_deeply($rows, [{key1 => 1, key2 => 2}, {key1 => 3, key2 => 4}], "$test : basic");
312
-
313
-$dbi->execute('delete from table1');
314
-$dbi->register_filter(
315
-    twice       => sub { $_[0] * 2 },
316
-    three_times => sub { $_[0] * 3 }
317
-);
318
-$dbi->default_query_filter('twice');
319
-$dbi->insert('table1', {key1 => 1, key2 => 2}, {filter => {key1 => 'three_times'}});
320
-$result = $dbi->execute($SELECT_TMPLS->{0});
321
-$rows   = $result->fetch_hash_all;
322
-is_deeply($rows, [{key1 => 3, key2 => 4}], "$test : filter");
323
-$dbi->default_query_filter(undef);
324
-
325
-$dbi->execute($DROP_TABLE->{0});
326
-$dbi->execute($CREATE_TABLE->{0});
327
-$dbi->insert('table1', {key1 => 1, key2 => 2}, {append => '   '});
328
-$rows = $dbi->select('table1')->fetch_hash_all;
329
-is_deeply($rows, [{key1 => 1, key2 => 2}], 'insert append');
330
-
331
-
332
-test 'insert error';
333
-eval{$dbi->insert('table1')};
334
-like($@, qr/Key-value pairs for insert must be specified to 'insert' second argument/, "$test : insert key-value not specifed");
335
-
336
-test 'update';
337
-$dbi = DBIx::Custom->new($NEW_ARGS->{0});
338
-$dbi->execute($CREATE_TABLE->{1});
339
-$dbi->insert('table1', {key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5});
340
-$dbi->insert('table1', {key1 => 6, key2 => 7, key3 => 8, key4 => 9, key5 => 10});
341
-$dbi->update('table1', {key2 => 11}, {where => {key1 => 1}});
342
-$result = $dbi->execute($SELECT_TMPLS->{0});
343
-$rows   = $result->fetch_hash_all;
344
-is_deeply($rows, [{key1 => 1, key2 => 11, key3 => 3, key4 => 4, key5 => 5},
345
-                  {key1 => 6, key2 => 7,  key3 => 8, key4 => 9, key5 => 10}],
346
-                  "$test : basic");
347
-                  
348
-$dbi->execute("delete from table1");
349
-$dbi->insert('table1', {key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5});
350
-$dbi->insert('table1', {key1 => 6, key2 => 7, key3 => 8, key4 => 9, key5 => 10});
351
-$dbi->update('table1', {key2 => 12}, {where => {key2 => 2, key3 => 3}});
352
-$result = $dbi->execute($SELECT_TMPLS->{0});
353
-$rows   = $result->fetch_hash_all;
354
-is_deeply($rows, [{key1 => 1, key2 => 12, key3 => 3, key4 => 4, key5 => 5},
355
-                  {key1 => 6, key2 => 7,  key3 => 8, key4 => 9, key5 => 10}],
356
-                  "$test : update key same as search key");
357
-
358
-$dbi->execute("delete from table1");
359
-$dbi->insert('table1', {key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5});
360
-$dbi->insert('table1', {key1 => 6, key2 => 7, key3 => 8, key4 => 9, key5 => 10});
361
-$dbi->register_filter(twice => sub { $_[0] * 2 });
362
-$dbi->update('table1', {key2 => 11}, {where => {key1 => 1},
363
-              filter => {key2 => 'twice'}});
364
-$result = $dbi->execute($SELECT_TMPLS->{0});
365
-$rows   = $result->fetch_hash_all;
366
-is_deeply($rows, [{key1 => 1, key2 => 22, key3 => 3, key4 => 4, key5 => 5},
367
-                  {key1 => 6, key2 => 7,  key3 => 8, key4 => 9, key5 => 10}],
368
-                  "$test : filter");
369
-
370
-
371
-$result = $dbi->update('table1', {key2 => 11}, {where => {key1 => 1}, append => '   '});
372
-
373
-test 'update error';
374
-$dbi = DBIx::Custom->new($NEW_ARGS->{0});
375
-$dbi->execute($CREATE_TABLE->{1});
376
-eval{$dbi->update('table1')};
377
-like($@, qr/Key-value pairs for update must be specified to 'update' second argument/,
378
-         "$test : update key-value pairs not specified");
379
-
380
-eval{$dbi->update('table1', {key2 => 1})};
381
-like($@, qr/Key-value pairs for where clause must be specified to 'update' third argument/,
382
-         "$test : where key-value pairs not specified");
383
-
384
-test 'update_all';
385
-$dbi = DBIx::Custom->new($NEW_ARGS->{0});
386
-$dbi->execute($CREATE_TABLE->{1});
387
-$dbi->insert('table1', {key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5});
388
-$dbi->insert('table1', {key1 => 6, key2 => 7, key3 => 8, key4 => 9, key5 => 10});
389
-$dbi->register_filter(twice => sub { $_[0] * 2 });
390
-$dbi->update_all('table1', {key2 => 10}, {filter => {key2 => 'twice'}});
391
-$result = $dbi->execute($SELECT_TMPLS->{0});
392
-$rows   = $result->fetch_hash_all;
393
-is_deeply($rows, [{key1 => 1, key2 => 20, key3 => 3, key4 => 4, key5 => 5},
394
-                  {key1 => 6, key2 => 20, key3 => 8, key4 => 9, key5 => 10}],
395
-                  "$test : filter");
396
-
397
-
398
-test 'delete';
399
-$dbi = DBIx::Custom->new($NEW_ARGS->{0});
400
-$dbi->execute($CREATE_TABLE->{0});
401
-$dbi->insert('table1', {key1 => 1, key2 => 2});
402
-$dbi->insert('table1', {key1 => 3, key2 => 4});
403
-$dbi->delete('table1', {where => {key1 => 1}});
404
-$result = $dbi->execute($SELECT_TMPLS->{0});
405
-$rows   = $result->fetch_hash_all;
406
-is_deeply($rows, [{key1 => 3, key2 => 4}], "$test : basic");
407
-
408
-$dbi->execute("delete from table1;");
409
-$dbi->insert('table1', {key1 => 1, key2 => 2});
410
-$dbi->insert('table1', {key1 => 3, key2 => 4});
411
-$dbi->register_filter(twice => sub { $_[0] * 2 });
412
-$dbi->delete('table1', {where => {key2 => 1}, filter => {key2 => 'twice'}});
413
-$result = $dbi->execute($SELECT_TMPLS->{0});
414
-$rows   = $result->fetch_hash_all;
415
-is_deeply($rows, [{key1 => 3, key2 => 4}], "$test : filter");
416
-
417
-$dbi->delete('table1', {where => {key1 => 1}, append => '   '});
418
-
419
-$dbi->delete_all('table1');
420
-$dbi->insert('table1', {key1 => 1, key2 => 2});
421
-$dbi->insert('table1', {key1 => 3, key2 => 4});
422
-$dbi->delete('table1', {where => {key1 => 1, key2 => 2}});
423
-$rows = $dbi->select('table1')->fetch_hash_all;
424
-is_deeply($rows, [{key1 => 3, key2 => 4}], "$test : delete multi key");
425
-
426
-
427
-test 'delete error';
428
-$dbi = DBIx::Custom->new($NEW_ARGS->{0});
429
-$dbi->execute($CREATE_TABLE->{0});
430
-eval{$dbi->delete('table1')};
431
-like($@, qr/Key-value pairs for where clause must be specified to 'delete' second argument/,
432
-         "$test : where key-value pairs not specified");
433
-
434
-test 'delete_all';
435
-$dbi = DBIx::Custom->new($NEW_ARGS->{0});
436
-$dbi->execute($CREATE_TABLE->{0});
437
-$dbi->insert('table1', {key1 => 1, key2 => 2});
438
-$dbi->insert('table1', {key1 => 3, key2 => 4});
439
-$dbi->delete_all('table1');
440
-$result = $dbi->execute($SELECT_TMPLS->{0});
441
-$rows   = $result->fetch_hash_all;
442
-is_deeply($rows, [], "$test : basic");
443
-
444
-
445
-test 'select';
446
-$dbi = DBIx::Custom->new($NEW_ARGS->{0});
447
-$dbi->execute($CREATE_TABLE->{0});
448
-$dbi->insert('table1', {key1 => 1, key2 => 2});
449
-$dbi->insert('table1', {key1 => 3, key2 => 4});
450
-$rows = $dbi->select('table1')->fetch_hash_all;
451
-is_deeply($rows, [{key1 => 1, key2 => 2},
452
-                  {key1 => 3, key2 => 4}], "$test : table");
453
-
454
-$rows = $dbi->select('table1', {columns => ['key1']})->fetch_hash_all;
455
-is_deeply($rows, [{key1 => 1}, {key1 => 3}], "$test : table and columns and where key");
456
-
457
-$rows = $dbi->select('table1', {where => {key1 => 1}})->fetch_hash_all;
458
-is_deeply($rows, [{key1 => 1, key2 => 2}], "$test : table and columns and where key");
459
-
460
-$rows = $dbi->select('table1', {columns => ['key1'], where => {key1 => 3}})->fetch_hash_all;
461
-is_deeply($rows, [{key1 => 3}], "$test : table and columns and where key");
462
-
463
-$rows = $dbi->select('table1', {append => "order by key1 desc limit 1"})->fetch_hash_all;
464
-is_deeply($rows, [{key1 => 3, key2 => 4}], "$test : append statement");
465
-
466
-$dbi->register_filter(decrement => sub { $_[0] - 1 });
467
-$rows = $dbi->select('table1', {where => {key1 => 2}, filter => {key1 => 'decrement'}})
468
-            ->fetch_hash_all;
469
-is_deeply($rows, [{key1 => 1, key2 => 2}], "$test : filter");
470
-
471
-$dbi->execute($CREATE_TABLE->{2});
472
-$dbi->insert('table2', {key1 => 1, key3 => 5});
473
-$rows = $dbi->select([qw/table1 table2/],
474
-                      {
475
-                         columns => ['table1.key1 as table1_key1', 'table2.key1 as table2_key1', 'key2', 'key3'],
476
-                         where   => {'table1.key2' => 2},
477
-                         append  => "where table1.key1 = table2.key1"
478
-                      }
479
-                    )->fetch_hash_all;
480
-is_deeply($rows, [{table1_key1 => 1, table2_key1 => 1, key2 => 2, key3 => 5}], "$test : join");
481
-
482
-test 'Cache';
483
-$dbi = DBIx::Custom->new($NEW_ARGS->{0});
484
-DBIx::Custom->query_cache_max(2);
485
-$dbi->execute($CREATE_TABLE->{0});
486
-delete $DBIx::Custom::CLASS_ATTRS->{_query_caches};
487
-delete $DBIx::Custom::CLASS_ATTRS->{_query_cache_keys};
488
-$tmpls[0] = "insert into table1 {insert key1 key2}";
489
-$queries[0] = $dbi->create_query($tmpls[0]);
490
-is(DBIx::Custom->_query_caches->{$tmpls[0]}{sql}, $queries[0]->sql, "$test : sql first");
491
-is(DBIx::Custom->_query_caches->{$tmpls[0]}{columns}, $queries[0]->columns, "$test : columns first");
492
-is_deeply(DBIx::Custom->_query_cache_keys, [@tmpls], "$test : cache key first");
493
-
494
-$tmpls[1] = "select * from table1";
495
-$queries[1] = $dbi->create_query($tmpls[1]);
496
-is(DBIx::Custom->_query_caches->{$tmpls[0]}{sql}, $queries[0]->sql, "$test : sql first");
497
-is(DBIx::Custom->_query_caches->{$tmpls[0]}{columns}, $queries[0]->columns, "$test : columns first");
498
-is(DBIx::Custom->_query_caches->{$tmpls[1]}{sql}, $queries[1]->sql, "$test : sql second");
499
-is(DBIx::Custom->_query_caches->{$tmpls[1]}{columns}, $queries[1]->columns, "$test : columns second");
500
-is_deeply(DBIx::Custom->_query_cache_keys, [@tmpls], "$test : cache key second");
501
-
502
-$tmpls[2] = "select key1, key2 from table1";
503
-$queries[2] = $dbi->create_query($tmpls[2]);
504
-ok(!exists DBIx::Custom->_query_caches->{$tmpls[0]}, "$test : cache overflow deleted key");
505
-is(DBIx::Custom->_query_caches->{$tmpls[1]}{sql}, $queries[1]->sql, "$test : sql cache overflow deleted key");
506
-is(DBIx::Custom->_query_caches->{$tmpls[1]}{columns}, $queries[1]->columns, "$test : columns cache overflow deleted key");
507
-is(DBIx::Custom->_query_caches->{$tmpls[2]}{sql}, $queries[2]->sql, "$test : sql cache overflow deleted key");
508
-is(DBIx::Custom->_query_caches->{$tmpls[2]}{columns}, $queries[2]->columns, "$test : columns cache overflow deleted key");
509
-is_deeply(DBIx::Custom->_query_cache_keys, [@tmpls[1, 2]], "$test : cache key third");
510
-
511
-$queries[1] = $dbi->create_query($tmpls[1]);
512
-ok(!exists DBIx::Custom->_query_caches->{$tmpls[0]}, "$test : cache overflow deleted key");
513
-is(DBIx::Custom->_query_caches->{$tmpls[1]}{sql}, $queries[1]->sql, "$test : sql cache overflow deleted key");
514
-is_deeply(DBIx::Custom->_query_caches->{$tmpls[1]}{columns}, $queries[1]->columns, "$test : columns cache overflow deleted key");
515
-is(DBIx::Custom->_query_caches->{$tmpls[2]}{sql}, $queries[2]->sql, "$test : sql cache overflow deleted key");
516
-is_deeply(DBIx::Custom->_query_caches->{$tmpls[2]}{columns}, $queries[2]->columns, "$test : columns cache overflow deleted key");
517
-is_deeply(DBIx::Custom->_query_cache_keys, [@tmpls[1, 2]], "$test : cache key third");
518
-
519
-$query = $dbi->create_query($tmpls[0]);
520
-$query->filter('aaa');
521
-$query = $dbi->create_query($tmpls[0]);
522
-ok(!$query->filter, "$test : only cached sql and columns");
523
-$query->filter('bbb');
524
-$query = $dbi->create_query($tmpls[0]);
525
-ok(!$query->filter, "$test : only cached sql and columns");
526
-
527
-test 'fetch filter';
528
-$dbi = DBIx::Custom->new($NEW_ARGS->{0});
529
-$dbi->register_filter(
530
-    twice       => sub { $_[0] * 2 },
531
-    three_times => sub { $_[0] * 3 }
532
-);
533
-$dbi->default_fetch_filter('twice');
534
-$dbi->execute($CREATE_TABLE->{0});
535
-$dbi->insert('table1', {key1 => 1, key2 => 2});
536
-$result = $dbi->select('table1');
537
-$result->filter({key1 => 'three_times'});
538
-$row = $result->fetch_hash_single;
539
-is_deeply($row, {key1 => 3, key2 => 4}, "$test: default_fetch_filter and filter");
540
-
1
+use Test::More;
2
+use strict;
3
+use warnings;
4
+
5
+use utf8;
6
+use Encode qw/encode_utf8 decode_utf8/;
7
+
8
+BEGIN {
9
+    eval { require DBD::SQLite; 1 }
10
+        or plan skip_all => 'DBD::SQLite required';
11
+    eval { DBD::SQLite->VERSION >= 1.25 }
12
+        or plan skip_all => 'DBD::SQLite >= 1.25 required';
13
+
14
+    plan 'no_plan';
15
+    use_ok('DBIx::Custom');
16
+}
17
+
18
+# Function for test name
19
+my $test;
20
+sub test {
21
+    $test = shift;
22
+}
23
+
24
+# Constant varialbes for test
25
+my $CREATE_TABLE = {
26
+    0 => 'create table table1 (key1 char(255), key2 char(255));',
27
+    1 => 'create table table1 (key1 char(255), key2 char(255), key3 char(255), key4 char(255), key5 char(255));',
28
+    2 => 'create table table2 (key1 char(255), key3 char(255));'
29
+};
30
+
31
+my $SELECT_TMPLS = {
32
+    0 => 'select * from table1;'
33
+};
34
+
35
+my $DROP_TABLE = {
36
+    0 => 'drop table table1'
37
+};
38
+
39
+my $NEW_ARGS = {
40
+    0 => {data_source => 'dbi:SQLite:dbname=:memory:'}
41
+};
42
+
43
+# Variables
44
+my $dbi;
45
+my $sth;
46
+my $tmpl;
47
+my @tmpls;
48
+my $select_tmpl;
49
+my $insert_tmpl;
50
+my $update_tmpl;
51
+my $params;
52
+my $sql;
53
+my $result;
54
+my $row;
55
+my @rows;
56
+my $rows;
57
+my $query;
58
+my @queries;
59
+my $select_query;
60
+my $insert_query;
61
+my $update_query;
62
+my $ret_val;
63
+
64
+
65
+test 'disconnect';
66
+$dbi = DBIx::Custom->connect($NEW_ARGS->{0});
67
+$dbi->disconnect;
68
+ok(!$dbi->dbh, $test);
69
+
70
+
71
+test 'connected';
72
+$dbi = DBIx::Custom->connect($NEW_ARGS->{0});
73
+ok($dbi->connected, "$test : connected");
74
+
75
+# Prepare table
76
+$dbi = DBIx::Custom->connect($NEW_ARGS->{0});
77
+$dbi->execute($CREATE_TABLE->{0});
78
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
79
+$dbi->insert(table => 'table1', param => {key1 => 3, key2 => 4});
80
+
81
+test 'DBIx::Custom::Result test';
82
+$tmpl = "select key1, key2 from table1";
83
+$query = $dbi->create_query($tmpl);
84
+$result = $dbi->execute($query);
85
+
86
+@rows = ();
87
+while (my $row = $result->fetch) {
88
+    push @rows, [@$row];
89
+}
90
+is_deeply(\@rows, [[1, 2], [3, 4]], "$test : fetch scalar context");
91
+
92
+$result = $dbi->execute($query);
93
+@rows = ();
94
+while (my @row = $result->fetch) {
95
+    push @rows, [@row];
96
+}
97
+is_deeply(\@rows, [[1, 2], [3, 4]], "$test : fetch list context");
98
+
99
+$result = $dbi->execute($query);
100
+@rows = ();
101
+while (my $row = $result->fetch_hash) {
102
+    push @rows, {%$row};
103
+}
104
+is_deeply(\@rows, [{key1 => 1, key2 => 2}, {key1 => 3, key2 => 4}], "$test : fetch_hash scalar context");
105
+
106
+$result = $dbi->execute($query);
107
+@rows = ();
108
+while (my %row = $result->fetch_hash) {
109
+    push @rows, {%row};
110
+}
111
+is_deeply(\@rows, [{key1 => 1, key2 => 2}, {key1 => 3, key2 => 4}], "$test : fetch hash list context");
112
+
113
+$result = $dbi->execute($query);
114
+$rows = $result->fetch_all;
115
+is_deeply($rows, [[1, 2], [3, 4]], "$test : fetch_all scalar context");
116
+
117
+$result = $dbi->execute($query);
118
+@rows = $result->fetch_all;
119
+is_deeply(\@rows, [[1, 2], [3, 4]], "$test : fetch_all list context");
120
+
121
+$result = $dbi->execute($query);
122
+@rows = $result->fetch_hash_all;
123
+is_deeply($rows, [[1, 2], [3, 4]], "$test : fetch_hash_all scalar context");
124
+
125
+$result = $dbi->execute($query);
126
+@rows = $result->fetch_all;
127
+is_deeply(\@rows, [[1, 2], [3, 4]], "$test : fetch_hash_all list context");
128
+
129
+
130
+test 'Insert query return value';
131
+$dbi->execute($DROP_TABLE->{0});
132
+$dbi->execute($CREATE_TABLE->{0});
133
+$tmpl = "insert into table1 {insert key1 key2}";
134
+$query = $dbi->create_query($tmpl);
135
+$ret_val = $dbi->execute($query, param => {key1 => 1, key2 => 2});
136
+ok($ret_val, $test);
137
+
138
+
139
+test 'Direct query';
140
+$dbi->execute($DROP_TABLE->{0});
141
+$dbi->execute($CREATE_TABLE->{0});
142
+$insert_tmpl = "insert into table1 {insert key1 key2}";
143
+$dbi->execute($insert_tmpl, param => {key1 => 1, key2 => 2});
144
+$result = $dbi->execute($SELECT_TMPLS->{0});
145
+$rows = $result->fetch_hash_all;
146
+is_deeply($rows, [{key1 => 1, key2 => 2}], $test);
147
+
148
+test 'Filter basic';
149
+$dbi->execute($DROP_TABLE->{0});
150
+$dbi->execute($CREATE_TABLE->{0});
151
+$dbi->register_filter(twice       => sub { $_[0] * 2}, 
152
+                    three_times => sub { $_[0] * 3});
153
+
154
+$insert_tmpl  = "insert into table1 {insert key1 key2};";
155
+$insert_query = $dbi->create_query($insert_tmpl);
156
+$insert_query->filter({key1 => 'twice'});
157
+$dbi->execute($insert_query, param => {key1 => 1, key2 => 2});
158
+$result = $dbi->execute($SELECT_TMPLS->{0});
159
+$rows = $result->filter({key2 => 'three_times'})->fetch_hash_all;
160
+is_deeply($rows, [{key1 => 2, key2 => 6}], "$test : filter fetch_filter");
161
+$dbi->execute($DROP_TABLE->{0});
162
+
163
+test 'Filter in';
164
+$dbi->execute($CREATE_TABLE->{0});
165
+$insert_tmpl  = "insert into table1 {insert key1 key2};";
166
+$insert_query = $dbi->create_query($insert_tmpl);
167
+$dbi->execute($insert_query, param => {key1 => 2, key2 => 4});
168
+$select_tmpl = "select * from table1 where {in table1.key1 2} and {in table1.key2 2}";
169
+$select_query = $dbi->create_query($select_tmpl);
170
+$select_query->filter({'table1.key1' => 'twice'});
171
+$result = $dbi->execute($select_query, param => {'table1.key1' => [1,5], 'table1.key2' => [2,4]});
172
+$rows = $result->fetch_hash_all;
173
+is_deeply($rows, [{key1 => 2, key2 => 4}], "$test : filter");
174
+
175
+test 'DBIx::Custom::SQLTemplate basic tag';
176
+$dbi->execute($DROP_TABLE->{0});
177
+$dbi->execute($CREATE_TABLE->{1});
178
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5});
179
+$dbi->insert(table => 'table1', param => {key1 => 6, key2 => 7, key3 => 8, key4 => 9, key5 => 10});
180
+
181
+$tmpl = "select * from table1 where {= key1} and {<> key2} and {< key3} and {> key4} and {>= key5};";
182
+$query = $dbi->create_query($tmpl);
183
+$result = $dbi->execute($query, param => {key1 => 1, key2 => 3, key3 => 4, key4 => 3, key5 => 5});
184
+$rows = $result->fetch_hash_all;
185
+is_deeply($rows, [{key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5}], "$test : basic tag1");
186
+
187
+$tmpl = "select * from table1 where {<= key1} and {like key2};";
188
+$query = $dbi->create_query($tmpl);
189
+$result = $dbi->execute($query, param => {key1 => 1, key2 => '%2%'});
190
+$rows = $result->fetch_hash_all;
191
+is_deeply($rows, [{key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5}], "$test : basic tag2");
192
+
193
+test 'DIB::Custom::SQLTemplate in tag';
194
+$dbi->execute($DROP_TABLE->{0});
195
+$dbi->execute($CREATE_TABLE->{1});
196
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5});
197
+$dbi->insert(table => 'table1', param => {key1 => 6, key2 => 7, key3 => 8, key4 => 9, key5 => 10});
198
+
199
+$tmpl = "select * from table1 where {in key1 2};";
200
+$query = $dbi->create_query($tmpl);
201
+$result = $dbi->execute($query, param => {key1 => [9, 1]});
202
+$rows = $result->fetch_hash_all;
203
+is_deeply($rows, [{key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5}], "$test : basic");
204
+
205
+test 'DBIx::Custom::SQLTemplate insert tag';
206
+$dbi->execute("delete from table1");
207
+$insert_tmpl = 'insert into table1 {insert key1 key2 key3 key4 key5}';
208
+$dbi->execute($insert_tmpl, param => {key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5});
209
+
210
+$result = $dbi->execute($SELECT_TMPLS->{0});
211
+$rows = $result->fetch_hash_all;
212
+is_deeply($rows, [{key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5}], "$test : basic");
213
+
214
+test 'DBIx::Custom::SQLTemplate update tag';
215
+$dbi->execute("delete from table1");
216
+$insert_tmpl = "insert into table1 {insert key1 key2 key3 key4 key5}";
217
+$dbi->execute($insert_tmpl, param => {key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5});
218
+$dbi->execute($insert_tmpl, param => {key1 => 6, key2 => 7, key3 => 8, key4 => 9, key5 => 10});
219
+
220
+$update_tmpl = 'update table1 {update key1 key2 key3 key4} where {= key5}';
221
+$dbi->execute($update_tmpl, param => {key1 => 1, key2 => 1, key3 => 1, key4 => 1, key5 => 5});
222
+
223
+$result = $dbi->execute($SELECT_TMPLS->{0});
224
+$rows = $result->fetch_hash_all;
225
+is_deeply($rows, [{key1 => 1, key2 => 1, key3 => 1, key4 => 1, key5 => 5},
226
+                  {key1 => 6, key2 => 7, key3 => 8, key4 => 9, key5 => 10}], "$test : basic");
227
+
228
+test 'Error case';
229
+eval {DBIx::Custom->connect(data_source => 'dbi:SQLit')};
230
+ok($@, "$test : connect error");
231
+
232
+$dbi = DBIx::Custom->connect($NEW_ARGS->{0});
233
+eval{$dbi->create_query("{p }")};
234
+ok($@, "$test : create_query invalid SQL template");
235
+
236
+test 'insert';
237
+$dbi = DBIx::Custom->connect($NEW_ARGS->{0});
238
+$dbi->execute($CREATE_TABLE->{0});
239
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
240
+$dbi->insert(table => 'table1', param => {key1 => 3, key2 => 4});
241
+$result = $dbi->execute($SELECT_TMPLS->{0});
242
+$rows   = $result->fetch_hash_all;
243
+is_deeply($rows, [{key1 => 1, key2 => 2}, {key1 => 3, key2 => 4}], "$test : basic");
244
+
245
+$dbi->execute('delete from table1');
246
+$dbi->register_filter(
247
+    twice       => sub { $_[0] * 2 },
248
+    three_times => sub { $_[0] * 3 }
249
+);
250
+$dbi->default_query_filter('twice');
251
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2}, filter => {key1 => 'three_times'});
252
+$result = $dbi->execute($SELECT_TMPLS->{0});
253
+$rows   = $result->fetch_hash_all;
254
+is_deeply($rows, [{key1 => 3, key2 => 4}], "$test : filter");
255
+$dbi->default_query_filter(undef);
256
+
257
+$dbi->execute($DROP_TABLE->{0});
258
+$dbi->execute($CREATE_TABLE->{0});
259
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2}, append => '   ');
260
+$rows = $dbi->select(table => 'table1')->fetch_hash_all;
261
+is_deeply($rows, [{key1 => 1, key2 => 2}], 'insert append');
262
+
263
+test 'update';
264
+$dbi = DBIx::Custom->connect($NEW_ARGS->{0});
265
+$dbi->execute($CREATE_TABLE->{1});
266
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5});
267
+$dbi->insert(table => 'table1', param => {key1 => 6, key2 => 7, key3 => 8, key4 => 9, key5 => 10});
268
+$dbi->update(table => 'table1', param => {key2 => 11}, where => {key1 => 1});
269
+$result = $dbi->execute($SELECT_TMPLS->{0});
270
+$rows   = $result->fetch_hash_all;
271
+is_deeply($rows, [{key1 => 1, key2 => 11, key3 => 3, key4 => 4, key5 => 5},
272
+                  {key1 => 6, key2 => 7,  key3 => 8, key4 => 9, key5 => 10}],
273
+                  "$test : basic");
274
+                  
275
+$dbi->execute("delete from table1");
276
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5});
277
+$dbi->insert(table => 'table1', param => {key1 => 6, key2 => 7, key3 => 8, key4 => 9, key5 => 10});
278
+$dbi->update(table => 'table1', param => {key2 => 12}, where => {key2 => 2, key3 => 3});
279
+$result = $dbi->execute($SELECT_TMPLS->{0});
280
+$rows   = $result->fetch_hash_all;
281
+is_deeply($rows, [{key1 => 1, key2 => 12, key3 => 3, key4 => 4, key5 => 5},
282
+                  {key1 => 6, key2 => 7,  key3 => 8, key4 => 9, key5 => 10}],
283
+                  "$test : update key same as search key");
284
+
285
+$dbi->execute("delete from table1");
286
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5});
287
+$dbi->insert(table => 'table1', param => {key1 => 6, key2 => 7, key3 => 8, key4 => 9, key5 => 10});
288
+$dbi->register_filter(twice => sub { $_[0] * 2 });
289
+$dbi->update(table => 'table1', param => {key2 => 11}, where => {key1 => 1},
290
+              filter => {key2 => 'twice'});
291
+$result = $dbi->execute($SELECT_TMPLS->{0});
292
+$rows   = $result->fetch_hash_all;
293
+is_deeply($rows, [{key1 => 1, key2 => 22, key3 => 3, key4 => 4, key5 => 5},
294
+                  {key1 => 6, key2 => 7,  key3 => 8, key4 => 9, key5 => 10}],
295
+                  "$test : filter");
296
+
297
+
298
+$result = $dbi->update(table => 'table1', param => {key2 => 11}, where => {key1 => 1}, append => '   ');
299
+
300
+test 'update_all';
301
+$dbi = DBIx::Custom->connect($NEW_ARGS->{0});
302
+$dbi->execute($CREATE_TABLE->{1});
303
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5});
304
+$dbi->insert(table => 'table1', param => {key1 => 6, key2 => 7, key3 => 8, key4 => 9, key5 => 10});
305
+$dbi->register_filter(twice => sub { $_[0] * 2 });
306
+$dbi->update_all(table => 'table1', param => {key2 => 10}, filter => {key2 => 'twice'});
307
+$result = $dbi->execute($SELECT_TMPLS->{0});
308
+$rows   = $result->fetch_hash_all;
309
+is_deeply($rows, [{key1 => 1, key2 => 20, key3 => 3, key4 => 4, key5 => 5},
310
+                  {key1 => 6, key2 => 20, key3 => 8, key4 => 9, key5 => 10}],
311
+                  "$test : filter");
312
+
313
+
314
+test 'delete';
315
+$dbi = DBIx::Custom->connect($NEW_ARGS->{0});
316
+$dbi->execute($CREATE_TABLE->{0});
317
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
318
+$dbi->insert(table => 'table1', param => {key1 => 3, key2 => 4});
319
+$dbi->delete(table => 'table1', where => {key1 => 1});
320
+$result = $dbi->execute($SELECT_TMPLS->{0});
321
+$rows   = $result->fetch_hash_all;
322
+is_deeply($rows, [{key1 => 3, key2 => 4}], "$test : basic");
323
+
324
+$dbi->execute("delete from table1;");
325
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
326
+$dbi->insert(table => 'table1', param => {key1 => 3, key2 => 4});
327
+$dbi->register_filter(twice => sub { $_[0] * 2 });
328
+$dbi->delete(table => 'table1', where => {key2 => 1}, filter => {key2 => 'twice'});
329
+$result = $dbi->execute($SELECT_TMPLS->{0});
330
+$rows   = $result->fetch_hash_all;
331
+is_deeply($rows, [{key1 => 3, key2 => 4}], "$test : filter");
332
+
333
+$dbi->delete(table => 'table1', where => {key1 => 1}, append => '   ');
334
+
335
+$dbi->delete_all(table => 'table1');
336
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
337
+$dbi->insert(table => 'table1', param => {key1 => 3, key2 => 4});
338
+$dbi->delete(table => 'table1', where => {key1 => 1, key2 => 2});
339
+$rows = $dbi->select(table => 'table1')->fetch_hash_all;
340
+is_deeply($rows, [{key1 => 3, key2 => 4}], "$test : delete multi key");
341
+
342
+__END__
343
+
344
+test 'delete error';
345
+$dbi = DBIx::Custom->connect($NEW_ARGS->{0});
346
+$dbi->execute($CREATE_TABLE->{0});
347
+eval{$dbi->delete(table => 'table1')};
348
+like($@, qr/Key-value pairs for where clause must be specified to 'delete' second argument/,
349
+         "$test : where key-value pairs not specified");
350
+
351
+test 'delete_all';
352
+$dbi = DBIx::Custom->connect($NEW_ARGS->{0});
353
+$dbi->execute($CREATE_TABLE->{0});
354
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
355
+$dbi->insert(table => 'table1', param => {key1 => 3, key2 => 4});
356
+$dbi->delete_all(table => 'table1');
357
+$result = $dbi->execute($SELECT_TMPLS->{0});
358
+$rows   = $result->fetch_hash_all;
359
+is_deeply($rows, [], "$test : basic");
360
+
361
+
362
+test 'select';
363
+$dbi = DBIx::Custom->connect($NEW_ARGS->{0});
364
+$dbi->execute($CREATE_TABLE->{0});
365
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
366
+$dbi->insert(table => 'table1', param => {key1 => 3, key2 => 4});
367
+$rows = $dbi->select(table => 'table1')->fetch_hash_all;
368
+is_deeply($rows, [{key1 => 1, key2 => 2},
369
+                  {key1 => 3, key2 => 4}], "$test : table");
370
+
371
+$rows = $dbi->select(table => 'table1', columns => ['key1'])->fetch_hash_all;
372
+is_deeply($rows, [{key1 => 1}, {key1 => 3}], "$test : table and columns and where key");
373
+
374
+$rows = $dbi->select(table => 'table1', where => {key1 => 1})->fetch_hash_all;
375
+is_deeply($rows, [{key1 => 1, key2 => 2}], "$test : table and columns and where key");
376
+
377
+$rows = $dbi->select(table => 'table1', columns => ['key1'], where => {key1 => 3})->fetch_hash_all;
378
+is_deeply($rows, [{key1 => 3}], "$test : table and columns and where key");
379
+
380
+$rows = $dbi->select(table => 'table1', append => "order by key1 desc limit 1")->fetch_hash_all;
381
+is_deeply($rows, [{key1 => 3, key2 => 4}], "$test : append statement");
382
+
383
+$dbi->register_filter(decrement => sub { $_[0] - 1 });
384
+$rows = $dbi->select(table => 'table1', {where => {key1 => 2}, filter => {key1 => 'decrement'})
385
+            ->fetch_hash_all;
386
+is_deeply($rows, [{key1 => 1, key2 => 2}], "$test : filter");
387
+
388
+$dbi->execute($CREATE_TABLE->{2});
389
+$dbi->insert(table => 'table2', param => {key1 => 1, key3 => 5});
390
+$rows = $dbi->select(
391
+    table => [qw/table1 table2/],
392
+    columns => ['table1.key1 as table1_key1', 'table2.key1 as table2_key1', 'key2', 'key3'],
393
+    where   => {'table1.key2' => 2},
394
+    append  => "where table1.key1 = table2.key1"
395
+)->fetch_hash_all;
396
+is_deeply($rows, [{table1_key1 => 1, table2_key1 => 1, key2 => 2, key3 => 5}], "$test : join");
397
+
398
+test 'Cache';
399
+$dbi = DBIx::Custom->connect($NEW_ARGS->{0});
400
+DBIx::Custom->query_cache_max(2);
401
+$dbi->execute($CREATE_TABLE->{0});
402
+delete $DBIx::Custom::CLASS_ATTRS->{_query_caches};
403
+delete $DBIx::Custom::CLASS_ATTRS->{_query_cache_keys};
404
+$tmpls[0] = "insert into table1 {insert key1 key2}";
405
+$queries[0] = $dbi->create_query($tmpls[0]);
406
+is(DBIx::Custom->_query_caches->{$tmpls[0]}{sql}, $queries[0]->sql, "$test : sql first");
407
+is(DBIx::Custom->_query_caches->{$tmpls[0]}{columns}, $queries[0]->columns, "$test : columns first");
408
+is_deeply(DBIx::Custom->_query_cache_keys, [@tmpls], "$test : cache key first");
409
+
410
+$tmpls[1] = "select * from table1";
411
+$queries[1] = $dbi->create_query($tmpls[1]);
412
+is(DBIx::Custom->_query_caches->{$tmpls[0]}{sql}, $queries[0]->sql, "$test : sql first");
413
+is(DBIx::Custom->_query_caches->{$tmpls[0]}{columns}, $queries[0]->columns, "$test : columns first");
414
+is(DBIx::Custom->_query_caches->{$tmpls[1]}{sql}, $queries[1]->sql, "$test : sql second");
415
+is(DBIx::Custom->_query_caches->{$tmpls[1]}{columns}, $queries[1]->columns, "$test : columns second");
416
+is_deeply(DBIx::Custom->_query_cache_keys, [@tmpls], "$test : cache key second");
417
+
418
+$tmpls[2] = "select key1, key2 from table1";
419
+$queries[2] = $dbi->create_query($tmpls[2]);
420
+ok(!exists DBIx::Custom->_query_caches->{$tmpls[0]}, "$test : cache overflow deleted key");
421
+is(DBIx::Custom->_query_caches->{$tmpls[1]}{sql}, $queries[1]->sql, "$test : sql cache overflow deleted key");
422
+is(DBIx::Custom->_query_caches->{$tmpls[1]}{columns}, $queries[1]->columns, "$test : columns cache overflow deleted key");
423
+is(DBIx::Custom->_query_caches->{$tmpls[2]}{sql}, $queries[2]->sql, "$test : sql cache overflow deleted key");
424
+is(DBIx::Custom->_query_caches->{$tmpls[2]}{columns}, $queries[2]->columns, "$test : columns cache overflow deleted key");
425
+is_deeply(DBIx::Custom->_query_cache_keys, [@tmpls[1, 2]], "$test : cache key third");
426
+
427
+$queries[1] = $dbi->create_query($tmpls[1]);
428
+ok(!exists DBIx::Custom->_query_caches->{$tmpls[0]}, "$test : cache overflow deleted key");
429
+is(DBIx::Custom->_query_caches->{$tmpls[1]}{sql}, $queries[1]->sql, "$test : sql cache overflow deleted key");
430
+is_deeply(DBIx::Custom->_query_caches->{$tmpls[1]}{columns}, $queries[1]->columns, "$test : columns cache overflow deleted key");
431
+is(DBIx::Custom->_query_caches->{$tmpls[2]}{sql}, $queries[2]->sql, "$test : sql cache overflow deleted key");
432
+is_deeply(DBIx::Custom->_query_caches->{$tmpls[2]}{columns}, $queries[2]->columns, "$test : columns cache overflow deleted key");
433
+is_deeply(DBIx::Custom->_query_cache_keys, [@tmpls[1, 2]], "$test : cache key third");
434
+
435
+$query = $dbi->create_query($tmpls[0]);
436
+$query->filter('aaa');
437
+$query = $dbi->create_query($tmpls[0]);
438
+ok(!$query->filter, "$test : only cached sql and columns");
439
+$query->filter('bbb');
440
+$query = $dbi->create_query($tmpls[0]);
441
+ok(!$query->filter, "$test : only cached sql and columns");
442
+
443
+test 'fetch filter';
444
+$dbi = DBIx::Custom->connect($NEW_ARGS->{0});
445
+$dbi->register_filter(
446
+    twice       => sub { $_[0] * 2 },
447
+    three_times => sub { $_[0] * 3 }
448
+);
449
+$dbi->default_fetch_filter('twice');
450
+$dbi->execute($CREATE_TABLE->{0});
451
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
452
+$result = $dbi->select(table => 'table1');
453
+$result->filter({key1 => 'three_times'});
454
+$row = $result->fetch_hash_single;
455
+is_deeply($row, {key1 => 3, key2 => 4}, "$test: default_fetch_filter and filter");
456
+
457
+test 'filters';
458
+$dbi = DBIx::Custom->new;
459
+
460
+ok($dbi->filters->{decode_utf8}->(encode_utf8('あ')),
461
+   'あ', "$test : decode_utf8;);
462
+
463
+is($dbi->filters->{encode_utf8}->('あ'),
464
+   encode_utf8('あ'), "$test : encode_utf8");
465
+
+2 -20
t/dbix-custom-core.t
... ...
@@ -33,12 +33,12 @@ $dbi = DBIx::Custom->new(
33 33
     default_bind_filter => 'f',
34 34
     default_fetch_filter => 'g',
35 35
     result_class => 'g',
36
-    sql_tmpl => $SQL_TMPL->{0},
36
+    sql_template => $SQL_TMPL->{0},
37 37
 );
38 38
 is_deeply($dbi,{user => 'a', database => 'a', password => 'b', data_source => 'c', 
39 39
                 options => {d => 1, e => 2}, filters => {f => 3}, default_bind_filter => 'f',
40 40
                 default_fetch_filter => 'g', result_class => 'g',
41
-                sql_tmpl => $SQL_TMPL->{0}}, $test);
41
+                sql_template => $SQL_TMPL->{0}}, $test);
42 42
 isa_ok($dbi, 'DBIx::Custom');
43 43
 
44 44
 
... ...
@@ -49,24 +49,18 @@ test 'Sub class constructor';
49 49
     
50 50
     __PACKAGE__
51 51
       ->filters({f => 3})
52
-      ->formats({f => 3})
53 52
     ;
54 53
 }
55 54
 $dbi = DBIx::Custom::T1->new(
56 55
     filters => {
57 56
         fo => 30,
58 57
     },
59
-    formats => {
60
-        fo => 30,
61
-    },
62 58
 );
63 59
 is_deeply(scalar $dbi->filters, {fo => 30}, "$test : filters");
64
-is_deeply(scalar $dbi->formats, {fo => 30}, "$test : formats");
65 60
 
66 61
 test 'Sub class constructor default';
67 62
 $dbi = DBIx::Custom::T1->new;
68 63
 is_deeply($dbi->filters, {f => 3}, "$test : filters");
69
-is_deeply($dbi->formats, {f => 3}, "$test : formats");
70 64
 isa_ok($dbi, 'DBIx::Custom::T1');
71 65
 
72 66
 
... ...
@@ -77,7 +71,6 @@ test 'Sub sub class constructor default';
77 71
 }
78 72
 $dbi = DBIx::Custom::T1_2->new;
79 73
 is_deeply(scalar $dbi->filters, {f => 3}, "$test : filters");
80
-is_deeply(scalar $dbi->formats, {f => 3}, "$test : formats");
81 74
 isa_ok($dbi, 'DBIx::Custom::T1_2');
82 75
 
83 76
 
... ...
@@ -88,12 +81,10 @@ test 'Customized sub class constructor default';
88 81
     
89 82
     __PACKAGE__
90 83
       ->filters({fo => 30})
91
-      ->formats({fo => 30})
92 84
     ;
93 85
 }
94 86
 $dbi = DBIx::Custom::T1_3->new;
95 87
 is_deeply(scalar $dbi->filters, {fo => 30}, "$test : filters");
96
-is_deeply(scalar $dbi->formats, {fo => 30}, "$test : formats");
97 88
 isa_ok($dbi, 'DBIx::Custom::T1_3');
98 89
 
99 90
 
... ...
@@ -102,12 +93,8 @@ $dbi = DBIx::Custom::T1_3->new(
102 93
     filters => {
103 94
         f => 3,
104 95
     },
105
-    formats => {
106
-        f => 3,
107
-    },
108 96
 );
109 97
 is_deeply($dbi->filters, {f => 3}, "$test : filters");
110
-is_deeply($dbi->formats, {f => 3}, "$test : formats");
111 98
 isa_ok($dbi, 'DBIx::Custom');
112 99
 
113 100
 
... ...
@@ -116,11 +103,6 @@ $dbi = DBIx::Custom->new;
116 103
 $dbi->register_filter(a => sub {1});
117 104
 is($dbi->filters->{a}->(), 1, $test);
118 105
 
119
-test 'register_formats';
120
-$dbi = DBIx::Custom->new;
121
-$dbi->register_format(a => sub {1});
122
-is($dbi->formats->{a}->(), 1, $test);
123
-
124 106
 test 'Accessor';
125 107
 $dbi = DBIx::Custom->new;
126 108
 $dbi->options({opt1 => 1, opt2 => 2});
-85
t/dbix-custom-mysql-timeformat.t
... ...
@@ -1,85 +0,0 @@
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
-
-85
t/dbix-custom-sqlite-timeformat.t
... ...
@@ -1,85 +0,0 @@
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
-
+4 -4
t/dbix-custom-sqlite.t
... ...
@@ -39,8 +39,8 @@ $dbi = DBIx::Custom::SQLite->new;
39 39
 $dbi->connect_memory;
40 40
 $ret_val = $dbi->execute($CREATE_TABLE->{0});
41 41
 ok(defined $ret_val, $test);
42
-$dbi->insert('table1', {key1 => 'a', key2 => 2});
43
-$rows = $dbi->select('table1', {where => {key1 => 'a'}})->fetch_hash_all;
42
+$dbi->insert(table => 'table1', param => {key1 => 'a', key2 => 2});
43
+$rows = $dbi->select(table => 'table1', where => {key1 => 'a'})->fetch_hash_all;
44 44
 is_deeply($rows, [{key1 => 'a', key2 => 2}], "$test : select rows");
45 45
 
46 46
 test 'connect_memory error';
... ...
@@ -71,8 +71,8 @@ test 'last_insert_rowid';
71 71
 $dbi = DBIx::Custom::SQLite->new;
72 72
 $dbi->connect_memory;
73 73
 $ret_val = $dbi->execute($CREATE_TABLE->{0});
74
-$dbi->insert('table1', {key1 => 1, key2 => 2});
74
+$dbi->insert({table => 'table1', param => {key1 => 1, key2 => 2}});
75 75
 is($dbi->last_insert_rowid, 1, "$test: first");
76
-$dbi->insert('table1', {key1 => 1, key2 => 2});
76
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
77 77
 is($dbi->last_insert_rowid, 2, "$test: second");
78 78
 $dbi->disconnect;