changed argument of tag processor(not backword compat...
...ible)
... | ... |
@@ -1,4 +1,5 @@ |
1 | 1 |
0.1604 |
2 |
+ changed argument of tag processor(not backword compatible) |
|
2 | 3 |
renamed default_query_filter to default_bind_filter(not backword compatible) |
3 | 4 |
renamed DBIx::Custom::SQLTemplate to DBIx::Custom::SQLBuilder(not backword compatible) |
4 | 5 |
renamed create_query to build_query(not backword compatible) |
... | ... |
@@ -77,7 +77,7 @@ sub connect { |
77 | 77 |
sub register_filter { |
78 | 78 |
my $invocant = shift; |
79 | 79 |
|
80 |
- # Add filter |
|
80 |
+ # Register filter |
|
81 | 81 |
my $filters = ref $_[0] eq 'HASH' ? $_[0] : {@_}; |
82 | 82 |
$invocant->filters({%{$invocant->filters}, %$filters}); |
83 | 83 |
|
... | ... |
@@ -91,7 +91,7 @@ sub insert { |
91 | 91 |
|
92 | 92 |
# Check arguments |
93 | 93 |
foreach my $name (keys %args) { |
94 |
- croak "\"$name\" is invalid name" |
|
94 |
+ croak qq{"$name" is invalid name} |
|
95 | 95 |
unless $VALID_INSERT_ARGS{$name}; |
96 | 96 |
} |
97 | 97 |
|
... | ... |
@@ -104,10 +104,6 @@ sub insert { |
104 | 104 |
# Insert keys |
105 | 105 |
my @insert_keys = keys %$param; |
106 | 106 |
|
107 |
- # Not exists insert keys |
|
108 |
- croak("Key-value pairs for insert must be specified to 'insert' second argument") |
|
109 |
- unless @insert_keys; |
|
110 |
- |
|
111 | 107 |
# Templte for insert |
112 | 108 |
my $source = "insert into $table {insert " |
113 | 109 |
. join(' ', @insert_keys) . '}'; |
... | ... |
@@ -128,7 +124,7 @@ sub update { |
128 | 124 |
|
129 | 125 |
# Check arguments |
130 | 126 |
foreach my $name (keys %args) { |
131 |
- croak "\"$name\" is invalid name" |
|
127 |
+ croak qq{"$name" is invalid name} |
|
132 | 128 |
unless $VALID_UPDATE_ARGS{$name}; |
133 | 129 |
} |
134 | 130 |
|
... | ... |
@@ -143,15 +139,11 @@ sub update { |
143 | 139 |
# Update keys |
144 | 140 |
my @update_keys = keys %$param; |
145 | 141 |
|
146 |
- # Not exists update kyes |
|
147 |
- croak("Key-value pairs for update must be specified to 'update' second argument") |
|
148 |
- unless @update_keys; |
|
149 |
- |
|
150 | 142 |
# Where keys |
151 | 143 |
my @where_keys = keys %$where; |
152 | 144 |
|
153 | 145 |
# Not exists where keys |
154 |
- croak("Key-value pairs for where clause must be specified to 'update' third argument") |
|
146 |
+ croak qq{"where" must contain column-value pair} |
|
155 | 147 |
if !@where_keys && !$allow_update_all; |
156 | 148 |
|
157 | 149 |
# Update clause |
... | ... |
@@ -174,7 +166,7 @@ sub update { |
174 | 166 |
my $source = "update $table $update_clause $where_clause"; |
175 | 167 |
$source .= " $append_statement" if $append_statement; |
176 | 168 |
|
177 |
- # Rearrange parammeters |
|
169 |
+ # Rearrange parameters |
|
178 | 170 |
foreach my $wkey (@where_keys) { |
179 | 171 |
|
180 | 172 |
if (exists $param->{$wkey}) { |
... | ... |
@@ -205,7 +197,7 @@ sub delete { |
205 | 197 |
|
206 | 198 |
# Check arguments |
207 | 199 |
foreach my $name (keys %args) { |
208 |
- croak "\"$name\" is invalid name" |
|
200 |
+ croak qq{"$name" is invalid name} |
|
209 | 201 |
unless $VALID_DELETE_ARGS{$name}; |
210 | 202 |
} |
211 | 203 |
|
... | ... |
@@ -220,7 +212,7 @@ sub delete { |
220 | 212 |
my @where_keys = keys %$where; |
221 | 213 |
|
222 | 214 |
# Not exists where keys |
223 |
- croak("Key-value pairs for where clause must be specified to 'delete' second argument") |
|
215 |
+ croak qq{Key-value pairs for where clause must be specified to "delete" second argument} |
|
224 | 216 |
if !@where_keys && !$allow_delete_all; |
225 | 217 |
|
226 | 218 |
# Where clause |
... | ... |
@@ -254,7 +246,7 @@ sub select { |
254 | 246 |
|
255 | 247 |
# Check arguments |
256 | 248 |
foreach my $name (keys %args) { |
257 |
- croak "\"$name\" is invalid name" |
|
249 |
+ croak qq{"$name" is invalid name} |
|
258 | 250 |
unless $VALID_SELECT_ARGS{$name}; |
259 | 251 |
} |
260 | 252 |
|
... | ... |
@@ -342,7 +334,7 @@ sub build_query { |
342 | 334 |
|
343 | 335 |
# Create query |
344 | 336 |
$query = eval{$builder->build_query($source)}; |
345 |
- croak($@) if $@; |
|
337 |
+ croak $@ if $@; |
|
346 | 338 |
|
347 | 339 |
# Cache query |
348 | 340 |
$self->cache_method->($self, $source, |
... | ... |
@@ -368,23 +360,15 @@ sub execute{ |
368 | 360 |
|
369 | 361 |
# Check arguments |
370 | 362 |
foreach my $name (keys %args) { |
371 |
- croak "\"$name\" is invalid name" |
|
363 |
+ croak qq{"$name" is invalid name} |
|
372 | 364 |
unless $VALID_EXECUTE_ARGS{$name}; |
373 | 365 |
} |
374 | 366 |
|
375 | 367 |
my $params = $args{param} || {}; |
376 | 368 |
|
377 | 369 |
# First argument is SQL template |
378 |
- unless (ref $query eq 'DBIx::Custom::Query') { |
|
379 |
- my $source; |
|
380 |
- |
|
381 |
- if (ref $query eq 'ARRAY') { |
|
382 |
- $source = $query->[0]; |
|
383 |
- } |
|
384 |
- else { $source = $query } |
|
385 |
- |
|
386 |
- $query = $self->build_query($source); |
|
387 |
- } |
|
370 |
+ $query = $self->build_query($query) |
|
371 |
+ unless ref $query; |
|
388 | 372 |
|
389 | 373 |
my $filter = $args{filter} || $query->filter || {}; |
390 | 374 |
|
... | ... |
@@ -421,7 +405,7 @@ sub _build_bind_values { |
421 | 405 |
my $count = {}; |
422 | 406 |
foreach my $column (@{$query->columns}) { |
423 | 407 |
|
424 |
- croak "\"$column\" is not exists in params" |
|
408 |
+ croak qq{"$column" is not exists in params} |
|
425 | 409 |
unless exists $params->{$column}; |
426 | 410 |
|
427 | 411 |
# Value |
... | ... |
@@ -443,7 +427,7 @@ sub _build_bind_values { |
443 | 427 |
} |
444 | 428 |
else { |
445 | 429 |
my $filters = $self->filters; |
446 |
- croak "Not exists filter \"$fname\"" |
|
430 |
+ croak qq{Not exists filter "$fname"} |
|
447 | 431 |
unless exists $filters->{$fname}; |
448 | 432 |
$filter_func = $filters->{$fname}; |
449 | 433 |
} |
... | ... |
@@ -5,8 +5,6 @@ use warnings; |
5 | 5 |
|
6 | 6 |
use base 'DBIx::Custom'; |
7 | 7 |
|
8 |
-use Carp 'croak'; |
|
9 |
- |
|
10 | 8 |
__PACKAGE__->attr([qw/database host port/]); |
11 | 9 |
|
12 | 10 |
sub connect { |
... | ... |
@@ -12,13 +12,13 @@ use DBIx::Custom::QueryBuilder::TagProcessor; |
12 | 12 |
__PACKAGE__->dual_attr('tag_processors', default => sub { {} }, inherit => 'hash_copy'); |
13 | 13 |
__PACKAGE__->register_tag_processor( |
14 | 14 |
'?' => \&DBIx::Custom::QueryBuilder::TagProcessors::expand_placeholder_tag, |
15 |
- '=' => \&DBIx::Custom::QueryBuilder::TagProcessors::expand_basic_tag, |
|
16 |
- '<>' => \&DBIx::Custom::QueryBuilder::TagProcessors::expand_basic_tag, |
|
17 |
- '>' => \&DBIx::Custom::QueryBuilder::TagProcessors::expand_basic_tag, |
|
18 |
- '<' => \&DBIx::Custom::QueryBuilder::TagProcessors::expand_basic_tag, |
|
19 |
- '>=' => \&DBIx::Custom::QueryBuilder::TagProcessors::expand_basic_tag, |
|
20 |
- '<=' => \&DBIx::Custom::QueryBuilder::TagProcessors::expand_basic_tag, |
|
21 |
- 'like' => \&DBIx::Custom::QueryBuilder::TagProcessors::expand_basic_tag, |
|
15 |
+ '=' => \&DBIx::Custom::QueryBuilder::TagProcessors::expand_equal_tag, |
|
16 |
+ '<>' => \&DBIx::Custom::QueryBuilder::TagProcessors::expand_not_equal_tag, |
|
17 |
+ '>' => \&DBIx::Custom::QueryBuilder::TagProcessors::expand_greater_than_tag, |
|
18 |
+ '<' => \&DBIx::Custom::QueryBuilder::TagProcessors::expand_lower_than_tag, |
|
19 |
+ '>=' => \&DBIx::Custom::QueryBuilder::TagProcessors::expand_greater_than_equal_tag, |
|
20 |
+ '<=' => \&DBIx::Custom::QueryBuilder::TagProcessors::expand_lower_than_equal_tag, |
|
21 |
+ 'like' => \&DBIx::Custom::QueryBuilder::TagProcessors::expand_like_tag, |
|
22 | 22 |
'in' => \&DBIx::Custom::QueryBuilder::TagProcessors::expand_in_tag, |
23 | 23 |
'insert' => \&DBIx::Custom::QueryBuilder::TagProcessors::expand_insert_tag, |
24 | 24 |
'update' => \&DBIx::Custom::QueryBuilder::TagProcessors::expand_update_tag |
... | ... |
@@ -29,26 +29,29 @@ __PACKAGE__->attr(tag_end => '}'); |
29 | 29 |
|
30 | 30 |
__PACKAGE__->attr('tag_syntax' => <<'EOS'); |
31 | 31 |
[tag] [expand] |
32 |
-{? name} ? |
|
33 |
-{= name} name = ? |
|
34 |
-{<> name} name <> ? |
|
32 |
+{? NAME} ? |
|
33 |
+{= NAME} NAME = ? |
|
34 |
+{<> NAME} NAME <> ? |
|
35 | 35 |
|
36 |
-{< name} name < ? |
|
37 |
-{> name} name > ? |
|
38 |
-{>= name} name >= ? |
|
39 |
-{<= name} name <= ? |
|
36 |
+{< NAME} NAME < ? |
|
37 |
+{> NAME} NAME > ? |
|
38 |
+{>= NAME} NAME >= ? |
|
39 |
+{<= NAME} NAME <= ? |
|
40 | 40 |
|
41 |
-{like name} name like ? |
|
42 |
-{in name number} name in [?, ?, ..] |
|
41 |
+{like NAME} NAME like ? |
|
42 |
+{in NAME number} NAME in [?, ?, ..] |
|
43 | 43 |
|
44 |
-{insert key1 key2} (key1, key2) values (?, ?) |
|
45 |
-{update key1 key2} set key1 = ?, key2 = ? |
|
44 |
+{insert NAME1 NAME2} (NAME1, NAME2) values (?, ?) |
|
45 |
+{update NAME1 NAME2} set NAME1 = ?, NAME2 = ? |
|
46 | 46 |
EOS |
47 | 47 |
|
48 | 48 |
sub register_tag_processor { |
49 | 49 |
my $self = shift; |
50 |
+ |
|
51 |
+ # Merge |
|
50 | 52 |
my $tag_processors = ref $_[0] eq 'HASH' ? $_[0] : {@_}; |
51 | 53 |
$self->tag_processors({%{$self->tag_processors}, %{$tag_processors}}); |
54 |
+ |
|
52 | 55 |
return $self; |
53 | 56 |
} |
54 | 57 |
|
... | ... |
@@ -67,9 +70,6 @@ sub build_query { |
67 | 70 |
sub _parse { |
68 | 71 |
my ($self, $source) = @_; |
69 | 72 |
|
70 |
- if (ref $source eq 'ARRAY') { |
|
71 |
- $source = $source->[1]; |
|
72 |
- } |
|
73 | 73 |
$source ||= ''; |
74 | 74 |
|
75 | 75 |
my $tree = []; |
... | ... |
@@ -99,17 +99,18 @@ sub _parse { |
99 | 99 |
# Tag processor is exist? |
100 | 100 |
unless ($self->tag_processors->{$tag_name}) { |
101 | 101 |
my $tag_syntax = $self->tag_syntax; |
102 |
- croak("Tag '{$tag}' is not registerd.\n\n" . |
|
102 |
+ croak qq{Tag "{$tag}" is not registerd.\n\n} . |
|
103 | 103 |
"<SQL builder syntax>\n" . |
104 | 104 |
"$tag_syntax\n" . |
105 | 105 |
"<Your source>\n" . |
106 |
- "$original\n\n"); |
|
106 |
+ "$original\n\n"; |
|
107 | 107 |
} |
108 | 108 |
|
109 | 109 |
# Check tag arguments |
110 | 110 |
foreach my $tag_arg (@tag_args) { |
111 |
+ |
|
111 | 112 |
# Cannot cantain placehosder '?' |
112 |
- croak("Tag '{t }' arguments cannot contain '?'") |
|
113 |
+ croak qq{Tag cannot contain "?"} |
|
113 | 114 |
if $tag_arg =~ /\?/; |
114 | 115 |
} |
115 | 116 |
|
... | ... |
@@ -130,7 +131,7 @@ sub _build_query { |
130 | 131 |
# SQL |
131 | 132 |
my $sql = ''; |
132 | 133 |
|
133 |
- # All parameter key infomation |
|
134 |
+ # All Columns |
|
134 | 135 |
my $all_columns = []; |
135 | 136 |
|
136 | 137 |
# Build SQL |
... | ... |
@@ -154,22 +155,21 @@ sub _build_query { |
154 | 155 |
my $tag_processor = $self->tag_processors->{$tag_name}; |
155 | 156 |
|
156 | 157 |
# Tag processor is code ref? |
157 |
- croak("Tag processor '$tag_name' must be code reference") |
|
158 |
+ croak qq{Tag processor "$tag_name" must be code reference} |
|
158 | 159 |
unless ref $tag_processor eq 'CODE'; |
159 | 160 |
|
160 | 161 |
# Expand tag using tag processor |
161 |
- my ($expand, $columns) = $tag_processor->($tag_name, $tag_args); |
|
162 |
+ my ($expand, $columns) = @{$tag_processor->($tag_args)}; |
|
162 | 163 |
|
163 | 164 |
# Check tag processor return value |
164 |
- croak("Tag processor '$tag_name' must return (\$expand, \$columns)") |
|
165 |
+ croak qq{Tag processor "$tag_name" must return [\$expand, \$columns]} |
|
165 | 166 |
if !defined $expand || ref $columns ne 'ARRAY'; |
166 | 167 |
|
167 | 168 |
# Check placeholder count |
168 |
- croak("Placeholder count in SQL created by tag processor '$tag_name' " . |
|
169 |
- "must be same as key informations count") |
|
169 |
+ croak qq{Count of Placeholder must be same as count of columns in "$tag_name"} |
|
170 | 170 |
unless $self->_placeholder_count($expand) eq @$columns; |
171 | 171 |
|
172 |
- # Add key information |
|
172 |
+ # Add columns |
|
173 | 173 |
push @$all_columns, @$columns; |
174 | 174 |
|
175 | 175 |
# Join expand tag to SQL |
... | ... |
@@ -188,8 +188,9 @@ sub _build_query { |
188 | 188 |
|
189 | 189 |
sub _placeholder_count { |
190 | 190 |
my ($self, $expand) = @_; |
191 |
- $expand ||= ''; |
|
192 | 191 |
|
192 |
+ # Count |
|
193 |
+ $expand ||= ''; |
|
193 | 194 |
my $count = 0; |
194 | 195 |
my $pos = -1; |
195 | 196 |
while (($pos = index($expand, '?', $pos + 1)) != -1) { |
... | ... |
@@ -6,53 +6,51 @@ use warnings; |
6 | 6 |
use Carp 'croak'; |
7 | 7 |
|
8 | 8 |
sub expand_basic_tag { |
9 |
- my ($tag_name, $tag_args) = @_; |
|
9 |
+ my ($name, $args) = @_; |
|
10 | 10 |
|
11 |
- # Key |
|
12 |
- my $column = $tag_args->[0]; |
|
11 |
+ # Column |
|
12 |
+ my $column = $args->[0]; |
|
13 | 13 |
|
14 |
- # Key is not exist |
|
15 |
- croak("You must be pass key as argument to tag '{$tag_name }'") |
|
14 |
+ # Check arguments |
|
15 |
+ croak qq{Column must be specified in tag "{$name }"} |
|
16 | 16 |
unless $column; |
17 | 17 |
|
18 |
- # Expand |
|
19 |
- return ("$column $tag_name ?", [$column]); |
|
18 |
+ return ["$column $name ?", [$column]]; |
|
20 | 19 |
} |
21 | 20 |
|
21 |
+sub expand_equal_tag { expand_basic_tag('=', @_) } |
|
22 |
+sub expand_not_equal_tag { expand_basic_tag('<>', @_) } |
|
23 |
+sub expand_greater_than_tag { expand_basic_tag('>', @_) } |
|
24 |
+sub expand_lower_than_tag { expand_basic_tag('<', @_) } |
|
25 |
+sub expand_greater_than_equal_tag { expand_basic_tag('>=', @_) } |
|
26 |
+sub expand_lower_than_equal_tag { expand_basic_tag('<=', @_) } |
|
27 |
+sub expand_like_tag { expand_basic_tag('like', @_) } |
|
28 |
+ |
|
22 | 29 |
sub expand_placeholder_tag { |
23 |
- my ($tag_name, $tag_args) = @_; |
|
30 |
+ my $tag_args = shift; |
|
24 | 31 |
|
25 |
- # Key |
|
32 |
+ # Column |
|
26 | 33 |
my $column = $tag_args->[0]; |
27 | 34 |
|
28 |
- # Key is not exist |
|
29 |
- croak("You must be pass key as argument to tag '{$tag_name }'") |
|
35 |
+ # Check arguments |
|
36 |
+ croak qq{Column must be specified in tag "{? }"} |
|
30 | 37 |
unless $column; |
31 | 38 |
|
32 |
- # Expand |
|
33 |
- return ('?', [$column]); |
|
39 |
+ return ['?', [$column]]; |
|
34 | 40 |
} |
35 | 41 |
|
36 | 42 |
sub expand_in_tag { |
37 |
- my ($tag_name, $tag_args) = @_; |
|
38 |
- my ($column, $count) = @$tag_args; |
|
43 |
+ my ($column, $count) = @{$_[0]}; |
|
39 | 44 |
|
40 |
- # Key must be specified |
|
41 |
- croak("You must be pass key as first argument of tag '{in }'\n" . |
|
42 |
- "Usage: {in \$key \$count}") |
|
43 |
- unless $column; |
|
44 |
- |
|
45 |
- # Place holder count must be specified |
|
46 |
- croak("You must be pass value count as second argument of tag '{in }'\n" . |
|
47 |
- "Usage: {in \$key \$count}") |
|
48 |
- if !$count || $count =~ /\D/; |
|
45 |
+ # Check arguments |
|
46 |
+ croak qq{Column and count of values must be specified in tag "{in }"} |
|
47 |
+ unless $column && $count && $count =~ /^\d+$/; |
|
49 | 48 |
|
50 |
- # Expand tag |
|
51 |
- my $expand = "$column $tag_name ("; |
|
49 |
+ # Expand |
|
50 |
+ my $expand = "$column in ("; |
|
52 | 51 |
for (my $i = 0; $i < $count; $i++) { |
53 | 52 |
$expand .= '?, '; |
54 | 53 |
} |
55 |
- |
|
56 | 54 |
$expand =~ s/, $//; |
57 | 55 |
$expand .= ')'; |
58 | 56 |
|
... | ... |
@@ -60,57 +58,34 @@ sub expand_in_tag { |
60 | 58 |
my $columns = []; |
61 | 59 |
push @$columns, $column for (0 .. $count - 1); |
62 | 60 |
|
63 |
- return ($expand, $columns); |
|
61 |
+ return [$expand, $columns]; |
|
64 | 62 |
} |
65 | 63 |
|
66 | 64 |
sub expand_insert_tag { |
67 |
- my ($tag_name, $columns) = @_; |
|
68 |
- |
|
69 |
- # Insert key (k1, k2, k3, ..) |
|
70 |
- my $insert_keys = '('; |
|
71 |
- |
|
72 |
- # placeholder (?, ?, ?, ..) |
|
73 |
- my $place_holders = '('; |
|
74 |
- |
|
75 |
- foreach my $column (@$columns) { |
|
76 |
- |
|
77 |
- # Join insert column |
|
78 |
- $insert_keys .= "$column, "; |
|
79 |
- |
|
80 |
- # Join place holder |
|
81 |
- $place_holders .= "?, "; |
|
82 |
- } |
|
83 |
- |
|
84 |
- # Delete last ', ' |
|
85 |
- $insert_keys =~ s/, $//; |
|
86 |
- |
|
87 |
- # Close |
|
88 |
- $insert_keys .= ')'; |
|
89 |
- $place_holders =~ s/, $//; |
|
90 |
- $place_holders .= ')'; |
|
65 |
+ my $columns = shift; |
|
91 | 66 |
|
92 |
- # Expand tag |
|
93 |
- my $expand = "$insert_keys values $place_holders"; |
|
67 |
+ # Insert |
|
68 |
+ my $expand = '('; |
|
69 |
+ $expand .= "$_, " for @$columns; |
|
70 |
+ $expand =~ s/, $//; |
|
71 |
+ $expand .= ') '; |
|
72 |
+ $expand .= 'values ('; |
|
73 |
+ $expand .= "?, " for @$columns; |
|
74 |
+ $expand =~ s/, $//; |
|
75 |
+ $expand .= ')'; |
|
94 | 76 |
|
95 |
- return ($expand, [@$columns]); |
|
77 |
+ return [$expand, [@$columns]]; |
|
96 | 78 |
} |
97 | 79 |
|
98 | 80 |
sub expand_update_tag { |
99 |
- my ($tag_name, $columns) = @_; |
|
81 |
+ my $columns = shift; |
|
100 | 82 |
|
101 |
- # Expanded tag |
|
83 |
+ # Update |
|
102 | 84 |
my $expand = 'set '; |
103 |
- |
|
104 |
- foreach my $column (@$columns) { |
|
105 |
- |
|
106 |
- # Join key and placeholder |
|
107 |
- $expand .= "$column = ?, "; |
|
108 |
- } |
|
109 |
- |
|
110 |
- # Delete last ', ' |
|
85 |
+ $expand .= "$_ = ?, " for @$columns; |
|
111 | 86 |
$expand =~ s/, $//; |
112 | 87 |
|
113 |
- return ($expand, [@$columns]); |
|
88 |
+ return [$expand, [@$columns]]; |
|
114 | 89 |
} |
115 | 90 |
|
116 | 91 |
1; |
... | ... |
@@ -123,6 +98,20 @@ DBIx::Custom::SQLBuilder::TagProcessors - Tag processor |
123 | 98 |
|
124 | 99 |
=head2 C<expand_basic_tag> |
125 | 100 |
|
101 |
+=head2 C<expand_equal_tag> |
|
102 |
+ |
|
103 |
+=head2 C<expand_not_equal_tag> |
|
104 |
+ |
|
105 |
+=head2 C<expand_greater_than_tag> |
|
106 |
+ |
|
107 |
+=head2 C<expand_lower_than_tag> |
|
108 |
+ |
|
109 |
+=head2 C<expand_greater_than_equal_tag> |
|
110 |
+ |
|
111 |
+=head2 C<expand_lower_than_equal_tag> |
|
112 |
+ |
|
113 |
+=head2 C<expand_like_tag> |
|
114 |
+ |
|
126 | 115 |
=head2 C<expand_in_tag> |
127 | 116 |
|
128 | 117 |
=head2 C<expand_insert_tag> |
... | ... |
@@ -10,29 +10,29 @@ use Carp 'croak'; |
10 | 10 |
__PACKAGE__->attr([qw/sth filters default_filter filter/]); |
11 | 11 |
|
12 | 12 |
sub fetch { |
13 |
- |
|
14 |
- $_[0]->{filters} ||= {}; |
|
15 |
- $_[0]->{filter} ||= {}; |
|
13 |
+ my $self = shift; |
|
14 |
+ |
|
15 |
+ $self->{filters} ||= {}; |
|
16 |
+ $self->{filter} ||= {}; |
|
16 | 17 |
|
17 | 18 |
# Fetch |
18 |
- my @row = $_[0]->{sth}->fetchrow_array; |
|
19 |
+ my @row = $self->{sth}->fetchrow_array; |
|
19 | 20 |
|
20 | 21 |
# Cannot fetch |
21 | 22 |
return unless @row; |
22 | 23 |
|
23 | 24 |
# Filter |
24 |
- for (my $i = 0; $i < @{$_[0]->{sth}->{NAME_lc}}; $i++) { |
|
25 |
- my $fname = $_[0]->{filter}->{$_[0]->{sth}->{NAME_lc}->[$i]} |
|
26 |
- || $_[0]->{default_filter}; |
|
25 |
+ for (my $i = 0; $i < @{$self->{sth}->{NAME_lc}}; $i++) { |
|
27 | 26 |
|
28 |
- croak "Filter \"$fname\" is not registered." |
|
29 |
- if $fname && ! exists $_[0]->{filters}->{$fname}; |
|
27 |
+ # Filter name |
|
28 |
+ my $column = $self->{sth}->{NAME_lc}->[$i]; |
|
29 |
+ my $fname = exists $self->{filter}->{$column} |
|
30 |
+ ? $self->{filter}->{$column} |
|
31 |
+ : $self->{default_filter}; |
|
30 | 32 |
|
31 |
- next unless $fname; |
|
32 |
- |
|
33 |
- $row[$i] = ref $fname |
|
34 |
- ? $fname->($row[$i]) |
|
35 |
- : $_[0]->{filters}->{$fname}->($row[$i]); |
|
33 |
+ # Filter |
|
34 |
+ $row[$i] = $self->{filters}->{$fname}->($row[$i]) |
|
35 |
+ if $fname; |
|
36 | 36 |
} |
37 | 37 |
|
38 | 38 |
return \@row; |
... | ... |
@@ -57,7 +57,7 @@ sub fetch_multi { |
57 | 57 |
my ($self, $count) = @_; |
58 | 58 |
|
59 | 59 |
# Not specified Row count |
60 |
- croak("Row count must be specified") |
|
60 |
+ croak 'Row count must be specified' |
|
61 | 61 |
unless $count; |
62 | 62 |
|
63 | 63 |
# Fetch multi rows |
... | ... |
@@ -86,30 +86,31 @@ sub fetch_all { |
86 | 86 |
} |
87 | 87 |
|
88 | 88 |
sub fetch_hash { |
89 |
- |
|
90 |
- $_[0]->{filters} ||= {}; |
|
91 |
- $_[0]->{filter} ||= {}; |
|
89 |
+ my $self = shift; |
|
90 |
+ |
|
91 |
+ $self->{filters} ||= {}; |
|
92 |
+ $self->{filter} ||= {}; |
|
92 | 93 |
|
93 | 94 |
# Fetch |
94 |
- my $row = $_[0]->{sth}->fetchrow_arrayref; |
|
95 |
+ my $row = $self->{sth}->fetchrow_arrayref; |
|
95 | 96 |
|
96 | 97 |
# Cannot fetch |
97 | 98 |
return unless $row; |
98 | 99 |
|
99 | 100 |
# Filter |
100 | 101 |
my $row_hash = {}; |
101 |
- for (my $i = 0; $i < @{$_[0]->{sth}->{NAME_lc}}; $i++) { |
|
102 |
+ for (my $i = 0; $i < @{$self->{sth}->{NAME_lc}}; $i++) { |
|
102 | 103 |
|
103 |
- my $fname = $_[0]->{filter}->{$_[0]->{sth}->{NAME_lc}->[$i]} |
|
104 |
- || $_[0]->{default_filter}; |
|
104 |
+ # Filter name |
|
105 |
+ my $column = $self->{sth}->{NAME_lc}->[$i]; |
|
106 |
+ my $fname = exists $self->{filter}->{$column} |
|
107 |
+ ? $self->{filter}->{$column} |
|
108 |
+ : $self->{default_filter}; |
|
105 | 109 |
|
106 |
- croak "Filter \"$fname\" is not registered." |
|
107 |
- if $fname && ! exists $_[0]->{filters}->{$fname}; |
|
108 |
- |
|
109 |
- $row_hash->{$_[0]->{sth}->{NAME_lc}->[$i]} |
|
110 |
- = !$fname ? $row->[$i] : |
|
111 |
- ref $fname ? $fname->($row->[$i]) : |
|
112 |
- $_[0]->{filters}->{$fname}->($row->[$i]); |
|
110 |
+ # Filter |
|
111 |
+ $row_hash->{$column} |
|
112 |
+ = $fname ? $self->{filters}->{$fname}->($row->[$i]) |
|
113 |
+ : $row->[$i]; |
|
113 | 114 |
} |
114 | 115 |
|
115 | 116 |
return $row_hash; |
... | ... |
@@ -134,7 +135,7 @@ sub fetch_hash_multi { |
134 | 135 |
my ($self, $count) = @_; |
135 | 136 |
|
136 | 137 |
# Not specified Row count |
137 |
- croak("Row count must be specified") |
|
138 |
+ croak 'Row count must be specified' |
|
138 | 139 |
unless $count; |
139 | 140 |
|
140 | 141 |
# Fetch multi rows |
... | ... |
@@ -159,6 +160,7 @@ sub fetch_hash_all { |
159 | 160 |
while(my $row = $self->fetch_hash) { |
160 | 161 |
push @$rows, $row; |
161 | 162 |
} |
163 |
+ |
|
162 | 164 |
return $rows; |
163 | 165 |
} |
164 | 166 |
|
... | ... |
@@ -5,8 +5,6 @@ use warnings; |
5 | 5 |
|
6 | 6 |
use base 'DBIx::Custom'; |
7 | 7 |
|
8 |
-use Carp 'croak'; |
|
9 |
- |
|
10 | 8 |
__PACKAGE__->attr('database'); |
11 | 9 |
|
12 | 10 |
sub connect { |
... | ... |
@@ -227,6 +227,10 @@ $dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2}, append => ' ' |
227 | 227 |
$rows = $dbi->select(table => 'table1')->fetch_hash_all; |
228 | 228 |
is_deeply($rows, [{key1 => 1, key2 => 2}], 'insert append'); |
229 | 229 |
|
230 |
+eval{$dbi->insert(table => 'table1', noexist => 1)}; |
|
231 |
+like($@, qr/noexist/, "$test: invalid name"); |
|
232 |
+ |
|
233 |
+ |
|
230 | 234 |
test 'update'; |
231 | 235 |
$dbi = DBIx::Custom->connect($NEW_ARGS->{0}); |
232 | 236 |
$dbi->execute($CREATE_TABLE->{1}); |
... | ... |
@@ -261,9 +265,15 @@ is_deeply($rows, [{key1 => 1, key2 => 22, key3 => 3, key4 => 4, key5 => 5}, |
261 | 265 |
{key1 => 6, key2 => 7, key3 => 8, key4 => 9, key5 => 10}], |
262 | 266 |
"$test : filter"); |
263 | 267 |
|
264 |
- |
|
265 | 268 |
$result = $dbi->update(table => 'table1', param => {key2 => 11}, where => {key1 => 1}, append => ' '); |
266 | 269 |
|
270 |
+eval{$dbi->update(table => 'table1', noexist => 1)}; |
|
271 |
+like($@, qr/noexist/, "$test: invalid name"); |
|
272 |
+ |
|
273 |
+eval{$dbi->update(table => 'table1')}; |
|
274 |
+like($@, qr/where/, "$test: not contain where"); |
|
275 |
+ |
|
276 |
+ |
|
267 | 277 |
test 'update_all'; |
268 | 278 |
$dbi = DBIx::Custom->connect($NEW_ARGS->{0}); |
269 | 279 |
$dbi->execute($CREATE_TABLE->{1}); |
... | ... |
@@ -306,11 +316,15 @@ $dbi->delete(table => 'table1', where => {key1 => 1, key2 => 2}); |
306 | 316 |
$rows = $dbi->select(table => 'table1')->fetch_hash_all; |
307 | 317 |
is_deeply($rows, [{key1 => 3, key2 => 4}], "$test : delete multi key"); |
308 | 318 |
|
319 |
+eval{$dbi->delete(table => 'table1', noexist => 1)}; |
|
320 |
+like($@, qr/noexist/, "$test: invalid name"); |
|
321 |
+ |
|
322 |
+ |
|
309 | 323 |
test 'delete error'; |
310 | 324 |
$dbi = DBIx::Custom->connect($NEW_ARGS->{0}); |
311 | 325 |
$dbi->execute($CREATE_TABLE->{0}); |
312 | 326 |
eval{$dbi->delete(table => 'table1')}; |
313 |
-like($@, qr/Key-value pairs for where clause must be specified to 'delete' second argument/, |
|
327 |
+like($@, qr/Key-value pairs for where clause must be specified to "delete" second argument/, |
|
314 | 328 |
"$test : where key-value pairs not specified"); |
315 | 329 |
|
316 | 330 |
test 'delete_all'; |
... | ... |
@@ -367,6 +381,10 @@ $rows = $dbi->select( |
367 | 381 |
)->fetch_hash_all; |
368 | 382 |
is_deeply($rows, [{table1_key1 => 1, table2_key1 => 1, key2 => 2, key3 => 5}], "$test : relation : no exists where"); |
369 | 383 |
|
384 |
+eval{$dbi->select(table => 'table1', noexist => 1)}; |
|
385 |
+like($@, qr/noexist/, "$test: invalid name"); |
|
386 |
+ |
|
387 |
+ |
|
370 | 388 |
test 'fetch filter'; |
371 | 389 |
$dbi = DBIx::Custom->connect($NEW_ARGS->{0}); |
372 | 390 |
$dbi->register_filter( |
... | ... |
@@ -425,3 +443,4 @@ $dbi->cache(0); |
425 | 443 |
$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2}); |
426 | 444 |
is(scalar keys %{$dbi->{_cached}}, 0, 'not cache'); |
427 | 445 |
|
446 |
+ |
... | ... |
@@ -100,3 +100,7 @@ test 'register_filters'; |
100 | 100 |
$dbi = DBIx::Custom->new; |
101 | 101 |
$dbi->register_filter(a => sub {1}); |
102 | 102 |
is($dbi->filters->{a}->(), 1, $test); |
103 |
+$dbi->register_filter({b => sub {2}}); |
|
104 |
+is($dbi->filters->{b}->(), 2, $test); |
|
105 |
+ |
|
106 |
+ |