Showing 4 changed files with 139 additions and 14 deletions
+2
Changes
... ...
@@ -1,3 +1,5 @@
1
+0.1610
2
+  added check_filter attribute.
1 3
 0.1609
2 4
   updated document.
3 5
 0.1608
+16 -1
lib/DBIx/Custom.pm
... ...
@@ -42,6 +42,8 @@ __PACKAGE__->attr(cache_method => sub {
42 42
     }
43 43
 });
44 44
 
45
+__PACKAGE__->attr(filter_check => 1);
46
+
45 47
 sub connect {
46 48
     my $proto = shift;
47 49
     
... ...
@@ -394,7 +396,8 @@ sub execute{
394 396
         my $result = $self->result_class->new(
395 397
             sth            => $sth,
396 398
             default_filter => $self->default_fetch_filter,
397
-            filters        => $self->filters
399
+            filters        => $self->filters,
400
+            filter_check   => $self->filter_check
398 401
         );
399 402
 
400 403
         return $result;
... ...
@@ -941,6 +944,8 @@ This is same as the following one.
941 944
     );
942 945
     $result->filter({title => 'decode_utf8', author => 'to_upper_case'});
943 946
 
947
+In fetch filter, column name must be lower case even if column conatain upper case charactor. This is requirment not to depend database systems.
948
+
944 949
 =head2 6. Performance
945 950
 
946 951
 If you execute insert statement by using select() method,
... ...
@@ -1151,6 +1156,16 @@ B<Example:>
1151 1156
         }
1152 1157
     );
1153 1158
 
1159
+=head2 C<filter_check>
1160
+
1161
+    my $filter_check = $dbi->filter_check;
1162
+    $dbi             = $dbi->filter_check(0);
1163
+
1164
+Enable filter check. 
1165
+Default to 1.
1166
+This check maybe damege performance.
1167
+If you require performance, set C<filter_check> to 0.
1168
+
1154 1169
 =head1 METHODS
1155 1170
 
1156 1171
 L<DBIx::Custom> inherits all methods from L<Object::Simple>
+47 -13
lib/DBIx/Custom/Result.pm
... ...
@@ -7,33 +7,38 @@ use base 'Object::Simple';
7 7
 
8 8
 use Carp 'croak';
9 9
 
10
-__PACKAGE__->attr([qw/sth filters default_filter filter/]);
10
+__PACKAGE__->attr([qw/sth filters default_filter filter filter_check/]);
11 11
 
12 12
 sub fetch {
13 13
     my $self = shift;
14 14
     
15 15
     # Filters
16
-    $self->{filters} ||= {};
17
-    $self->{filter}  ||= {};
16
+    my $filters = $self->{filters} || {};
17
+    my $filter  = $self->{filter}  || {};
18 18
     
19 19
     # Fetch
20 20
     my @row = $self->{sth}->fetchrow_array;
21 21
     
22 22
     # No row
23 23
     return unless @row;
24
-
24
+    
25
+    # Check filter
26
+    $self->_check_filter($filters, $filter, 
27
+                         $self->default_filter, $self->sth)
28
+      if $self->{filter_check};
29
+    
25 30
     # Filtering
26 31
     my $columns = $self->{sth}->{NAME_lc};
27 32
     for (my $i = 0; $i < @$columns; $i++) {
28 33
         
29 34
         # Filter name
30 35
         my $column = $columns->[$i];
31
-        my $fname  = exists $self->{filter}->{$column}
32
-                   ? $self->{filter}->{$column}
36
+        my $fname  = exists $filter->{$column}
37
+                   ? $filter->{$column}
33 38
                    : $self->{default_filter};
34 39
         
35 40
         # Filtering
36
-        $row[$i] = $self->{filters}->{$fname}->($row[$i])
41
+        $row[$i] = $filters->{$fname}->($row[$i])
37 42
           if $fname;
38 43
     }
39 44
 
... ...
@@ -89,15 +94,20 @@ sub fetch_hash {
89 94
     my $self = shift;
90 95
     
91 96
     # Filters
92
-    $self->{filters} ||= {};
93
-    $self->{filter}  ||= {};
97
+    my $filters = $self->{filters} || {};
98
+    my $filter  = $self->{filter}  || {};
94 99
     
95 100
     # Fetch
96 101
     my $row = $self->{sth}->fetchrow_arrayref;
97 102
     
98 103
     # Cannot fetch
99 104
     return unless $row;
100
-    
105
+
106
+    # Check filter
107
+    $self->_check_filter($filters, $filter, 
108
+                         $self->default_filter, $self->sth)
109
+      if $self->{filter_check};
110
+
101 111
     # Filter
102 112
     my $row_hash = {};
103 113
     my $columns = $self->{sth}->{NAME_lc};
... ...
@@ -105,13 +115,13 @@ sub fetch_hash {
105 115
         
106 116
         # Filter name
107 117
         my $column = $columns->[$i];
108
-        my $fname  = exists $self->{filter}->{$column}
109
-                   ? $self->{filter}->{$column}
118
+        my $fname  = exists $filter->{$column}
119
+                   ? $filter->{$column}
110 120
                    : $self->{default_filter};
111 121
         
112 122
         # Filtering
113 123
         $row_hash->{$column}
114
-          = $fname ? $self->{filters}->{$fname}->($row->[$i]) 
124
+          = $fname ? $filters->{$fname}->($row->[$i]) 
115 125
                    : $row->[$i];
116 126
     }
117 127
     
... ...
@@ -164,6 +174,30 @@ sub fetch_hash_all {
164 174
     return $rows;
165 175
 }
166 176
 
177
+sub _check_filter {
178
+    my ($self, $filters, $filter, $default_filter, $sth) = @_;
179
+    
180
+    # Filter name not exists
181
+    foreach my $fname (values %$filter) {
182
+        croak qq{Fetch filter "$fname" is not registered}
183
+          unless exists $filters->{$fname};
184
+    }
185
+    
186
+    # Default filter name not exists
187
+    croak qq{Default fetch filter "$default_filter" is not registered}
188
+      if $default_filter && ! exists $filters->{$default_filter};
189
+    
190
+    # Column name not exists
191
+    my %columns = map {$_ => 1} @{$self->sth->{NAME_lc}};
192
+    foreach my $column (keys %$filter) {
193
+        croak qq{Column name "$column" in fetch filter must lower case string}
194
+          unless $column eq lc $column;
195
+        
196
+        croak qq{Column name "$column" in fetch filter is not found in result columns}
197
+          unless $columns{$column};
198
+    }
199
+}
200
+
167 201
 1;
168 202
 
169 203
 =head1 NAME
+74
t/dbix-custom-core-sqlite.t
... ...
@@ -447,3 +447,77 @@ $dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
447 447
 is(scalar keys %{$dbi->{_cached}}, 0, 'not cache');
448 448
 
449 449
 
450
+test 'filter_check in fetching';
451
+$dbi = DBIx::Custom->connect($NEW_ARGS->{0});
452
+$dbi->execute($CREATE_TABLE->{0});
453
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
454
+$dbi->default_fetch_filter('not_exists');
455
+$result = $dbi->select(table => 'table1');
456
+eval{$result->fetch_first};
457
+like($@, qr/\QDefault fetch filter "not_exists" is not registered/, "$test : array :default_fetch_filter");
458
+
459
+$dbi->default_fetch_filter(undef);
460
+$result = $dbi->select(table => 'table1');
461
+$result->filter({key1 => 'not_exists'});
462
+eval{$result->fetch_first};
463
+like($@, qr/\QFetch filter "not_exists" is not registered/, "$test :  array :fetch_filter");
464
+
465
+$result = $dbi->select(table => 'table1');
466
+$result->filter({not_exists => 'encode_utf8'});
467
+eval{$result->fetch_first};
468
+like($@, qr/\QColumn name "not_exists" in fetch filter is not found in result columns/,
469
+     "$test :  array : fetch_filter");
470
+
471
+$result = $dbi->select(table => 'table1');
472
+$result->filter({Key1 => 'encode_utf8'});
473
+eval{$result->fetch_first};
474
+like($@, qr/\QColumn name "Key1" in fetch filter must lower case string/,
475
+     "$test :  array : contain upper case charactor");
476
+
477
+$dbi->filter_check(0);
478
+$result = $dbi->select(table => 'table1');
479
+$result->filter({Key1 => 'encode_utf8'});
480
+eval{$result->fetch_first};
481
+ok(!$@, "$test : array : filter_check off");
482
+
483
+$dbi = DBIx::Custom->connect($NEW_ARGS->{0});
484
+$dbi->execute($CREATE_TABLE->{0});
485
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
486
+$dbi->default_fetch_filter('not_exists');
487
+$result = $dbi->select(table => 'table1');
488
+eval{$result->fetch_hash_first};
489
+like($@, qr/\QDefault fetch filter "not_exists" is not registered/, "$test : hash :default_fetch_filter");
490
+
491
+$dbi->default_fetch_filter(undef);
492
+$result = $dbi->select(table => 'table1');
493
+$result->filter({key1 => 'not_exists'});
494
+eval{$result->fetch_hash_first};
495
+like($@, qr/\QFetch filter "not_exists" is not registered/, "$test : hash :fetch_filter");
496
+
497
+$result = $dbi->select(table => 'table1');
498
+$result->filter({not_exists => 'encode_utf8'});
499
+eval{$result->fetch_hash_first};
500
+like($@, qr/\QColumn name "not_exists" in fetch filter is not found in result columns/,
501
+     "$test : hash : fetch_filter");
502
+
503
+$result = $dbi->select(table => 'table1');
504
+$result->filter({Key1 => 'encode_utf8'});
505
+eval{$result->fetch_hash_first};
506
+like($@, qr/\QColumn name "Key1" in fetch filter must lower case string/,
507
+     "$test : hash : contain upper case charactor");
508
+
509
+$dbi->filter_check(0);
510
+$result = $dbi->select(table => 'table1');
511
+$result->filter({Key1 => 'encode_utf8'});
512
+eval{$result->fetch_hash_first};
513
+ok(!$@, "$test : hash : filter_check off");
514
+
515
+
516
+test 'filter_check in binding parameter';
517
+$dbi = DBIx::Custom->connect($NEW_ARGS->{0});
518
+$dbi->execute($CREATE_TABLE->{0});
519
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
520
+
521
+
522
+
523
+