Showing 11 changed files with 95 additions and 93 deletions
+4
Changes
... ...
@@ -1,3 +1,7 @@
1
+0.1402
2
+  remove finish(), error()
3
+  can receive code ref to filter()
4
+  renamed resist to register
1 5
 0.1401
2 6
   renamed fetch_rows to fetch_multi
3 7
   renamed fetch_hash_rows to fetch_hash_multi
+19 -16
lib/DBIx/Custom.pm 1000755 → 1000644
... ...
@@ -29,7 +29,7 @@ __PACKAGE__->dual_attr([qw/ filters formats/],
29 29
 __PACKAGE__->attr(result_class => 'DBIx::Custom::Result');
30 30
 __PACKAGE__->attr(sql_tmpl => sub { DBIx::Custom::SQLTemplate->new });
31 31
 
32
-sub resist_filter {
32
+sub register_filter {
33 33
     my $invocant = shift;
34 34
     
35 35
     # Add filter
... ...
@@ -39,7 +39,7 @@ sub resist_filter {
39 39
     return $invocant;
40 40
 }
41 41
 
42
-sub resist_format{
42
+sub register_format{
43 43
     my $invocant = shift;
44 44
     
45 45
     # Add format
... ...
@@ -631,11 +631,12 @@ DBIx::Custom - DBI with hash bind and filtering system
631 631
 
632 632
 =head1 VERSION
633 633
 
634
-Version 0.1401
634
+Version 0.1402
635 635
 
636 636
 =cut
637 637
 
638
-our $VERSION = '0.1401';
638
+our $VERSION = '0.1402';
639
+$VERSION = eval $VERSION;
639 640
 
640 641
 =head1 STATE
641 642
 
... ...
@@ -654,6 +655,8 @@ This module is not stable. Method name and functionality will be change.
654 655
     $dbi->execute("select id from books where {= author} && {like title}",
655 656
                 {author => 'ken', title => '%Perl%'});
656 657
     
658
+    
659
+    
657 660
     # Insert 
658 661
     $dbi->insert('books', {title => 'perl', author => 'Ken'});
659 662
     
... ...
@@ -759,7 +762,7 @@ This method is generally used to get a filter.
759 762
 
760 763
     $filter = $dbi->filters->{encode_utf8};
761 764
 
762
-If you add filter, use resist_filter method.
765
+If you add filter, use register_filter method.
763 766
 
764 767
 =head2 formats
765 768
 
... ...
@@ -772,7 +775,7 @@ This method is generally used to get a format.
772 775
 
773 776
     $filter = $dbi->formats->{datetime};
774 777
 
775
-If you add format, use resist_format method.
778
+If you add format, use register_format method.
776 779
 
777 780
 =head2 default_query_filter
778 781
 
... ...
@@ -783,7 +786,7 @@ Binding filter
783 786
 
784 787
 The following is bind filter example
785 788
     
786
-    $dbi->resist_filter(encode_utf8 => sub {
789
+    $dbi->register_filter(encode_utf8 => sub {
787 790
         my $value = shift;
788 791
         
789 792
         require Encode 'encode_utf8';
... ...
@@ -809,7 +812,7 @@ Fetching filter
809 812
 
810 813
 The following is fetch filter example
811 814
 
812
-    $dbi->resist_filter(decode_utf8 => sub {
815
+    $dbi->register_filter(decode_utf8 => sub {
813 816
         my $value = shift;
814 817
         
815 818
         require Encode 'decode_utf8';
... ...
@@ -882,15 +885,15 @@ Check if database is connected.
882 885
     
883 886
     $is_connected = $dbi->connected;
884 887
     
885
-=head2 resist_filter
888
+=head2 register_filter
886 889
 
887 890
 Resist filter
888 891
     
889
-    $dbi->resist_filter($fname1 => $filter1, $fname => $filter2);
892
+    $dbi->register_filter($fname1 => $filter1, $fname => $filter2);
890 893
     
891
-The following is resist_filter example
894
+The following is register_filter example
892 895
 
893
-    $dbi->resist_filter(
896
+    $dbi->register_filter(
894 897
         encode_utf8 => sub {
895 898
             my ($value, $key, $dbi, $infos) = @_;
896 899
             utf8::upgrade($value) unless Encode::is_utf8($value);
... ...
@@ -902,15 +905,15 @@ The following is resist_filter example
902 905
         }
903 906
     );
904 907
 
905
-=head2 resist_format
908
+=head2 register_format
906 909
 
907 910
 Add format
908 911
 
909
-    $dbi->resist_format($fname1 => $format, $fname2 => $format2);
912
+    $dbi->register_format($fname1 => $format, $fname2 => $format2);
910 913
     
911
-The following is resist_format example.
914
+The following is register_format example.
912 915
 
913
-    $dbi->resist_format(date => '%Y:%m:%d', datetime => '%Y-%m-%d %H:%M:%S');
916
+    $dbi->register_format(date => '%Y:%m:%d', datetime => '%Y-%m-%d %H:%M:%S');
914 917
 
915 918
 =head2 create_query
916 919
     
+2 -2
lib/DBIx/Custom/Basic.pm
... ...
@@ -7,13 +7,13 @@ use base 'DBIx::Custom';
7 7
 
8 8
 use Encode qw/decode encode/;
9 9
 
10
-__PACKAGE__->resist_filter(
10
+__PACKAGE__->register_filter(
11 11
     none        => sub { $_[0] },
12 12
     encode_utf8 => sub { encode('UTF-8', $_[0]) },
13 13
     decode_utf8 => sub { decode('UTF-8', $_[0]) }
14 14
 );
15 15
 
16
-__PACKAGE__->resist_format(
16
+__PACKAGE__->register_format(
17 17
     'SQL99_date'        => '%Y-%m-%d',
18 18
     'SQL99_datetime'    => '%Y-%m-%d %H:%M:%S',
19 19
     'SQL99_time'        => '%H:%M:%S',
+1 -1
lib/DBIx/Custom/MySQL.pm
... ...
@@ -6,7 +6,7 @@ use strict;
6 6
 use base 'DBIx::Custom::Basic';
7 7
 use Carp 'croak';
8 8
 
9
-__PACKAGE__->resist_format(
9
+__PACKAGE__->register_format(
10 10
     datetime => __PACKAGE__->formats->{SQL99_datetime},
11 11
     date     => __PACKAGE__->formats->{SQL99_date},
12 12
     time     => __PACKAGE__->formats->{SQL99_time},
+43 -29
lib/DBIx/Custom/Result.pm
... ...
@@ -12,10 +12,9 @@ __PACKAGE__->attr([qw/sth filters default_filter filter/]);
12 12
 sub fetch {
13 13
     my ($self, $type) = @_;
14 14
     
15
-    my $sth            = $self->sth;
16
-    my $filters        = $self->filters || {};
17
-    my $default_filter = $self->default_filter || '';
18
-    my $filter         = $self->filter || {};
15
+    my $sth     = $self->{sth};
16
+    my $filters = $self->{filters} || {};
17
+    my $filter  = $self->{filter} || {};
19 18
     
20 19
     # Fetch
21 20
     my $row = $sth->fetchrow_arrayref;
... ...
@@ -28,9 +27,22 @@ sub fetch {
28 27
     
29 28
     # Filter
30 29
     for (my $i = 0; $i < @$columns; $i++) {
31
-        my $fname  = $filter->{$columns->[$i]} || $filters->{$default_filter} || '';
32
-        my $filter = $filters->{$fname};
33
-        $row->[$i] = $filter->($row->[$i]) if $filter;
30
+        my $fname  = $filter->{$columns->[$i]} || $self->{default_filter} || '';
31
+        
32
+        if ($fname) {
33
+            my $filter;
34
+            
35
+            if (ref $fname) {
36
+                $filter = $fname;
37
+            }
38
+            else {
39
+                croak "Filter \"$fname\" is not registered."
40
+                  unless exists $filters->{$fname};
41
+                  
42
+                $filter = $filters->{$fname};
43
+            }
44
+            $row->[$i] = $filter->($row->[$i]);
45
+        }
34 46
     }
35 47
 
36 48
     return wantarray ? @$row : $row;
... ...
@@ -39,10 +51,9 @@ sub fetch {
39 51
 sub fetch_hash {
40 52
     my $self = shift;
41 53
 
42
-    my $sth            = $self->sth;
43
-    my $filters        = $self->filters || {};
44
-    my $default_filter = $self->default_filter || '';
45
-    my $filter         = $self->filter || {};
54
+    my $sth            = $self->{sth};
55
+    my $filters        = $self->{filters} || {};
56
+    my $filter         = $self->{filter} || {};
46 57
     
47 58
     # Fetch
48 59
     my $row = $sth->fetchrow_arrayref;
... ...
@@ -56,11 +67,25 @@ sub fetch_hash {
56 67
     # Filter
57 68
     my $row_hash = {};
58 69
     for (my $i = 0; $i < @$columns; $i++) {
59
-        my $fname  = $filter->{$columns->[$i]} || $default_filter || '';
60
-        my $filter = $filters->{$fname};
61
-        $row_hash->{$columns->[$i]} = $filter
62
-                                    ? $filter->($row->[$i])
63
-                                    : $row->[$i];
70
+        my $fname  = $filter->{$columns->[$i]} || $self->{default_filter} || '';
71
+        
72
+        if ($fname) {
73
+            my $filter;
74
+            
75
+            if (ref $fname) {
76
+                $filter = $fname;
77
+            }
78
+            else {
79
+                croak "Filter \"$fname\" is not registered."
80
+                  unless exists $filters->{$fname};
81
+                  
82
+                $filter = $filters->{$fname};
83
+            }
84
+            $row_hash->{$columns->[$i]} = $filter->($row->[$i]);
85
+        }
86
+        else {
87
+            $row_hash->{$columns->[$i]} = $row->[$i];
88
+        }
64 89
     }
65 90
     
66 91
     return wantarray ? %$row_hash : $row_hash;
... ...
@@ -76,7 +101,7 @@ sub fetch_single {
76 101
     return unless $row;
77 102
     
78 103
     # Finish statement handle
79
-    $self->finish;
104
+    $self->sth->finish;
80 105
     
81 106
     return wantarray ? @$row : $row;
82 107
 }
... ...
@@ -91,7 +116,7 @@ sub fetch_hash_single {
91 116
     return unless $row;
92 117
     
93 118
     # Finish statement handle
94
-    $self->finish;
119
+    $self->sth->finish;
95 120
     
96 121
     return wantarray ? %$row : $row;
97 122
 }
... ...
@@ -160,17 +185,6 @@ sub fetch_hash_all {
160 185
     return wantarray ? @$rows : $rows;
161 186
 }
162 187
 
163
-sub finish { shift->sth->finish }
164
-
165
-sub error { 
166
-    my $self = shift;
167
-    
168
-    # Statement handle
169
-    my $sth  = $self->sth;
170
-    
171
-    return wantarray ? ($sth->errstr, $sth->err, $sth->state) : $sth->errstr;
172
-}
173
-
174 188
 1;
175 189
 
176 190
 =head1 NAME
+6 -6
lib/DBIx/Custom/SQLTemplate.pm
... ...
@@ -17,7 +17,7 @@ __PACKAGE__->dual_attr('tag_end',   default => '}', inherit => 'scalar_copy');
17 17
 
18 18
 __PACKAGE__->dual_attr('tag_syntax', inherit => 'scalar_copy');
19 19
 
20
-__PACKAGE__->resist_tag_processor(
20
+__PACKAGE__->register_tag_processor(
21 21
     '?'      => \&DBIx::Custom::SQLTemplate::TagProcessors::expand_placeholder_tag,
22 22
     '='      => \&DBIx::Custom::SQLTemplate::TagProcessors::expand_basic_tag,
23 23
     '<>'     => \&DBIx::Custom::SQLTemplate::TagProcessors::expand_basic_tag,
... ...
@@ -50,7 +50,7 @@ __PACKAGE__->tag_syntax(<< 'EOS');
50 50
 EOS
51 51
 
52 52
 
53
-sub resist_tag_processor {
53
+sub register_tag_processor {
54 54
     my $invocant = shift;
55 55
     my $tag_processors = ref $_[0] eq 'HASH' ? $_[0] : {@_};
56 56
     $invocant->tag_processors({%{$invocant->tag_processors}, %{$tag_processors}});
... ...
@@ -293,15 +293,15 @@ query has two infomation
293 293
     1. sql       : SQL
294 294
     2. key_infos : Parameter access key information
295 295
 
296
-=head2 resist_tag_processor
296
+=head2 register_tag_processor
297 297
 
298 298
 Add tag processor
299 299
     
300
-    $sql_tmpl = $sql_tmpl->resist_tag_processor($tag_processor);
300
+    $sql_tmpl = $sql_tmpl->register_tag_processor($tag_processor);
301 301
 
302
-The following is resist_tag_processor sample
302
+The following is register_tag_processor sample
303 303
 
304
-    $sql_tmpl->resist_tag_processor(
304
+    $sql_tmpl->register_tag_processor(
305 305
         '?' => sub {
306 306
             my ($tag_name, $tag_args) = @_;
307 307
             
+1 -1
lib/DBIx/Custom/SQLite.pm
... ...
@@ -7,7 +7,7 @@ use base 'DBIx::Custom::Basic';
7 7
 use Carp 'croak';
8 8
 
9 9
 # Add format
10
-__PACKAGE__->resist_format(
10
+__PACKAGE__->register_format(
11 11
     datetime => __PACKAGE__->formats->{SQL99_datetime},
12 12
     date     => __PACKAGE__->formats->{SQL99_date},
13 13
     time     => __PACKAGE__->formats->{SQL99_time},
+7 -7
t/dbix-custom-core-sqlite.t 1000755 → 1000644
... ...
@@ -168,7 +168,7 @@ is_deeply($rows, [{key1 => 1, key2 => 2}], $test);
168 168
 test 'Filter basic';
169 169
 $dbi->execute($DROP_TABLE->{0});
170 170
 $dbi->execute($CREATE_TABLE->{0});
171
-$dbi->resist_filter(twice       => sub { $_[0] * 2}, 
171
+$dbi->register_filter(twice       => sub { $_[0] * 2}, 
172 172
                     three_times => sub { $_[0] * 3});
173 173
 
174 174
 $insert_tmpl  = "insert into table1 {insert key1 key2};";
... ...
@@ -311,7 +311,7 @@ $rows   = $result->fetch_hash_all;
311 311
 is_deeply($rows, [{key1 => 1, key2 => 2}, {key1 => 3, key2 => 4}], "$test : basic");
312 312
 
313 313
 $dbi->execute('delete from table1');
314
-$dbi->resist_filter(
314
+$dbi->register_filter(
315 315
     twice       => sub { $_[0] * 2 },
316 316
     three_times => sub { $_[0] * 3 }
317 317
 );
... ...
@@ -358,7 +358,7 @@ is_deeply($rows, [{key1 => 1, key2 => 12, key3 => 3, key4 => 4, key5 => 5},
358 358
 $dbi->execute("delete from table1");
359 359
 $dbi->insert('table1', {key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5});
360 360
 $dbi->insert('table1', {key1 => 6, key2 => 7, key3 => 8, key4 => 9, key5 => 10});
361
-$dbi->resist_filter(twice => sub { $_[0] * 2 });
361
+$dbi->register_filter(twice => sub { $_[0] * 2 });
362 362
 $dbi->update('table1', {key2 => 11}, {where => {key1 => 1},
363 363
               filter => {key2 => 'twice'}});
364 364
 $result = $dbi->execute($SELECT_TMPLS->{0});
... ...
@@ -386,7 +386,7 @@ $dbi = DBIx::Custom->new($NEW_ARGS->{0});
386 386
 $dbi->execute($CREATE_TABLE->{1});
387 387
 $dbi->insert('table1', {key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5});
388 388
 $dbi->insert('table1', {key1 => 6, key2 => 7, key3 => 8, key4 => 9, key5 => 10});
389
-$dbi->resist_filter(twice => sub { $_[0] * 2 });
389
+$dbi->register_filter(twice => sub { $_[0] * 2 });
390 390
 $dbi->update_all('table1', {key2 => 10}, {filter => {key2 => 'twice'}});
391 391
 $result = $dbi->execute($SELECT_TMPLS->{0});
392 392
 $rows   = $result->fetch_hash_all;
... ...
@@ -408,7 +408,7 @@ is_deeply($rows, [{key1 => 3, key2 => 4}], "$test : basic");
408 408
 $dbi->execute("delete from table1;");
409 409
 $dbi->insert('table1', {key1 => 1, key2 => 2});
410 410
 $dbi->insert('table1', {key1 => 3, key2 => 4});
411
-$dbi->resist_filter(twice => sub { $_[0] * 2 });
411
+$dbi->register_filter(twice => sub { $_[0] * 2 });
412 412
 $dbi->delete('table1', {where => {key2 => 1}, filter => {key2 => 'twice'}});
413 413
 $result = $dbi->execute($SELECT_TMPLS->{0});
414 414
 $rows   = $result->fetch_hash_all;
... ...
@@ -463,7 +463,7 @@ is_deeply($rows, [{key1 => 3}], "$test : table and columns and where key");
463 463
 $rows = $dbi->select('table1', {append => "order by key1 desc limit 1"})->fetch_hash_all;
464 464
 is_deeply($rows, [{key1 => 3, key2 => 4}], "$test : append statement");
465 465
 
466
-$dbi->resist_filter(decrement => sub { $_[0] - 1 });
466
+$dbi->register_filter(decrement => sub { $_[0] - 1 });
467 467
 $rows = $dbi->select('table1', {where => {key1 => 2}, filter => {key1 => 'decrement'}})
468 468
             ->fetch_hash_all;
469 469
 is_deeply($rows, [{key1 => 1, key2 => 2}], "$test : filter");
... ...
@@ -526,7 +526,7 @@ ok(!$query->filter, "$test : only cached sql and columns");
526 526
 
527 527
 test 'fetch filter';
528 528
 $dbi = DBIx::Custom->new($NEW_ARGS->{0});
529
-$dbi->resist_filter(
529
+$dbi->register_filter(
530 530
     twice       => sub { $_[0] * 2 },
531 531
     three_times => sub { $_[0] * 3 }
532 532
 );
+4 -4
t/dbix-custom-core.t 1000755 → 1000644
... ...
@@ -111,14 +111,14 @@ is_deeply($dbi->formats, {f => 3}, "$test : formats");
111 111
 isa_ok($dbi, 'DBIx::Custom');
112 112
 
113 113
 
114
-test 'resist_filters';
114
+test 'register_filters';
115 115
 $dbi = DBIx::Custom->new;
116
-$dbi->resist_filter(a => sub {1});
116
+$dbi->register_filter(a => sub {1});
117 117
 is($dbi->filters->{a}->(), 1, $test);
118 118
 
119
-test 'resist_formats';
119
+test 'register_formats';
120 120
 $dbi = DBIx::Custom->new;
121
-$dbi->resist_format(a => sub {1});
121
+$dbi->register_format(a => sub {1});
122 122
 is($dbi->formats->{a}->(), 1, $test);
123 123
 
124 124
 test 'Accessor';
-19
t/dbix-custom-result-sqlite.t
... ...
@@ -220,22 +220,3 @@ $result->filter({key1 => 'three_times'});
220 220
 $rows = $result->fetch_hash_all;
221 221
 is_deeply($rows, [{key1 => 3, key2 => 2}, {key1 => 9, key2 => 4}], "$test hash");
222 222
 
223
-test 'finish';
224
-$result = query($dbh, $sql);
225
-$result->fetch;
226
-$result->finish;
227
-ok(!$result->fetch, $test);
228
-
229
-test 'error'; # Cannot real test
230
-$result = query($dbh, $sql);
231
-$sth = $result->sth;
232
-
233
-@error = $result->error;
234
-is(scalar @error, 3, "$test list context count");
235
-is($error[0], $sth->errstr, "$test list context errstr");
236
-is($error[1], $sth->err, "$test list context err");
237
-is($error[2], $sth->state, "$test list context state");
238
-
239
-$error = $result->error;
240
-is($error, $sth->errstr, "$test scalar context");
241
-
+8 -8
t/dbix-custom-sql-template.t 1000755 → 1000644
... ...
@@ -66,7 +66,7 @@ for (my $i = 0; $i < @$datas; $i++) {
66 66
 test 'Original tag processor';
67 67
 $sql_tmpl = DBIx::Custom::SQLTemplate->new;
68 68
 
69
-$ret_val = $sql_tmpl->resist_tag_processor(
69
+$ret_val = $sql_tmpl->register_tag_processor(
70 70
     p => sub {
71 71
         my ($tag_name, $args) = @_;
72 72
         
... ...
@@ -77,8 +77,8 @@ $ret_val = $sql_tmpl->resist_tag_processor(
77 77
 );
78 78
 
79 79
 $query = $sql_tmpl->create_query("{p a b}");
80
-is($query->{sql}, "p ? a b;", "$test : resist_tag_processor sql");
81
-is_deeply($query->{columns}, [2], "$test : resist_tag_processor columns");
80
+is($query->{sql}, "p ? a b;", "$test : register_tag_processor sql");
81
+is_deeply($query->{columns}, [2], "$test : register_tag_processor columns");
82 82
 isa_ok($ret_val, 'DBIx::Custom::SQLTemplate');
83 83
 
84 84
 
... ...
@@ -89,28 +89,28 @@ $sql_tmpl = DBIx::Custom::SQLTemplate->new;
89 89
 eval{$sql_tmpl->create_query("{a }")};
90 90
 like($@, qr/Tag '{a }' in SQL template is not exist/, "$test : tag_processor not exist");
91 91
 
92
-$sql_tmpl->resist_tag_processor({
92
+$sql_tmpl->register_tag_processor({
93 93
     q => 'string'
94 94
 });
95 95
 
96 96
 eval{$sql_tmpl->create_query("{q}", {})};
97 97
 like($@, qr/Tag processor 'q' must be code reference/, "$test : tag_processor not code ref");
98 98
 
99
-$sql_tmpl->resist_tag_processor({
99
+$sql_tmpl->register_tag_processor({
100 100
    r => sub {} 
101 101
 });
102 102
 
103 103
 eval{$sql_tmpl->create_query("{r}")};
104 104
 like($@, qr/\QTag processor 'r' must return (\E\$expand\Q, \E\$columns\Q)/, "$test : tag processor return noting");
105 105
 
106
-$sql_tmpl->resist_tag_processor({
106
+$sql_tmpl->register_tag_processor({
107 107
    s => sub { return ("a", "")} 
108 108
 });
109 109
 
110 110
 eval{$sql_tmpl->create_query("{s}")};
111 111
 like($@, qr/\QTag processor 's' must return (\E\$expand\Q, \E\$columns\Q)/, "$test : tag processor return not array columns");
112 112
 
113
-$sql_tmpl->resist_tag_processor(
113
+$sql_tmpl->register_tag_processor(
114 114
     t => sub {return ("a", [])}
115 115
 );
116 116
 
... ...
@@ -120,7 +120,7 @@ like($@, qr/Tag '{t }' arguments cannot contain '?'/, "$test : cannot contain '?
120 120
 
121 121
 test 'General error case';
122 122
 $sql_tmpl = DBIx::Custom::SQLTemplate->new;
123
-$sql_tmpl->resist_tag_processor(
123
+$sql_tmpl->register_tag_processor(
124 124
     a => sub {
125 125
         return ("? ? ?", [[],[]]);
126 126
     }