| ... | ... | 
                  @@ -308,7 +308,7 @@ sub _build_bind_values {
                 | 
              
| 308 | 308 | 
                   | 
              
| 309 | 309 | 
                  # Filter  | 
              
| 310 | 310 | 
                  push @bind_values,  | 
              
| 311 | 
                  - $filter ? $filter->($value, $table, $column, $self->filters)  | 
              |
| 311 | 
                  + $filter ? $filter->($value, $table, $column, $self)  | 
              |
| 312 | 312 | 
                  : $value;  | 
              
| 313 | 313 | 
                  }  | 
              
| 314 | 314 | 
                   | 
              
| ... | ... | 
                  @@ -317,6 +317,62 @@ sub _build_bind_values {
                 | 
              
| 317 | 317 | 
                   | 
              
| 318 | 318 | 
                   sub transaction { DBIx::Custom::Transaction->new(dbi => shift) }
                 | 
              
| 319 | 319 | 
                   | 
              
| 320 | 
                  +sub run_transaction {
                 | 
              |
| 321 | 
                  + my ($self, $transaction) = @_;  | 
              |
| 322 | 
                  +  | 
              |
| 323 | 
                  + # DBIx::Custom object  | 
              |
| 324 | 
                  + my $dbi = $self->dbi;  | 
              |
| 325 | 
                  +  | 
              |
| 326 | 
                  + # Shorcut  | 
              |
| 327 | 
                  + return unless $dbi;  | 
              |
| 328 | 
                  +  | 
              |
| 329 | 
                  + # Check auto commit  | 
              |
| 330 | 
                  +    croak("AutoCommit must be true before transaction start")
                 | 
              |
| 331 | 
                  + unless $dbi->_auto_commit;  | 
              |
| 332 | 
                  +  | 
              |
| 333 | 
                  + # Auto commit off  | 
              |
| 334 | 
                  + $dbi->_auto_commit(0);  | 
              |
| 335 | 
                  +  | 
              |
| 336 | 
                  + # Run transaction  | 
              |
| 337 | 
                  +    eval {$transaction->()};
                 | 
              |
| 338 | 
                  +  | 
              |
| 339 | 
                  + # Tranzaction error  | 
              |
| 340 | 
                  + my $transaction_error = $@;  | 
              |
| 341 | 
                  +  | 
              |
| 342 | 
                  + # Tranzaction is failed.  | 
              |
| 343 | 
                  +    if ($transaction_error) {
                 | 
              |
| 344 | 
                  + # Rollback  | 
              |
| 345 | 
                  +        eval{$dbi->dbh->rollback};
                 | 
              |
| 346 | 
                  +  | 
              |
| 347 | 
                  + # Rollback error  | 
              |
| 348 | 
                  + my $rollback_error = $@;  | 
              |
| 349 | 
                  +  | 
              |
| 350 | 
                  + # Auto commit on  | 
              |
| 351 | 
                  + $dbi->_auto_commit(1);  | 
              |
| 352 | 
                  +  | 
              |
| 353 | 
                  +        if ($rollback_error) {
                 | 
              |
| 354 | 
                  + # Rollback is failed  | 
              |
| 355 | 
                  +            croak("${transaction_error}Rollback is failed : $rollback_error");
                 | 
              |
| 356 | 
                  + }  | 
              |
| 357 | 
                  +        else {
                 | 
              |
| 358 | 
                  + # Rollback is success  | 
              |
| 359 | 
                  +            croak("${transaction_error}Rollback is success");
                 | 
              |
| 360 | 
                  + }  | 
              |
| 361 | 
                  + }  | 
              |
| 362 | 
                  + # Tranzaction is success  | 
              |
| 363 | 
                  +    else {
                 | 
              |
| 364 | 
                  + # Commit  | 
              |
| 365 | 
                  +        eval{$dbi->dbh->commit};
                 | 
              |
| 366 | 
                  + my $commit_error = $@;  | 
              |
| 367 | 
                  +  | 
              |
| 368 | 
                  + # Auto commit on  | 
              |
| 369 | 
                  + $dbi->_auto_commit(1);  | 
              |
| 370 | 
                  +  | 
              |
| 371 | 
                  + # Commit is failed  | 
              |
| 372 | 
                  + croak($commit_error) if $commit_error;  | 
              |
| 373 | 
                  + }  | 
              |
| 374 | 
                  +}  | 
              |
| 375 | 
                  +  | 
              |
| 320 | 376 | 
                   sub create_table {
                 | 
              
| 321 | 377 | 
                  my ($self, $table, @column_definitions) = @_;  | 
              
| 322 | 378 | 
                   | 
              
| ... | ... | 
                  @@ -1139,6 +1195,10 @@ This method is same as DBI do method.  | 
              
| 1139 | 1195 | 
                   | 
              
| 1140 | 1196 | 
                  See also L<DBI>  | 
              
| 1141 | 1197 | 
                   | 
              
| 1198 | 
                  +=head2 run_transaction  | 
              |
| 1199 | 
                  +  | 
              |
| 1200 | 
                  +  | 
              |
| 1201 | 
                  +  | 
              |
| 1142 | 1202 | 
                  =head1 DBIx::Custom default configuration  | 
              
| 1143 | 1203 | 
                   | 
              
| 1144 | 1204 | 
                  DBIx::Custom have DBI object.  | 
              
| ... | ... | 
                  @@ -1,71 +0,0 @@  | 
              
| 1 | 
                  -package DBIx::Custom::Column;  | 
              |
| 2 | 
                  -  | 
              |
| 3 | 
                  -use strict;  | 
              |
| 4 | 
                  -use warnings;  | 
              |
| 5 | 
                  -  | 
              |
| 6 | 
                  -use base 'Object::Simple';  | 
              |
| 7 | 
                  -  | 
              |
| 8 | 
                  -__PACKAGE__->attr([qw/column id table/]);  | 
              |
| 9 | 
                  -  | 
              |
| 10 | 
                  -sub parse {
                 | 
              |
| 11 | 
                  - my ($self, $key) = @_;  | 
              |
| 12 | 
                  -  | 
              |
| 13 | 
                  - $key ||= '';  | 
              |
| 14 | 
                  -  | 
              |
| 15 | 
                  -    unless ($key =~ /\./) {
                 | 
              |
| 16 | 
                  - $self->column($key);  | 
              |
| 17 | 
                  -        $self->table('');
                 | 
              |
| 18 | 
                  - return $self;  | 
              |
| 19 | 
                  - }  | 
              |
| 20 | 
                  -  | 
              |
| 21 | 
                  - my ($table, $column) = split /\./, $key;  | 
              |
| 22 | 
                  -  | 
              |
| 23 | 
                  - $self->column($column);  | 
              |
| 24 | 
                  - $self->table($table);  | 
              |
| 25 | 
                  -  | 
              |
| 26 | 
                  - return $self;  | 
              |
| 27 | 
                  -}  | 
              |
| 28 | 
                  -  | 
              |
| 29 | 
                  -1;  | 
              |
| 30 | 
                  -  | 
              |
| 31 | 
                  -=head1 NAME  | 
              |
| 32 | 
                  -  | 
              |
| 33 | 
                  -DBIx::Custom::Column - DBIx::Custom column  | 
              |
| 34 | 
                  -  | 
              |
| 35 | 
                  -=head1 SYNOPSIS  | 
              |
| 36 | 
                  -  | 
              |
| 37 | 
                  - # New  | 
              |
| 38 | 
                  - my $column = DBIx::Custom::Column->new;  | 
              |
| 39 | 
                  -  | 
              |
| 40 | 
                  - # Parse  | 
              |
| 41 | 
                  -    $column->parse('books.author@IDxxx');
                 | 
              |
| 42 | 
                  -  | 
              |
| 43 | 
                  - # Attributes  | 
              |
| 44 | 
                  - my $name = $column->name;  | 
              |
| 45 | 
                  - my $table = $column->table;  | 
              |
| 46 | 
                  - my $id = $column->id;  | 
              |
| 47 | 
                  -  | 
              |
| 48 | 
                  -=head1 ATTRIBUTES  | 
              |
| 49 | 
                  -  | 
              |
| 50 | 
                  -=head2 id  | 
              |
| 51 | 
                  -  | 
              |
| 52 | 
                  - $column = $column->id($id);  | 
              |
| 53 | 
                  - $id = $column->id  | 
              |
| 54 | 
                  -  | 
              |
| 55 | 
                  -=head2 name  | 
              |
| 56 | 
                  -  | 
              |
| 57 | 
                  - $column = $column->name($name);  | 
              |
| 58 | 
                  - $name = $column->name  | 
              |
| 59 | 
                  -  | 
              |
| 60 | 
                  -=head2 table  | 
              |
| 61 | 
                  -  | 
              |
| 62 | 
                  - $column = $column->table($table);  | 
              |
| 63 | 
                  - $table = $column->table  | 
              |
| 64 | 
                  -  | 
              |
| 65 | 
                  -=head1 METHODS  | 
              |
| 66 | 
                  -  | 
              |
| 67 | 
                  -=head2 parse  | 
              |
| 68 | 
                  -  | 
              |
| 69 | 
                  -    $column->parse('books.author@IDxxx');
                 | 
              |
| 70 | 
                  -  | 
              |
| 71 | 
                  -=cut  | 
              
| ... | ... | 
                  @@ -1,96 +0,0 @@  | 
              
| 1 | 
                  -package DBIx::Custom::Transaction;  | 
              |
| 2 | 
                  -  | 
              |
| 3 | 
                  -use strict;  | 
              |
| 4 | 
                  -use warnings;  | 
              |
| 5 | 
                  -  | 
              |
| 6 | 
                  -use base 'Object::Simple';  | 
              |
| 7 | 
                  -use Carp 'croak';  | 
              |
| 8 | 
                  -  | 
              |
| 9 | 
                  -__PACKAGE__->attr('dbi');
                 | 
              |
| 10 | 
                  -  | 
              |
| 11 | 
                  -sub run {
                 | 
              |
| 12 | 
                  - my ($self, $transaction) = @_;  | 
              |
| 13 | 
                  -  | 
              |
| 14 | 
                  - # DBIx::Custom object  | 
              |
| 15 | 
                  - my $dbi = $self->dbi;  | 
              |
| 16 | 
                  -  | 
              |
| 17 | 
                  - # Shorcut  | 
              |
| 18 | 
                  - return unless $dbi;  | 
              |
| 19 | 
                  -  | 
              |
| 20 | 
                  - # Check auto commit  | 
              |
| 21 | 
                  -    croak("AutoCommit must be true before transaction start")
                 | 
              |
| 22 | 
                  - unless $dbi->_auto_commit;  | 
              |
| 23 | 
                  -  | 
              |
| 24 | 
                  - # Auto commit off  | 
              |
| 25 | 
                  - $dbi->_auto_commit(0);  | 
              |
| 26 | 
                  -  | 
              |
| 27 | 
                  - # Run transaction  | 
              |
| 28 | 
                  -    eval {$transaction->()};
                 | 
              |
| 29 | 
                  -  | 
              |
| 30 | 
                  - # Tranzaction error  | 
              |
| 31 | 
                  - my $transaction_error = $@;  | 
              |
| 32 | 
                  -  | 
              |
| 33 | 
                  - # Tranzaction is failed.  | 
              |
| 34 | 
                  -    if ($transaction_error) {
                 | 
              |
| 35 | 
                  - # Rollback  | 
              |
| 36 | 
                  -        eval{$dbi->dbh->rollback};
                 | 
              |
| 37 | 
                  -  | 
              |
| 38 | 
                  - # Rollback error  | 
              |
| 39 | 
                  - my $rollback_error = $@;  | 
              |
| 40 | 
                  -  | 
              |
| 41 | 
                  - # Auto commit on  | 
              |
| 42 | 
                  - $dbi->_auto_commit(1);  | 
              |
| 43 | 
                  -  | 
              |
| 44 | 
                  -        if ($rollback_error) {
                 | 
              |
| 45 | 
                  - # Rollback is failed  | 
              |
| 46 | 
                  -            croak("${transaction_error}Rollback is failed : $rollback_error");
                 | 
              |
| 47 | 
                  - }  | 
              |
| 48 | 
                  -        else {
                 | 
              |
| 49 | 
                  - # Rollback is success  | 
              |
| 50 | 
                  -            croak("${transaction_error}Rollback is success");
                 | 
              |
| 51 | 
                  - }  | 
              |
| 52 | 
                  - }  | 
              |
| 53 | 
                  - # Tranzaction is success  | 
              |
| 54 | 
                  -    else {
                 | 
              |
| 55 | 
                  - # Commit  | 
              |
| 56 | 
                  -        eval{$dbi->dbh->commit};
                 | 
              |
| 57 | 
                  - my $commit_error = $@;  | 
              |
| 58 | 
                  -  | 
              |
| 59 | 
                  - # Auto commit on  | 
              |
| 60 | 
                  - $dbi->_auto_commit(1);  | 
              |
| 61 | 
                  -  | 
              |
| 62 | 
                  - # Commit is failed  | 
              |
| 63 | 
                  - croak($commit_error) if $commit_error;  | 
              |
| 64 | 
                  - }  | 
              |
| 65 | 
                  -}  | 
              |
| 66 | 
                  -  | 
              |
| 67 | 
                  -1;  | 
              |
| 68 | 
                  -  | 
              |
| 69 | 
                  -=head1 NAME  | 
              |
| 70 | 
                  -  | 
              |
| 71 | 
                  -DBIx::Custom::Transaction - Transaction  | 
              |
| 72 | 
                  -  | 
              |
| 73 | 
                  -=head1 SYNOPSYS  | 
              |
| 74 | 
                  -  | 
              |
| 75 | 
                  - use DBIx::Custom::Transaction  | 
              |
| 76 | 
                  - my $txn = DBIx::Custom::Transaction->new(dbi => DBIx::Custom->new);  | 
              |
| 77 | 
                  -    $txn->run(sub { ... });
                 | 
              |
| 78 | 
                  -  | 
              |
| 79 | 
                  -=head1 ATTRIBUTES  | 
              |
| 80 | 
                  -  | 
              |
| 81 | 
                  -=head2 dbi  | 
              |
| 82 | 
                  -  | 
              |
| 83 | 
                  - $self = $txn->dbi($dbi);  | 
              |
| 84 | 
                  - $dbi = $txn->dbi;  | 
              |
| 85 | 
                  -  | 
              |
| 86 | 
                  -=head1 METHODS  | 
              |
| 87 | 
                  -  | 
              |
| 88 | 
                  -=head2 run  | 
              |
| 89 | 
                  -  | 
              |
| 90 | 
                  - $txn->run(  | 
              |
| 91 | 
                  -        sub {
                 | 
              |
| 92 | 
                  - # Transaction  | 
              |
| 93 | 
                  - }  | 
              |
| 94 | 
                  - );  | 
              |
| 95 | 
                  -  | 
              |
| 96 | 
                  -=cut  | 
              
| ... | ... | 
                  @@ -397,7 +397,7 @@ is_deeply($rows, [{key1 => 4, key2 => 4, key3 => 4, key4 => 4, key5 => 5},
                 | 
              
| 397 | 397 | 
                  test 'transaction';  | 
              
| 398 | 398 | 
                   $dbi->do($DROP_TABLE->{0});
                 | 
              
| 399 | 399 | 
                   $dbi->do($CREATE_TABLE->{0});
                 | 
              
| 400 | 
                  -$dbi->transaction->run(sub {
                 | 
              |
| 400 | 
                  +$dbi->run_transaction(sub {
                 | 
              |
| 401 | 401 | 
                       $insert_tmpl = 'insert into table1 {insert key1 key2}';
                 | 
              
| 402 | 402 | 
                       $dbi->query($insert_tmpl, {key1 => 1, key2 => 2});
                 | 
              
| 403 | 403 | 
                       $dbi->query($insert_tmpl, {key1 => 3, key2 => 4});
                 | 
              
| ... | ... | 
                  @@ -410,7 +410,7 @@ $dbi->do($DROP_TABLE->{0});
                 | 
              
| 410 | 410 | 
                   $dbi->do($CREATE_TABLE->{0});
                 | 
              
| 411 | 411 | 
                   $dbi->dbh->{RaiseError} = 0;
                 | 
              
| 412 | 412 | 
                   eval{
                 | 
              
| 413 | 
                  -    $dbi->transaction->run(sub {
                 | 
              |
| 413 | 
                  +    $dbi->run_transaction(sub {
                 | 
              |
| 414 | 414 | 
                           $insert_tmpl = 'insert into table1 {insert key1 key2}';
                 | 
              
| 415 | 415 | 
                           $dbi->query($insert_tmpl, {key1 => 1, key2 => 2});
                 | 
              
| 416 | 416 | 
                  die "Fatal Error";  | 
              
| ... | ... | 
                  @@ -427,7 +427,7 @@ is_deeply($rows, [], "$test : rollback");  | 
              
| 427 | 427 | 
                   | 
              
| 428 | 428 | 
                  test 'Error case';  | 
              
| 429 | 429 | 
                  $dbi = DBIx::Custom->new;  | 
              
| 430 | 
                  -eval{$dbi->transaction->run};
                 | 
              |
| 430 | 
                  +eval{$dbi->run_transaction};
                 | 
              |
| 431 | 431 | 
                  like($@, qr/Not yet connect to database/, "$test : Yet Connected");  | 
              
| 432 | 432 | 
                   | 
              
| 433 | 433 | 
                  $dbi = DBIx::Custom->new(data_source => 'dbi:SQLit');  | 
              
| ... | ... | 
                  @@ -437,7 +437,7 @@ ok($@, "$test : connect error");  | 
              
| 437 | 437 | 
                   $dbi = DBIx::Custom->new($NEW_ARGS->{0});
                 | 
              
| 438 | 438 | 
                  $dbi->connect;  | 
              
| 439 | 439 | 
                   $dbi->dbh->{AutoCommit} = 0;
                 | 
              
| 440 | 
                  -eval{$dbi->transaction->run};
                 | 
              |
| 440 | 
                  +eval{$dbi->run_transaction};
                 | 
              |
| 441 | 441 | 
                  like($@, qr/AutoCommit must be true before transaction start/,  | 
              
| 442 | 442 | 
                  "$test : transaction auto commit is false");  | 
              
| 443 | 443 | 
                   | 
              
| ... | ... | 
                  @@ -1,69 +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 | 
                  -  | 
              |
| 56 | 
                  -$ret_val = $dbi->utf8_filter_on;  | 
              |
| 57 | 
                  -is($dbi->bind_filter, $dbi->filters->{encode_utf8}, 'default bind filter');
                 | 
              |
| 58 | 
                  -is($dbi->fetch_filter, $dbi->filters->{decode_utf8}, 'default fetch filter');
                 | 
              |
| 59 | 
                  -is(ref $ret_val, 'DBIx::Custom::Basic', "$test : retern value");  | 
              |
| 60 | 
                  -  | 
              |
| 61 | 
                  -$decoded_str = 'あ';  | 
              |
| 62 | 
                  -$encoded_str = $dbi->bind_filter->($decoded_str);  | 
              |
| 63 | 
                  -is($encoded_str, encode('UTF-8', $decoded_str), "$test : encode utf8");
                 | 
              |
| 64 | 
                  -is($decoded_str, $dbi->fetch_filter->($encoded_str), "$test : fetch_filter");  | 
              |
| 65 | 
                  -  | 
              |
| 66 | 
                  -$decoded_str = 'a';  | 
              |
| 67 | 
                  -$encoded_str = $dbi->bind_filter->($decoded_str);  | 
              |
| 68 | 
                  -is($encoded_str, encode('UTF-8', $decoded_str), "$test : upgrade and encode utf8");
                 | 
              |
| 69 | 
                  -is($decoded_str, $dbi->fetch_filter->($encoded_str), "$test : fetch_filter");  | 
              
| ... | ... | 
                  @@ -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 | 
                  -  | 
              
| ... | ... | 
                  @@ -1,36 +0,0 @@  | 
              
| 1 | 
                  -use Test::More;  | 
              |
| 2 | 
                  -use strict;  | 
              |
| 3 | 
                  -use warnings;  | 
              |
| 4 | 
                  -  | 
              |
| 5 | 
                  -# user password database  | 
              |
| 6 | 
                  -our ($USER, $PASSWORD, $DATABASE) = connect_info();  | 
              |
| 7 | 
                  -  | 
              |
| 8 | 
                  -plan skip_all => 'private MySQL test' unless $USER;  | 
              |
| 9 | 
                  -  | 
              |
| 10 | 
                  -plan 'no_plan';  | 
              |
| 11 | 
                  -  | 
              |
| 12 | 
                  -use DBIx::Custom;  | 
              |
| 13 | 
                  -use Scalar::Util 'blessed';  | 
              |
| 14 | 
                  -{
                 | 
              |
| 15 | 
                  - my $dbi = DBIx::Custom->new(  | 
              |
| 16 | 
                  - user => $USER,  | 
              |
| 17 | 
                  - password => $PASSWORD,  | 
              |
| 18 | 
                  - data_source => "dbi:mysql:dbname=$DATABASE"  | 
              |
| 19 | 
                  - );  | 
              |
| 20 | 
                  - $dbi->connect;  | 
              |
| 21 | 
                  -  | 
              |
| 22 | 
                  - ok(blessed $dbi->dbh);  | 
              |
| 23 | 
                  - can_ok($dbi->dbh, qw/prepare/);  | 
              |
| 24 | 
                  -}  | 
              |
| 25 | 
                  -  | 
              |
| 26 | 
                  -sub connect_info {
                 | 
              |
| 27 | 
                  - my $file = 'password.tmp';  | 
              |
| 28 | 
                  - open my $fh, '<', $file  | 
              |
| 29 | 
                  - or return;  | 
              |
| 30 | 
                  -  | 
              |
| 31 | 
                  - my ($user, $password, $database) = split(/\s/, (<$fh>)[0]);  | 
              |
| 32 | 
                  -  | 
              |
| 33 | 
                  - close $fh;  | 
              |
| 34 | 
                  -  | 
              |
| 35 | 
                  - return ($user, $password, $database);  | 
              |
| 36 | 
                  -}  | 
              
| ... | ... | 
                  @@ -1,223 +0,0 @@  | 
              
| 1 | 
                  -use Test::More 'no_plan';  | 
              |
| 2 | 
                  -use strict;  | 
              |
| 3 | 
                  -use warnings;  | 
              |
| 4 | 
                  -  | 
              |
| 5 | 
                  -use DBIx::Custom;  | 
              |
| 6 | 
                  -use DBIx::Custom::SQL::Template;  | 
              |
| 7 | 
                  -  | 
              |
| 8 | 
                  -# Function for test name  | 
              |
| 9 | 
                  -my $test;  | 
              |
| 10 | 
                  -sub test {
                 | 
              |
| 11 | 
                  - $test = shift;  | 
              |
| 12 | 
                  -}  | 
              |
| 13 | 
                  -  | 
              |
| 14 | 
                  -# Variables for test  | 
              |
| 15 | 
                  -our $SQL_TMPL = {
                 | 
              |
| 16 | 
                  - 0 => DBIx::Custom::SQL::Template->new->tag_start(0),  | 
              |
| 17 | 
                  - 1 => DBIx::Custom::SQL::Template->new->tag_start(1),  | 
              |
| 18 | 
                  - 2 => DBIx::Custom::SQL::Template->new->tag_start(2)  | 
              |
| 19 | 
                  -};  | 
              |
| 20 | 
                  -my $dbi;  | 
              |
| 21 | 
                  -  | 
              |
| 22 | 
                  -  | 
              |
| 23 | 
                  -test 'Constructor';  | 
              |
| 24 | 
                  -$dbi = DBIx::Custom->new(  | 
              |
| 25 | 
                  - user => 'a',  | 
              |
| 26 | 
                  - database => 'a',  | 
              |
| 27 | 
                  - password => 'b',  | 
              |
| 28 | 
                  - data_source => 'c',  | 
              |
| 29 | 
                  -    options => {d => 1, e => 2},
                 | 
              |
| 30 | 
                  -    filters => {
                 | 
              |
| 31 | 
                  - f => 3,  | 
              |
| 32 | 
                  - },  | 
              |
| 33 | 
                  - bind_filter => 'f',  | 
              |
| 34 | 
                  - fetch_filter => 'g',  | 
              |
| 35 | 
                  - result_class => 'g',  | 
              |
| 36 | 
                  -    sql_tmpl => $SQL_TMPL->{0},
                 | 
              |
| 37 | 
                  -);  | 
              |
| 38 | 
                  -is_deeply($dbi,{user => 'a', database => 'a', password => 'b', data_source => 'c', 
                 | 
              |
| 39 | 
                  -                options => {d => 1, e => 2}, filters => {f => 3}, bind_filter => 'f',
                 | 
              |
| 40 | 
                  - fetch_filter => 'g', result_class => 'g',  | 
              |
| 41 | 
                  -                sql_tmpl => $SQL_TMPL->{0}}, $test);
                 | 
              |
| 42 | 
                  -isa_ok($dbi, 'DBIx::Custom');  | 
              |
| 43 | 
                  -  | 
              |
| 44 | 
                  -  | 
              |
| 45 | 
                  -test 'Sub class constructor';  | 
              |
| 46 | 
                  -{
                 | 
              |
| 47 | 
                  - package DBIx::Custom::T1;  | 
              |
| 48 | 
                  - use base 'DBIx::Custom';  | 
              |
| 49 | 
                  -  | 
              |
| 50 | 
                  - __PACKAGE__  | 
              |
| 51 | 
                  -      ->user('a')
                 | 
              |
| 52 | 
                  -      ->database('a')
                 | 
              |
| 53 | 
                  -      ->password('b')
                 | 
              |
| 54 | 
                  -      ->data_source('c')
                 | 
              |
| 55 | 
                  -      ->options({d => 1, e => 2})
                 | 
              |
| 56 | 
                  -      ->filters({f => 3})
                 | 
              |
| 57 | 
                  -      ->formats({f => 3})
                 | 
              |
| 58 | 
                  -      ->bind_filter('f')
                 | 
              |
| 59 | 
                  -      ->fetch_filter('g')
                 | 
              |
| 60 | 
                  -      ->result_class('DBIx::Custom::Result')
                 | 
              |
| 61 | 
                  -      ->sql_tmpl($SQL_TMPL->{0})
                 | 
              |
| 62 | 
                  - ;  | 
              |
| 63 | 
                  -}  | 
              |
| 64 | 
                  -$dbi = DBIx::Custom::T1->new(  | 
              |
| 65 | 
                  - user => 'ao',  | 
              |
| 66 | 
                  - database => 'ao',  | 
              |
| 67 | 
                  - password => 'bo',  | 
              |
| 68 | 
                  - data_source => 'co',  | 
              |
| 69 | 
                  -    options => {do => 10, eo => 20},
                 | 
              |
| 70 | 
                  -    filters => {
                 | 
              |
| 71 | 
                  - fo => 30,  | 
              |
| 72 | 
                  - },  | 
              |
| 73 | 
                  -    formats => {
                 | 
              |
| 74 | 
                  - fo => 30,  | 
              |
| 75 | 
                  - },  | 
              |
| 76 | 
                  - bind_filter => 'fo',  | 
              |
| 77 | 
                  - fetch_filter => 'go',  | 
              |
| 78 | 
                  - result_class => 'ho',  | 
              |
| 79 | 
                  -    sql_tmpl => $SQL_TMPL->{0},
                 | 
              |
| 80 | 
                  -);  | 
              |
| 81 | 
                  -is($dbi->user, 'ao', "$test : user");  | 
              |
| 82 | 
                  -is($dbi->database, 'ao', "$test : database");  | 
              |
| 83 | 
                  -is($dbi->password, 'bo', "$test : passowr");  | 
              |
| 84 | 
                  -is($dbi->data_source, 'co', "$test : data_source");  | 
              |
| 85 | 
                  -is_deeply($dbi->options, {do => 10, eo => 20}, "$test : options");
                 | 
              |
| 86 | 
                  -is_deeply(scalar $dbi->filters, {fo => 30}, "$test : filters");
                 | 
              |
| 87 | 
                  -is_deeply(scalar $dbi->formats, {fo => 30}, "$test : formats");
                 | 
              |
| 88 | 
                  -is($dbi->bind_filter, 'fo', "$test : bind_filter");  | 
              |
| 89 | 
                  -is($dbi->fetch_filter, 'go', "$test : fetch_filter");  | 
              |
| 90 | 
                  -is($dbi->result_class, 'ho', "$test : result_class");  | 
              |
| 91 | 
                  -is($dbi->sql_tmpl->tag_start, 0, "$test : sql_tmpl");  | 
              |
| 92 | 
                  -isa_ok($dbi, 'DBIx::Custom::T1');  | 
              |
| 93 | 
                  -  | 
              |
| 94 | 
                  -test 'Sub class constructor default';  | 
              |
| 95 | 
                  -$dbi = DBIx::Custom::T1->new;  | 
              |
| 96 | 
                  -is($dbi->user, 'a', "$test : user");  | 
              |
| 97 | 
                  -is($dbi->database, 'a', "$test : database");  | 
              |
| 98 | 
                  -is($dbi->password, 'b', "$test : password");  | 
              |
| 99 | 
                  -is($dbi->data_source, 'c', "$test : data_source");  | 
              |
| 100 | 
                  -is_deeply($dbi->options, {d => 1, e => 2}, "$test : options");
                 | 
              |
| 101 | 
                  -is_deeply($dbi->filters, {f => 3}, "$test : filters");
                 | 
              |
| 102 | 
                  -is_deeply($dbi->formats, {f => 3}, "$test : formats");
                 | 
              |
| 103 | 
                  -is($dbi->bind_filter, 'f', "$test : bind_filter");  | 
              |
| 104 | 
                  -is($dbi->fetch_filter, 'g', "$test : fetch_filter");  | 
              |
| 105 | 
                  -is($dbi->result_class, 'DBIx::Custom::Result', "$test : result_class");  | 
              |
| 106 | 
                  -is($dbi->sql_tmpl->tag_start, 0, "$test : sql_tmpl");  | 
              |
| 107 | 
                  -isa_ok($dbi, 'DBIx::Custom::T1');  | 
              |
| 108 | 
                  -  | 
              |
| 109 | 
                  -  | 
              |
| 110 | 
                  -test 'Sub sub class constructor default';  | 
              |
| 111 | 
                  -{
                 | 
              |
| 112 | 
                  - package DBIx::Custom::T1_2;  | 
              |
| 113 | 
                  - use base 'DBIx::Custom::T1';  | 
              |
| 114 | 
                  -}  | 
              |
| 115 | 
                  -$dbi = DBIx::Custom::T1_2->new;  | 
              |
| 116 | 
                  -is($dbi->user, 'a', "$test : user");  | 
              |
| 117 | 
                  -is($dbi->database, 'a', "$test : database");  | 
              |
| 118 | 
                  -is($dbi->password, 'b', "$test : passowrd");  | 
              |
| 119 | 
                  -is($dbi->data_source, 'c', "$test : data_source");  | 
              |
| 120 | 
                  -is_deeply($dbi->options, {d => 1, e => 2}, "$test : options");
                 | 
              |
| 121 | 
                  -is_deeply(scalar $dbi->filters, {f => 3}, "$test : filters");
                 | 
              |
| 122 | 
                  -is_deeply(scalar $dbi->formats, {f => 3}, "$test : formats");
                 | 
              |
| 123 | 
                  -is($dbi->bind_filter, 'f', "$test : bind_filter");  | 
              |
| 124 | 
                  -is($dbi->fetch_filter, 'g', "$test : fetch_filter");  | 
              |
| 125 | 
                  -is($dbi->result_class, 'DBIx::Custom::Result', "$test : result_class");  | 
              |
| 126 | 
                  -is($dbi->sql_tmpl->tag_start, 0, "$test sql_tmpl");  | 
              |
| 127 | 
                  -isa_ok($dbi, 'DBIx::Custom::T1_2');  | 
              |
| 128 | 
                  -  | 
              |
| 129 | 
                  -  | 
              |
| 130 | 
                  -test 'Customized sub class constructor default';  | 
              |
| 131 | 
                  -{
                 | 
              |
| 132 | 
                  - package DBIx::Custom::T1_3;  | 
              |
| 133 | 
                  - use base 'DBIx::Custom::T1';  | 
              |
| 134 | 
                  -  | 
              |
| 135 | 
                  - __PACKAGE__  | 
              |
| 136 | 
                  -      ->user('ao')
                 | 
              |
| 137 | 
                  -      ->database('ao')
                 | 
              |
| 138 | 
                  -      ->password('bo')
                 | 
              |
| 139 | 
                  -      ->data_source('co')
                 | 
              |
| 140 | 
                  -      ->options({do => 10, eo => 20})
                 | 
              |
| 141 | 
                  -      ->filters({fo => 30})
                 | 
              |
| 142 | 
                  -      ->formats({fo => 30})
                 | 
              |
| 143 | 
                  -      ->bind_filter('fo')
                 | 
              |
| 144 | 
                  -      ->fetch_filter('go')
                 | 
              |
| 145 | 
                  -      ->result_class('ho')
                 | 
              |
| 146 | 
                  -      ->sql_tmpl($SQL_TMPL->{1})
                 | 
              |
| 147 | 
                  - ;  | 
              |
| 148 | 
                  -}  | 
              |
| 149 | 
                  -$dbi = DBIx::Custom::T1_3->new;  | 
              |
| 150 | 
                  -is($dbi->user, 'ao', "$test : user");  | 
              |
| 151 | 
                  -is($dbi->database, 'ao', "$test : database");  | 
              |
| 152 | 
                  -is($dbi->password, 'bo', "$test : password");  | 
              |
| 153 | 
                  -is($dbi->data_source, 'co', "$test : data_source");  | 
              |
| 154 | 
                  -is_deeply($dbi->options, {do => 10, eo => 20}, "$test : options");
                 | 
              |
| 155 | 
                  -is_deeply(scalar $dbi->filters, {fo => 30}, "$test : filters");
                 | 
              |
| 156 | 
                  -is_deeply(scalar $dbi->formats, {fo => 30}, "$test : formats");
                 | 
              |
| 157 | 
                  -is($dbi->bind_filter, 'fo', "$test : bind_filter");  | 
              |
| 158 | 
                  -is($dbi->fetch_filter, 'go', "$test : fetch_filter");  | 
              |
| 159 | 
                  -is($dbi->result_class, 'ho', "$test : result_class");  | 
              |
| 160 | 
                  -is($dbi->sql_tmpl->tag_start, 1, "$test : sql_tmpl");  | 
              |
| 161 | 
                  -isa_ok($dbi, 'DBIx::Custom::T1_3');  | 
              |
| 162 | 
                  -  | 
              |
| 163 | 
                  -  | 
              |
| 164 | 
                  -test 'Customized sub class constructor';  | 
              |
| 165 | 
                  -$dbi = DBIx::Custom::T1_3->new(  | 
              |
| 166 | 
                  - user => 'a',  | 
              |
| 167 | 
                  - database => 'a',  | 
              |
| 168 | 
                  - password => 'b',  | 
              |
| 169 | 
                  - data_source => 'c',  | 
              |
| 170 | 
                  -    options => {d => 1, e => 2},
                 | 
              |
| 171 | 
                  -    filters => {
                 | 
              |
| 172 | 
                  - f => 3,  | 
              |
| 173 | 
                  - },  | 
              |
| 174 | 
                  -    formats => {
                 | 
              |
| 175 | 
                  - f => 3,  | 
              |
| 176 | 
                  - },  | 
              |
| 177 | 
                  - bind_filter => 'f',  | 
              |
| 178 | 
                  - fetch_filter => 'g',  | 
              |
| 179 | 
                  - result_class => 'h',  | 
              |
| 180 | 
                  -    sql_tmpl => $SQL_TMPL->{2},
                 | 
              |
| 181 | 
                  -);  | 
              |
| 182 | 
                  -is($dbi->user, 'a', "$test : user");  | 
              |
| 183 | 
                  -is($dbi->database, 'a', "$test : database");  | 
              |
| 184 | 
                  -is($dbi->password, 'b', "$test : password");  | 
              |
| 185 | 
                  -is($dbi->data_source, 'c', "$test : data_source");  | 
              |
| 186 | 
                  -is_deeply($dbi->options, {d => 1, e => 2}, "$test : options");
                 | 
              |
| 187 | 
                  -is_deeply($dbi->filters, {f => 3}, "$test : filters");
                 | 
              |
| 188 | 
                  -is_deeply($dbi->formats, {f => 3}, "$test : formats");
                 | 
              |
| 189 | 
                  -is($dbi->bind_filter, 'f', "$test : bind_filter");  | 
              |
| 190 | 
                  -is($dbi->fetch_filter, 'g', "$test : fetch_filter");  | 
              |
| 191 | 
                  -is($dbi->result_class, 'h', "$test : result_class");  | 
              |
| 192 | 
                  -is($dbi->sql_tmpl->tag_start, 2, "$test : sql_tmpl");  | 
              |
| 193 | 
                  -isa_ok($dbi, 'DBIx::Custom');  | 
              |
| 194 | 
                  -  | 
              |
| 195 | 
                  -  | 
              |
| 196 | 
                  -test 'add_filters';  | 
              |
| 197 | 
                  -$dbi = DBIx::Custom->new;  | 
              |
| 198 | 
                  -$dbi->add_filter(a => sub {1});
                 | 
              |
| 199 | 
                  -is($dbi->filters->{a}->(), 1, $test);
                 | 
              |
| 200 | 
                  -  | 
              |
| 201 | 
                  -test 'add_formats';  | 
              |
| 202 | 
                  -$dbi = DBIx::Custom->new;  | 
              |
| 203 | 
                  -$dbi->add_format(a => sub {1});
                 | 
              |
| 204 | 
                  -is($dbi->formats->{a}->(), 1, $test);
                 | 
              |
| 205 | 
                  -  | 
              |
| 206 | 
                  -test 'filter_off';  | 
              |
| 207 | 
                  -$dbi = DBIx::Custom->new;  | 
              |
| 208 | 
                  -$dbi->bind_filter('a');
                 | 
              |
| 209 | 
                  -$dbi->fetch_filter('b');
                 | 
              |
| 210 | 
                  -$dbi->filter_off;  | 
              |
| 211 | 
                  -ok(!$dbi->bind_filter, "$test : bind_filter off");  | 
              |
| 212 | 
                  -ok(!$dbi->fetch_filter, "$test : fetch_filter off");  | 
              |
| 213 | 
                  -  | 
              |
| 214 | 
                  -test 'Accessor';  | 
              |
| 215 | 
                  -$dbi = DBIx::Custom->new;  | 
              |
| 216 | 
                  -$dbi->options({opt1 => 1, opt2 => 2});
                 | 
              |
| 217 | 
                  -is_deeply(scalar $dbi->options, {opt1 => 1, opt2 => 2}, "$test : options");
                 | 
              |
| 218 | 
                  -  | 
              |
| 219 | 
                  -$dbi->no_bind_filters(['a', 'b']);  | 
              |
| 220 | 
                  -is_deeply(scalar $dbi->no_bind_filters, ['a', 'b'], "$test: no_bind_filters");  | 
              |
| 221 | 
                  -  | 
              |
| 222 | 
                  -$dbi->no_fetch_filters(['a', 'b']);  | 
              |
| 223 | 
                  -is_deeply(scalar $dbi->no_fetch_filters, ['a', 'b'], "$test: no_fetch_filters");  | 
              
| ... | ... | 
                  @@ -1,47 +0,0 @@  | 
              
| 1 | 
                  -use Test::More;  | 
              |
| 2 | 
                  -use strict;  | 
              |
| 3 | 
                  -use warnings;  | 
              |
| 4 | 
                  -  | 
              |
| 5 | 
                  -# user password database  | 
              |
| 6 | 
                  -our ($USER, $PASSWORD, $DATABASE) = connect_info();  | 
              |
| 7 | 
                  -  | 
              |
| 8 | 
                  -plan skip_all => 'private MySQL test' unless $USER;  | 
              |
| 9 | 
                  -  | 
              |
| 10 | 
                  -plan 'no_plan';  | 
              |
| 11 | 
                  -  | 
              |
| 12 | 
                  -# Function for test name  | 
              |
| 13 | 
                  -my $test;  | 
              |
| 14 | 
                  -sub test {
                 | 
              |
| 15 | 
                  - $test = shift;  | 
              |
| 16 | 
                  -}  | 
              |
| 17 | 
                  -  | 
              |
| 18 | 
                  -  | 
              |
| 19 | 
                  -# Functions for tests  | 
              |
| 20 | 
                  -sub connect_info {
                 | 
              |
| 21 | 
                  - my $file = 'password.tmp';  | 
              |
| 22 | 
                  - open my $fh, '<', $file  | 
              |
| 23 | 
                  - or return;  | 
              |
| 24 | 
                  -  | 
              |
| 25 | 
                  - my ($user, $password, $database) = split(/\s/, (<$fh>)[0]);  | 
              |
| 26 | 
                  -  | 
              |
| 27 | 
                  - close $fh;  | 
              |
| 28 | 
                  -  | 
              |
| 29 | 
                  - return ($user, $password, $database);  | 
              |
| 30 | 
                  -}  | 
              |
| 31 | 
                  -  | 
              |
| 32 | 
                  -  | 
              |
| 33 | 
                  -# Constat variables for tests  | 
              |
| 34 | 
                  -my $CLASS = 'DBIx::Custom::MySQL';  | 
              |
| 35 | 
                  -  | 
              |
| 36 | 
                  -# Varialbes for tests  | 
              |
| 37 | 
                  -my $dbi;  | 
              |
| 38 | 
                  -  | 
              |
| 39 | 
                  -use DBIx::Custom::MySQL;  | 
              |
| 40 | 
                  -  | 
              |
| 41 | 
                  -test 'connect';  | 
              |
| 42 | 
                  -$dbi = $CLASS->new(user => $USER, password => $PASSWORD,  | 
              |
| 43 | 
                  - database => $DATABASE);  | 
              |
| 44 | 
                  -$dbi->connect;  | 
              |
| 45 | 
                  -is(ref $dbi->dbh, 'DBI::db', $test);  | 
              |
| 46 | 
                  -  | 
              |
| 47 | 
                  -  | 
              
| ... | ... | 
                  @@ -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 | 
                  -  | 
              
| ... | ... | 
                  @@ -1,37 +0,0 @@  | 
              
| 1 | 
                  -use Test::More 'no_plan';  | 
              |
| 2 | 
                  -  | 
              |
| 3 | 
                  -use strict;  | 
              |
| 4 | 
                  -use warnings;  | 
              |
| 5 | 
                  -use DBIx::Custom::Query;  | 
              |
| 6 | 
                  -  | 
              |
| 7 | 
                  -# Function for test name  | 
              |
| 8 | 
                  -my $test;  | 
              |
| 9 | 
                  -sub test{
                 | 
              |
| 10 | 
                  - $test = shift;  | 
              |
| 11 | 
                  -}  | 
              |
| 12 | 
                  -  | 
              |
| 13 | 
                  -# Variables for test  | 
              |
| 14 | 
                  -my $query;  | 
              |
| 15 | 
                  -  | 
              |
| 16 | 
                  -test 'Accessors';  | 
              |
| 17 | 
                  -$query = DBIx::Custom::Query->new(  | 
              |
| 18 | 
                  - sql => 'a',  | 
              |
| 19 | 
                  - key_infos => 'b',  | 
              |
| 20 | 
                  - bind_filter => 'c',  | 
              |
| 21 | 
                  - no_bind_filters => [qw/d e/],  | 
              |
| 22 | 
                  - sth => 'e',  | 
              |
| 23 | 
                  - fetch_filter => 'f',  | 
              |
| 24 | 
                  - no_fetch_filters => [qw/g h/],  | 
              |
| 25 | 
                  -);  | 
              |
| 26 | 
                  -  | 
              |
| 27 | 
                  -is($query->sql, 'a', "$test : sql");  | 
              |
| 28 | 
                  -is($query->key_infos, 'b', "$test : key_infos ");  | 
              |
| 29 | 
                  -is($query->bind_filter, 'c', "$test : bind_filter");  | 
              |
| 30 | 
                  -is_deeply($query->no_bind_filters, [qw/d e/], "$test : no_bind_filters");  | 
              |
| 31 | 
                  -is_deeply($query->_no_bind_filters, {d => 1, e => 1}, "$test : _no_bind_filters");
                 | 
              |
| 32 | 
                  -is_deeply($query->no_fetch_filters, [qw/g h/], "$test : no_fetch_filters");  | 
              |
| 33 | 
                  -is($query->sth, 'e', "$test : sth");  | 
              |
| 34 | 
                  -  | 
              |
| 35 | 
                  -$query->no_bind_filters(undef);  | 
              |
| 36 | 
                  -is_deeply(scalar $query->_no_bind_filters, {}, "$test _no_bind_filters undef value");
                 | 
              |
| 37 | 
                  -  | 
              
| ... | ... | 
                  @@ -1,259 +0,0 @@  | 
              
| 1 | 
                  -use Test::More;  | 
              |
| 2 | 
                  -use strict;  | 
              |
| 3 | 
                  -use warnings;  | 
              |
| 4 | 
                  -use DBI;  | 
              |
| 5 | 
                  -  | 
              |
| 6 | 
                  -BEGIN {
                 | 
              |
| 7 | 
                  -    eval { require DBD::SQLite; 1 }
                 | 
              |
| 8 | 
                  - or plan skip_all => 'DBD::SQLite required';  | 
              |
| 9 | 
                  -    eval { DBD::SQLite->VERSION >= 1 }
                 | 
              |
| 10 | 
                  - or plan skip_all => 'DBD::SQLite >= 1.00 required';  | 
              |
| 11 | 
                  -  | 
              |
| 12 | 
                  - plan 'no_plan';  | 
              |
| 13 | 
                  -    use_ok('DBIx::Custom::Result');
                 | 
              |
| 14 | 
                  -}  | 
              |
| 15 | 
                  -  | 
              |
| 16 | 
                  -my $test;  | 
              |
| 17 | 
                  -sub test {
                 | 
              |
| 18 | 
                  - $test = shift;  | 
              |
| 19 | 
                  -}  | 
              |
| 20 | 
                  -  | 
              |
| 21 | 
                  -sub query {
                 | 
              |
| 22 | 
                  - my ($dbh, $sql) = @_;  | 
              |
| 23 | 
                  - my $sth = $dbh->prepare($sql);  | 
              |
| 24 | 
                  - $sth->execute;  | 
              |
| 25 | 
                  - return DBIx::Custom::Result->new(sth => $sth);  | 
              |
| 26 | 
                  -}  | 
              |
| 27 | 
                  -  | 
              |
| 28 | 
                  -my $dbh;  | 
              |
| 29 | 
                  -my $sql;  | 
              |
| 30 | 
                  -my $sth;  | 
              |
| 31 | 
                  -my @row;  | 
              |
| 32 | 
                  -my $row;  | 
              |
| 33 | 
                  -my @rows;  | 
              |
| 34 | 
                  -my $rows;  | 
              |
| 35 | 
                  -my $result;  | 
              |
| 36 | 
                  -my $fetch_filter;  | 
              |
| 37 | 
                  -my @error;  | 
              |
| 38 | 
                  -my $error;  | 
              |
| 39 | 
                  -  | 
              |
| 40 | 
                  -$dbh = DBI->connect('dbi:SQLite:dbname=:memory:', undef, undef, {PrintError => 0, RaiseError => 1});
                 | 
              |
| 41 | 
                  -$dbh->do("create table table1 (key1 char(255), key2 char(255));");
                 | 
              |
| 42 | 
                  -$dbh->do("insert into table1 (key1, key2) values ('1', '2');");
                 | 
              |
| 43 | 
                  -$dbh->do("insert into table1 (key1, key2) values ('3', '4');");
                 | 
              |
| 44 | 
                  -  | 
              |
| 45 | 
                  -$sql = "select key1, key2 from table1";  | 
              |
| 46 | 
                  -  | 
              |
| 47 | 
                  -test 'fetch scalar context';  | 
              |
| 48 | 
                  -$result = query($dbh, $sql);  | 
              |
| 49 | 
                  -@rows = ();  | 
              |
| 50 | 
                  -while (my $row = $result->fetch) {
                 | 
              |
| 51 | 
                  - push @rows, [@$row];  | 
              |
| 52 | 
                  -}  | 
              |
| 53 | 
                  -is_deeply(\@rows, [[1, 2], [3, 4]], $test);  | 
              |
| 54 | 
                  -  | 
              |
| 55 | 
                  -  | 
              |
| 56 | 
                  -test 'fetch list context';  | 
              |
| 57 | 
                  -$result = query($dbh, $sql);  | 
              |
| 58 | 
                  -@rows = ();  | 
              |
| 59 | 
                  -while (my @row = $result->fetch) {
                 | 
              |
| 60 | 
                  - push @rows, [@row];  | 
              |
| 61 | 
                  -}  | 
              |
| 62 | 
                  -is_deeply(\@rows, [[1, 2], [3, 4]], $test);  | 
              |
| 63 | 
                  -  | 
              |
| 64 | 
                  -test 'fetch_hash scalar context';  | 
              |
| 65 | 
                  -$result = query($dbh, $sql);  | 
              |
| 66 | 
                  -@rows = ();  | 
              |
| 67 | 
                  -while (my $row = $result->fetch_hash) {
                 | 
              |
| 68 | 
                  -    push @rows, {%$row};
                 | 
              |
| 69 | 
                  -}  | 
              |
| 70 | 
                  -is_deeply(\@rows, [{key1 => 1, key2 => 2}, {key1 => 3, key2 => 4}], $test);
                 | 
              |
| 71 | 
                  -  | 
              |
| 72 | 
                  -  | 
              |
| 73 | 
                  -test 'fetch hash list context';  | 
              |
| 74 | 
                  -$result = query($dbh, $sql);  | 
              |
| 75 | 
                  -@rows = ();  | 
              |
| 76 | 
                  -while (my %row = $result->fetch_hash) {
                 | 
              |
| 77 | 
                  -    push @rows, {%row};
                 | 
              |
| 78 | 
                  -}  | 
              |
| 79 | 
                  -is_deeply(\@rows, [{key1 => 1, key2 => 2}, {key1 => 3, key2 => 4}], $test);
                 | 
              |
| 80 | 
                  -  | 
              |
| 81 | 
                  -  | 
              |
| 82 | 
                  -test 'fetch_single';  | 
              |
| 83 | 
                  -$result = query($dbh, $sql);  | 
              |
| 84 | 
                  -$row = $result->fetch_single;  | 
              |
| 85 | 
                  -is_deeply($row, [1, 2], "$test : row");  | 
              |
| 86 | 
                  -$row = $result->fetch;  | 
              |
| 87 | 
                  -ok(!$row, "$test : finished");  | 
              |
| 88 | 
                  -  | 
              |
| 89 | 
                  -  | 
              |
| 90 | 
                  -test 'fetch_single list context';  | 
              |
| 91 | 
                  -$result = query($dbh, $sql);  | 
              |
| 92 | 
                  -@row = $result->fetch_single;  | 
              |
| 93 | 
                  -is_deeply([@row], [1, 2], "$test : row");  | 
              |
| 94 | 
                  -@row = $result->fetch;  | 
              |
| 95 | 
                  -ok(!@row, "$test : finished");  | 
              |
| 96 | 
                  -  | 
              |
| 97 | 
                  -  | 
              |
| 98 | 
                  -test 'fetch_hash_single';  | 
              |
| 99 | 
                  -$result = query($dbh, $sql);  | 
              |
| 100 | 
                  -$row = $result->fetch_hash_single;  | 
              |
| 101 | 
                  -is_deeply($row, {key1 => 1, key2 => 2}, "$test : row");
                 | 
              |
| 102 | 
                  -$row = $result->fetch_hash;  | 
              |
| 103 | 
                  -ok(!$row, "$test : finished");  | 
              |
| 104 | 
                  -  | 
              |
| 105 | 
                  -  | 
              |
| 106 | 
                  -test 'fetch_hash_single list context';  | 
              |
| 107 | 
                  -$result = query($dbh, $sql);  | 
              |
| 108 | 
                  -@row = $result->fetch_hash_single;  | 
              |
| 109 | 
                  -is_deeply({@row}, {key1 => 1, key2 => 2}, "$test : row");
                 | 
              |
| 110 | 
                  -@row = $result->fetch_hash;  | 
              |
| 111 | 
                  -ok(!@row, "$test : finished");  | 
              |
| 112 | 
                  -  | 
              |
| 113 | 
                  -  | 
              |
| 114 | 
                  -test 'fetch_rows';  | 
              |
| 115 | 
                  -$dbh->do("insert into table1 (key1, key2) values ('5', '6');");
                 | 
              |
| 116 | 
                  -$dbh->do("insert into table1 (key1, key2) values ('7', '8');");
                 | 
              |
| 117 | 
                  -$dbh->do("insert into table1 (key1, key2) values ('9', '10');");
                 | 
              |
| 118 | 
                  -$result = query($dbh, $sql);  | 
              |
| 119 | 
                  -$rows = $result->fetch_rows(2);  | 
              |
| 120 | 
                  -is_deeply($rows, [[1, 2],  | 
              |
| 121 | 
                  - [3, 4]], "$test : fetch_rows first");  | 
              |
| 122 | 
                  -$rows = $result->fetch_rows(2);  | 
              |
| 123 | 
                  -is_deeply($rows, [[5, 6],  | 
              |
| 124 | 
                  - [7, 8]], "$test : fetch_rows secound");  | 
              |
| 125 | 
                  -$rows = $result->fetch_rows(2);  | 
              |
| 126 | 
                  -is_deeply($rows, [[9, 10]], "$test : fetch_rows third");  | 
              |
| 127 | 
                  -$rows = $result->fetch_rows(2);  | 
              |
| 128 | 
                  -ok(!$rows);  | 
              |
| 129 | 
                  -  | 
              |
| 130 | 
                  -  | 
              |
| 131 | 
                  -test 'fetch_rows list context';  | 
              |
| 132 | 
                  -$result = query($dbh, $sql);  | 
              |
| 133 | 
                  -@rows = $result->fetch_rows(2);  | 
              |
| 134 | 
                  -is_deeply([@rows], [[1, 2],  | 
              |
| 135 | 
                  - [3, 4]], "$test : fetch_rows first");  | 
              |
| 136 | 
                  -@rows = $result->fetch_rows(2);  | 
              |
| 137 | 
                  -is_deeply([@rows], [[5, 6],  | 
              |
| 138 | 
                  - [7, 8]], "$test : fetch_rows secound");  | 
              |
| 139 | 
                  -@rows = $result->fetch_rows(2);  | 
              |
| 140 | 
                  -is_deeply([@rows], [[9, 10]], "$test : fetch_rows third");  | 
              |
| 141 | 
                  -@rows = $result->fetch_rows(2);  | 
              |
| 142 | 
                  -ok(!@rows);  | 
              |
| 143 | 
                  -  | 
              |
| 144 | 
                  -  | 
              |
| 145 | 
                  -test 'fetch_rows error';  | 
              |
| 146 | 
                  -$result = query($dbh, $sql);  | 
              |
| 147 | 
                  -eval {$result->fetch_rows};
                 | 
              |
| 148 | 
                  -like($@, qr/Row count must be specified/, "$test : Not specified row count");  | 
              |
| 149 | 
                  -  | 
              |
| 150 | 
                  -  | 
              |
| 151 | 
                  -test 'fetch_hash_rows';  | 
              |
| 152 | 
                  -$result = query($dbh, $sql);  | 
              |
| 153 | 
                  -$rows = $result->fetch_hash_rows(2);  | 
              |
| 154 | 
                  -is_deeply($rows, [{key1 => 1, key2 => 2},
                 | 
              |
| 155 | 
                  -                  {key1 => 3, key2 => 4}], "$test : fetch_rows first");
                 | 
              |
| 156 | 
                  -$rows = $result->fetch_hash_rows(2);  | 
              |
| 157 | 
                  -is_deeply($rows, [{key1 => 5, key2 => 6},
                 | 
              |
| 158 | 
                  -                  {key1 => 7, key2 => 8}], "$test : fetch_rows secound");
                 | 
              |
| 159 | 
                  -$rows = $result->fetch_hash_rows(2);  | 
              |
| 160 | 
                  -is_deeply($rows, [{key1 => 9, key2 => 10}], "$test : fetch_rows third");
                 | 
              |
| 161 | 
                  -$rows = $result->fetch_hash_rows(2);  | 
              |
| 162 | 
                  -ok(!$rows);  | 
              |
| 163 | 
                  -  | 
              |
| 164 | 
                  -  | 
              |
| 165 | 
                  -test 'fetch_rows list context';  | 
              |
| 166 | 
                  -$result = query($dbh, $sql);  | 
              |
| 167 | 
                  -@rows = $result->fetch_hash_rows(2);  | 
              |
| 168 | 
                  -is_deeply([@rows], [{key1 => 1, key2 => 2},
                 | 
              |
| 169 | 
                  -                    {key1 => 3, key2 => 4}], "$test : fetch_rows first");
                 | 
              |
| 170 | 
                  -@rows = $result->fetch_hash_rows(2);  | 
              |
| 171 | 
                  -is_deeply([@rows], [{key1 => 5, key2 => 6},
                 | 
              |
| 172 | 
                  -                    {key1 => 7, key2 => 8}], "$test : fetch_rows secound");
                 | 
              |
| 173 | 
                  -@rows = $result->fetch_hash_rows(2);  | 
              |
| 174 | 
                  -is_deeply([@rows], [{key1 => 9, key2 => 10}], "$test : fetch_rows third");
                 | 
              |
| 175 | 
                  -@rows = $result->fetch_hash_rows(2);  | 
              |
| 176 | 
                  -ok(!@rows);  | 
              |
| 177 | 
                  -$dbh->do("delete from table1 where key1 = 5 or key1 = 7 or key1 = 9");
                 | 
              |
| 178 | 
                  -  | 
              |
| 179 | 
                  -  | 
              |
| 180 | 
                  -test 'fetch_rows error';  | 
              |
| 181 | 
                  -$result = query($dbh, $sql);  | 
              |
| 182 | 
                  -eval {$result->fetch_hash_rows};
                 | 
              |
| 183 | 
                  -like($@, qr/Row count must be specified/, "$test : Not specified row count");  | 
              |
| 184 | 
                  -  | 
              |
| 185 | 
                  -  | 
              |
| 186 | 
                  -test 'fetch_all';  | 
              |
| 187 | 
                  -$result = query($dbh, $sql);  | 
              |
| 188 | 
                  -$rows = $result->fetch_all;  | 
              |
| 189 | 
                  -is_deeply($rows, [[1, 2], [3, 4]], $test);  | 
              |
| 190 | 
                  -  | 
              |
| 191 | 
                  -test 'fetch_all list context';  | 
              |
| 192 | 
                  -$result = query($dbh, $sql);  | 
              |
| 193 | 
                  -@rows = $result->fetch_all;  | 
              |
| 194 | 
                  -is_deeply(\@rows, [[1, 2], [3, 4]], $test);  | 
              |
| 195 | 
                  -  | 
              |
| 196 | 
                  -  | 
              |
| 197 | 
                  -test 'fetch_hash_all';  | 
              |
| 198 | 
                  -$result = query($dbh, $sql);  | 
              |
| 199 | 
                  -@rows = $result->fetch_hash_all;  | 
              |
| 200 | 
                  -is_deeply($rows, [[1, 2], [3, 4]], $test);  | 
              |
| 201 | 
                  -  | 
              |
| 202 | 
                  -  | 
              |
| 203 | 
                  -test 'fetch_hash_all list context';  | 
              |
| 204 | 
                  -$result = query($dbh, $sql);  | 
              |
| 205 | 
                  -@rows = $result->fetch_all;  | 
              |
| 206 | 
                  -is_deeply(\@rows, [[1, 2], [3, 4]], $test);  | 
              |
| 207 | 
                  -  | 
              |
| 208 | 
                  -  | 
              |
| 209 | 
                  -test 'fetch filter';  | 
              |
| 210 | 
                  -$fetch_filter = sub {
                 | 
              |
| 211 | 
                  - my ($value, $key, $dbi, $infos) = @_;  | 
              |
| 212 | 
                  -    my ($type, $sth, $i) = @{$infos}{qw/type sth index/};
                 | 
              |
| 213 | 
                  -  | 
              |
| 214 | 
                  -    if ($key eq 'key1' && $value == 1 && $type =~ /char/i && $i == 0 && $sth->{TYPE}->[$i] eq $type) {
                 | 
              |
| 215 | 
                  - return $value * 3;  | 
              |
| 216 | 
                  - }  | 
              |
| 217 | 
                  - return $value;  | 
              |
| 218 | 
                  -};  | 
              |
| 219 | 
                  -  | 
              |
| 220 | 
                  -$result = query($dbh, $sql);  | 
              |
| 221 | 
                  -$result->fetch_filter($fetch_filter);  | 
              |
| 222 | 
                  -$rows = $result->fetch_all;  | 
              |
| 223 | 
                  -is_deeply($rows, [[3, 2], [3, 4]], "$test array");  | 
              |
| 224 | 
                  -  | 
              |
| 225 | 
                  -$result = query($dbh, $sql);  | 
              |
| 226 | 
                  -$result->fetch_filter($fetch_filter);  | 
              |
| 227 | 
                  -$rows = $result->fetch_hash_all;  | 
              |
| 228 | 
                  -is_deeply($rows, [{key1 => 3, key2 => 2}, {key1 => 3, key2 => 4}], "$test hash");
                 | 
              |
| 229 | 
                  -  | 
              |
| 230 | 
                  -$result = query($dbh, $sql);  | 
              |
| 231 | 
                  -$result->no_fetch_filters(['key1']);  | 
              |
| 232 | 
                  -$rows = $result->fetch_all;  | 
              |
| 233 | 
                  -is_deeply($rows, [[1, 2], [3, 4]], "$test array no filter keys");  | 
              |
| 234 | 
                  -  | 
              |
| 235 | 
                  -$result = query($dbh, $sql);  | 
              |
| 236 | 
                  -$result->no_fetch_filters(['key1']);  | 
              |
| 237 | 
                  -$rows = $result->fetch_hash_all;  | 
              |
| 238 | 
                  -is_deeply($rows, [{key1 => 1, key2 => 2}, {key1 => 3, key2 => 4}], "$test hash no filter keys");
                 | 
              |
| 239 | 
                  -  | 
              |
| 240 | 
                  -  | 
              |
| 241 | 
                  -test 'finish';  | 
              |
| 242 | 
                  -$result = query($dbh, $sql);  | 
              |
| 243 | 
                  -$result->fetch;  | 
              |
| 244 | 
                  -$result->finish;  | 
              |
| 245 | 
                  -ok(!$result->fetch, $test);  | 
              |
| 246 | 
                  -  | 
              |
| 247 | 
                  -test 'error'; # Cannot real test  | 
              |
| 248 | 
                  -$result = query($dbh, $sql);  | 
              |
| 249 | 
                  -$sth = $result->sth;  | 
              |
| 250 | 
                  -  | 
              |
| 251 | 
                  -@error = $result->error;  | 
              |
| 252 | 
                  -is(scalar @error, 3, "$test list context count");  | 
              |
| 253 | 
                  -is($error[0], $sth->errstr, "$test list context errstr");  | 
              |
| 254 | 
                  -is($error[1], $sth->err, "$test list context err");  | 
              |
| 255 | 
                  -is($error[2], $sth->state, "$test list context state");  | 
              |
| 256 | 
                  -  | 
              |
| 257 | 
                  -$error = $result->error;  | 
              |
| 258 | 
                  -is($error, $sth->errstr, "$test scalar context");  | 
              |
| 259 | 
                  -  | 
              
| ... | ... | 
                  @@ -1,198 +0,0 @@  | 
              
| 1 | 
                  -use strict;  | 
              |
| 2 | 
                  -use warnings;  | 
              |
| 3 | 
                  -  | 
              |
| 4 | 
                  -use Test::More 'no_plan';  | 
              |
| 5 | 
                  -  | 
              |
| 6 | 
                  -use DBIx::Custom::SQL::Template;  | 
              |
| 7 | 
                  -  | 
              |
| 8 | 
                  -# Function for test name  | 
              |
| 9 | 
                  -my $test;  | 
              |
| 10 | 
                  -sub test{
                 | 
              |
| 11 | 
                  - $test = shift;  | 
              |
| 12 | 
                  -}  | 
              |
| 13 | 
                  -  | 
              |
| 14 | 
                  -# Variable for test  | 
              |
| 15 | 
                  -my $datas;  | 
              |
| 16 | 
                  -my $sql_tmpl;  | 
              |
| 17 | 
                  -my $query;  | 
              |
| 18 | 
                  -my $ret_val;  | 
              |
| 19 | 
                  -my $clone;  | 
              |
| 20 | 
                  -  | 
              |
| 21 | 
                  -test "Various template pattern";  | 
              |
| 22 | 
                  -$datas = [  | 
              |
| 23 | 
                  - # Basic tests  | 
              |
| 24 | 
                  -    {   name            => 'placeholder basic',
                 | 
              |
| 25 | 
                  -        tmpl            => "a {?  k1} b {=  k2} {<> k3} {>  k4} {<  k5} {>= k6} {<= k7} {like k8}", ,
                 | 
              |
| 26 | 
                  - sql_expected => "a ? b k2 = ? k3 <> ? k4 > ? k5 < ? k6 >= ? k7 <= ? k8 like ?;",  | 
              |
| 27 | 
                  - key_infos_expected => [  | 
              |
| 28 | 
                  -            {original_key => 'k1', table => '', column => 'k1', access_keys => [['k1']]},
                 | 
              |
| 29 | 
                  -            {original_key => 'k2', table => '', column => 'k2', access_keys => [['k2']]},
                 | 
              |
| 30 | 
                  -            {original_key => 'k3', table => '', column => 'k3', access_keys => [['k3']]},
                 | 
              |
| 31 | 
                  -            {original_key => 'k4', table => '', column => 'k4', access_keys => [['k4']]},
                 | 
              |
| 32 | 
                  -            {original_key => 'k5', table => '', column => 'k5', access_keys => [['k5']]},
                 | 
              |
| 33 | 
                  -            {original_key => 'k6', table => '', column => 'k6', access_keys => [['k6']]},
                 | 
              |
| 34 | 
                  -            {original_key => 'k7', table => '', column => 'k7', access_keys => [['k7']]},
                 | 
              |
| 35 | 
                  -            {original_key => 'k8', table => '', column => 'k8', access_keys => [['k8']]},
                 | 
              |
| 36 | 
                  - ],  | 
              |
| 37 | 
                  - },  | 
              |
| 38 | 
                  -    {
                 | 
              |
| 39 | 
                  - name => 'placeholder in',  | 
              |
| 40 | 
                  -        tmpl            => "{in k1 3};",
                 | 
              |
| 41 | 
                  - sql_expected => "k1 in (?, ?, ?);",  | 
              |
| 42 | 
                  - key_infos_expected => [  | 
              |
| 43 | 
                  -            {original_key => 'k1', table => '', column => 'k1', access_keys => [['k1', [0]]]},
                 | 
              |
| 44 | 
                  -            {original_key => 'k1', table => '', column => 'k1', access_keys => [['k1', [1]]]},
                 | 
              |
| 45 | 
                  -            {original_key => 'k1', table => '', column => 'k1', access_keys => [['k1', [2]]]},
                 | 
              |
| 46 | 
                  - ],  | 
              |
| 47 | 
                  - },  | 
              |
| 48 | 
                  -  | 
              |
| 49 | 
                  - # Table name  | 
              |
| 50 | 
                  -    {
                 | 
              |
| 51 | 
                  - name => 'placeholder with table name',  | 
              |
| 52 | 
                  -        tmpl            => "{= a.k1} {= a.k2}",
                 | 
              |
| 53 | 
                  - sql_expected => "a.k1 = ? a.k2 = ?;",  | 
              |
| 54 | 
                  - key_infos_expected => [  | 
              |
| 55 | 
                  -            {original_key => 'a.k1', table => 'a', column => 'k1', access_keys => [['a.k1'], ['a', 'k1']]},
                 | 
              |
| 56 | 
                  -            {original_key => 'a.k2', table => 'a', column => 'k2', access_keys => [['a.k2'], ['a', 'k2']]},
                 | 
              |
| 57 | 
                  - ],  | 
              |
| 58 | 
                  - },  | 
              |
| 59 | 
                  -    {   
                 | 
              |
| 60 | 
                  - name => 'placeholder in with table name',  | 
              |
| 61 | 
                  -        tmpl            => "{in a.k1 2} {in b.k2 2}",
                 | 
              |
| 62 | 
                  - sql_expected => "a.k1 in (?, ?) b.k2 in (?, ?);",  | 
              |
| 63 | 
                  - key_infos_expected => [  | 
              |
| 64 | 
                  -            {original_key => 'a.k1', table => 'a', column => 'k1', access_keys => [['a.k1', [0]], ['a', 'k1', [0]]]},
                 | 
              |
| 65 | 
                  -            {original_key => 'a.k1', table => 'a', column => 'k1', access_keys => [['a.k1', [1]], ['a', 'k1', [1]]]},
                 | 
              |
| 66 | 
                  -            {original_key => 'b.k2', table => 'b', column => 'k2', access_keys => [['b.k2', [0]], ['b', 'k2', [0]]]},
                 | 
              |
| 67 | 
                  -            {original_key => 'b.k2', table => 'b', column => 'k2', access_keys => [['b.k2', [1]], ['b', 'k2', [1]]]},
                 | 
              |
| 68 | 
                  - ],  | 
              |
| 69 | 
                  - },  | 
              |
| 70 | 
                  -    {
                 | 
              |
| 71 | 
                  - name => 'not contain tag',  | 
              |
| 72 | 
                  - tmpl => "aaa",  | 
              |
| 73 | 
                  - sql_expected => "aaa;",  | 
              |
| 74 | 
                  - key_infos_expected => [],  | 
              |
| 75 | 
                  - }  | 
              |
| 76 | 
                  -];  | 
              |
| 77 | 
                  -  | 
              |
| 78 | 
                  -for (my $i = 0; $i < @$datas; $i++) {
                 | 
              |
| 79 | 
                  - my $data = $datas->[$i];  | 
              |
| 80 | 
                  - my $sql_tmpl = DBIx::Custom::SQL::Template->new;  | 
              |
| 81 | 
                  -    my $query = $sql_tmpl->create_query($data->{tmpl});
                 | 
              |
| 82 | 
                  -    is($query->{sql}, $data->{sql_expected}, "$test : $data->{name} : sql");
                 | 
              |
| 83 | 
                  -    is_deeply($query->{key_infos}, $data->{key_infos_expected}, "$test : $data->{name} : key_infos");
                 | 
              |
| 84 | 
                  -}  | 
              |
| 85 | 
                  -  | 
              |
| 86 | 
                  -  | 
              |
| 87 | 
                  -test 'Original tag processor';  | 
              |
| 88 | 
                  -$sql_tmpl = DBIx::Custom::SQL::Template->new;  | 
              |
| 89 | 
                  -  | 
              |
| 90 | 
                  -$ret_val = $sql_tmpl->add_tag_processor(  | 
              |
| 91 | 
                  -    p => sub {
                 | 
              |
| 92 | 
                  - my ($tag_name, $args) = @_;  | 
              |
| 93 | 
                  -  | 
              |
| 94 | 
                  - my $expand = "$tag_name ? $args->[0] $args->[1]";  | 
              |
| 95 | 
                  - my $key_infos = [2];  | 
              |
| 96 | 
                  - return ($expand, $key_infos);  | 
              |
| 97 | 
                  - }  | 
              |
| 98 | 
                  -);  | 
              |
| 99 | 
                  -  | 
              |
| 100 | 
                  -$query = $sql_tmpl->create_query("{p a b}");
                 | 
              |
| 101 | 
                  -is($query->{sql}, "p ? a b;", "$test : add_tag_processor sql");
                 | 
              |
| 102 | 
                  -is_deeply($query->{key_infos}, [2], "$test : add_tag_processor key_infos");
                 | 
              |
| 103 | 
                  -isa_ok($ret_val, 'DBIx::Custom::SQL::Template');  | 
              |
| 104 | 
                  -  | 
              |
| 105 | 
                  -  | 
              |
| 106 | 
                  -test "Tag processor error case";  | 
              |
| 107 | 
                  -$sql_tmpl = DBIx::Custom::SQL::Template->new;  | 
              |
| 108 | 
                  -  | 
              |
| 109 | 
                  -  | 
              |
| 110 | 
                  -eval{$sql_tmpl->create_query("{a }")};
                 | 
              |
| 111 | 
                  -like($@, qr/Tag '{a }' in SQL template is not exist/, "$test : tag_processor not exist");
                 | 
              |
| 112 | 
                  -  | 
              |
| 113 | 
                  -$sql_tmpl->add_tag_processor({
                 | 
              |
| 114 | 
                  - q => 'string'  | 
              |
| 115 | 
                  -});  | 
              |
| 116 | 
                  -  | 
              |
| 117 | 
                  -eval{$sql_tmpl->create_query("{q}", {})};
                 | 
              |
| 118 | 
                  -like($@, qr/Tag processor 'q' must be code reference/, "$test : tag_processor not code ref");  | 
              |
| 119 | 
                  -  | 
              |
| 120 | 
                  -$sql_tmpl->add_tag_processor({
                 | 
              |
| 121 | 
                  -   r => sub {} 
                 | 
              |
| 122 | 
                  -});  | 
              |
| 123 | 
                  -  | 
              |
| 124 | 
                  -eval{$sql_tmpl->create_query("{r}")};
                 | 
              |
| 125 | 
                  -like($@, qr/\QTag processor 'r' must return (\E\$expand\Q, \E\$key_infos\Q)/, "$test : tag processor return noting");  | 
              |
| 126 | 
                  -  | 
              |
| 127 | 
                  -$sql_tmpl->add_tag_processor({
                 | 
              |
| 128 | 
                  -   s => sub { return ("a", "")} 
                 | 
              |
| 129 | 
                  -});  | 
              |
| 130 | 
                  -  | 
              |
| 131 | 
                  -eval{$sql_tmpl->create_query("{s}")};
                 | 
              |
| 132 | 
                  -like($@, qr/\QTag processor 's' must return (\E\$expand\Q, \E\$key_infos\Q)/, "$test : tag processor return not array key_infos");  | 
              |
| 133 | 
                  -  | 
              |
| 134 | 
                  -$sql_tmpl->add_tag_processor(  | 
              |
| 135 | 
                  -    t => sub {return ("a", [])}
                 | 
              |
| 136 | 
                  -);  | 
              |
| 137 | 
                  -  | 
              |
| 138 | 
                  -eval{$sql_tmpl->create_query("{t ???}")};
                 | 
              |
| 139 | 
                  -like($@, qr/Tag '{t }' arguments cannot contain '?'/, "$test : cannot contain '?' in tag argument");
                 | 
              |
| 140 | 
                  -  | 
              |
| 141 | 
                  -  | 
              |
| 142 | 
                  -test 'General error case';  | 
              |
| 143 | 
                  -$sql_tmpl = DBIx::Custom::SQL::Template->new;  | 
              |
| 144 | 
                  -$sql_tmpl->add_tag_processor(  | 
              |
| 145 | 
                  -    a => sub {
                 | 
              |
| 146 | 
                  -        return ("? ? ?", [[],[]]);
                 | 
              |
| 147 | 
                  - }  | 
              |
| 148 | 
                  -);  | 
              |
| 149 | 
                  -eval{$sql_tmpl->create_query("{a}")};
                 | 
              |
| 150 | 
                  -like($@, qr/Placeholder count in SQL created by tag processor 'a' must be same as key informations count/, "$test placeholder count is invalid");  | 
              |
| 151 | 
                  -  | 
              |
| 152 | 
                  -  | 
              |
| 153 | 
                  -test 'Default tag processor Error case';  | 
              |
| 154 | 
                  -eval{$sql_tmpl->create_query("{= }")};
                 | 
              |
| 155 | 
                  -like($@, qr/You must be pass key as argument to tag '{= }'/, "$test : basic '=' : key not exist");
                 | 
              |
| 156 | 
                  -  | 
              |
| 157 | 
                  -eval{$sql_tmpl->create_query("{in }")};
                 | 
              |
| 158 | 
                  -like($@, qr/You must be pass key as first argument of tag '{in }'/, "$test : in : key not exist");
                 | 
              |
| 159 | 
                  -  | 
              |
| 160 | 
                  -eval{$sql_tmpl->create_query("{in a}")};
                 | 
              |
| 161 | 
                  -like($@, qr/\QYou must be pass placeholder count as second argument of tag '{in }'\E\n\QUsage: {in \E\$key\Q \E\$placeholder_count\Q}/,
                 | 
              |
| 162 | 
                  - "$test : in : key not exist");  | 
              |
| 163 | 
                  -  | 
              |
| 164 | 
                  -eval{$sql_tmpl->create_query("{in a r}")};
                 | 
              |
| 165 | 
                  -like($@, qr/\QYou must be pass placeholder count as second argument of tag '{in }'\E\n\QUsage: {in \E\$key\Q \E\$placeholder_count\Q}/,
                 | 
              |
| 166 | 
                  - "$test : in : key not exist");  | 
              |
| 167 | 
                  -  | 
              |
| 168 | 
                  -  | 
              |
| 169 | 
                  -test 'Clone';  | 
              |
| 170 | 
                  -$sql_tmpl = DBIx::Custom::SQL::Template->new;  | 
              |
| 171 | 
                  -$sql_tmpl  | 
              |
| 172 | 
                  -  ->tag_start('[')
                 | 
              |
| 173 | 
                  -  ->tag_end(']')
                 | 
              |
| 174 | 
                  -  ->tag_syntax('syntax')
                 | 
              |
| 175 | 
                  -  ->tag_processors({a => 1, b => 2});
                 | 
              |
| 176 | 
                  -  | 
              |
| 177 | 
                  -$clone = $sql_tmpl->clone;  | 
              |
| 178 | 
                  -is($clone->tag_start, $sql_tmpl->tag_start, "$test : tag_start");  | 
              |
| 179 | 
                  -is($clone->tag_end, $sql_tmpl->tag_end, "$test : tag_end");  | 
              |
| 180 | 
                  -is($clone->tag_syntax, $sql_tmpl->tag_syntax, "$test : tag_syntax");  | 
              |
| 181 | 
                  -  | 
              |
| 182 | 
                  -is_deeply( scalar $clone->tag_processors, scalar $sql_tmpl->tag_processors,  | 
              |
| 183 | 
                  - "$test : tag_processors deep clone");  | 
              |
| 184 | 
                  -  | 
              |
| 185 | 
                  -isnt($clone->tag_processors, $sql_tmpl->tag_processors,  | 
              |
| 186 | 
                  - "$test : tag_processors reference not copy");  | 
              |
| 187 | 
                  -  | 
              |
| 188 | 
                  -$sql_tmpl->tag_processors(undef);  | 
              |
| 189 | 
                  -  | 
              |
| 190 | 
                  -$clone = $sql_tmpl->clone;  | 
              |
| 191 | 
                  -is_deeply(scalar $clone->tag_processors, {}, "$test tag_processor undef copy");
                 | 
              |
| 192 | 
                  -  | 
              |
| 193 | 
                  -  | 
              |
| 194 | 
                  -  | 
              |
| 195 | 
                  -__END__  | 
              |
| 196 | 
                  -  | 
              |
| 197 | 
                  -  | 
              |
| 198 | 
                  -  | 
              
| ... | ... | 
                  @@ -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 | 
                  -  | 
              
| ... | ... | 
                  @@ -1,79 +0,0 @@  | 
              
| 1 | 
                  -use Test::More;  | 
              |
| 2 | 
                  -use strict;  | 
              |
| 3 | 
                  -use warnings;  | 
              |
| 4 | 
                  -use utf8;  | 
              |
| 5 | 
                  -  | 
              |
| 6 | 
                  -BEGIN {
                 | 
              |
| 7 | 
                  -    eval { require DBD::SQLite; 1 }
                 | 
              |
| 8 | 
                  - or plan skip_all => 'DBD::SQLite required';  | 
              |
| 9 | 
                  -    eval { DBD::SQLite->VERSION >= 1.25 }
                 | 
              |
| 10 | 
                  - or plan skip_all => 'DBD::SQLite >= 1.25 required';  | 
              |
| 11 | 
                  -  | 
              |
| 12 | 
                  - plan 'no_plan';  | 
              |
| 13 | 
                  -    use_ok('DBIx::Custom::SQLite');
                 | 
              |
| 14 | 
                  -}  | 
              |
| 15 | 
                  -  | 
              |
| 16 | 
                  -# Function for test name  | 
              |
| 17 | 
                  -my $test;  | 
              |
| 18 | 
                  -sub test {
                 | 
              |
| 19 | 
                  - $test = shift;  | 
              |
| 20 | 
                  -}  | 
              |
| 21 | 
                  -  | 
              |
| 22 | 
                  -# Constant varialbes for test  | 
              |
| 23 | 
                  -my $CREATE_TABLE = {
                 | 
              |
| 24 | 
                  - 0 => 'create table table1 (key1 char(255), key2 char(255));',  | 
              |
| 25 | 
                  - 1 => 'create table table1 (key1 char(255), key2 char(255), key3 char(255), key4 char(255), key5 char(255));',  | 
              |
| 26 | 
                  - 2 => 'create table table2 (key1 char(255), key3 char(255));'  | 
              |
| 27 | 
                  -};  | 
              |
| 28 | 
                  -  | 
              |
| 29 | 
                  -  | 
              |
| 30 | 
                  -# Variables for tests  | 
              |
| 31 | 
                  -my $dbi;  | 
              |
| 32 | 
                  -my $ret_val;  | 
              |
| 33 | 
                  -my $rows;  | 
              |
| 34 | 
                  -my $db_file;  | 
              |
| 35 | 
                  -my $id;  | 
              |
| 36 | 
                  -  | 
              |
| 37 | 
                  -test 'connect_memory';  | 
              |
| 38 | 
                  -$dbi = DBIx::Custom::SQLite->new;  | 
              |
| 39 | 
                  -$dbi->connect_memory;  | 
              |
| 40 | 
                  -$ret_val = $dbi->do($CREATE_TABLE->{0});
                 | 
              |
| 41 | 
                  -ok(defined $ret_val, $test);  | 
              |
| 42 | 
                  -$dbi->utf8_filter_on;  | 
              |
| 43 | 
                  -$dbi->insert('table1', {key1 => 'あ', key2 => 2});
                 | 
              |
| 44 | 
                  -$rows = $dbi->select('table1', {key1 => 'あ'})->fetch_hash_all;
                 | 
              |
| 45 | 
                  -is_deeply($rows, [{key1 => 'あ', key2 => 2}], "$test : select rows");
                 | 
              |
| 46 | 
                  -  | 
              |
| 47 | 
                  -test 'connect_memory error';  | 
              |
| 48 | 
                  -eval{$dbi->connect_memory};
                 | 
              |
| 49 | 
                  -like($@, qr/Already connected/, "$test : already connected");  | 
              |
| 50 | 
                  -  | 
              |
| 51 | 
                  -test 'reconnect_memory';  | 
              |
| 52 | 
                  -$dbi = DBIx::Custom::SQLite->new;  | 
              |
| 53 | 
                  -$dbi->reconnect_memory;  | 
              |
| 54 | 
                  -$ret_val = $dbi->do($CREATE_TABLE->{0});
                 | 
              |
| 55 | 
                  -ok(defined $ret_val, "$test : connect first");  | 
              |
| 56 | 
                  -$dbi->reconnect_memory;  | 
              |
| 57 | 
                  -$ret_val = $dbi->do($CREATE_TABLE->{2});
                 | 
              |
| 58 | 
                  -ok(defined $ret_val, "$test : connect first");  | 
              |
| 59 | 
                  -  | 
              |
| 60 | 
                  -test 'connect';  | 
              |
| 61 | 
                  -$db_file = 't/test.db';  | 
              |
| 62 | 
                  -unlink $db_file if -f $db_file;  | 
              |
| 63 | 
                  -$dbi = DBIx::Custom::SQLite->new(database => $db_file);  | 
              |
| 64 | 
                  -$dbi->connect;  | 
              |
| 65 | 
                  -ok(-f $db_file, "$test : database file");  | 
              |
| 66 | 
                  -$ret_val = $dbi->do($CREATE_TABLE->{0});
                 | 
              |
| 67 | 
                  -ok(defined $ret_val, "$test : database");  | 
              |
| 68 | 
                  -$dbi->disconnect;  | 
              |
| 69 | 
                  -unlink $db_file if -f $db_file;  | 
              |
| 70 | 
                  -  | 
              |
| 71 | 
                  -test 'last_insert_rowid';  | 
              |
| 72 | 
                  -$dbi = DBIx::Custom::SQLite->new;  | 
              |
| 73 | 
                  -$dbi->connect_memory;  | 
              |
| 74 | 
                  -$ret_val = $dbi->do($CREATE_TABLE->{0});
                 | 
              |
| 75 | 
                  -$dbi->insert('table1', {key1 => 1, key2 => 2});
                 | 
              |
| 76 | 
                  -is($dbi->last_insert_rowid, 1, "$test: first");  | 
              |
| 77 | 
                  -$dbi->insert('table1', {key1 => 1, key2 => 2});
                 | 
              |
| 78 | 
                  -is($dbi->last_insert_rowid, 2, "$test: second");  | 
              |
| 79 | 
                  -$dbi->disconnect;  |