... | ... |
@@ -179,7 +179,7 @@ sub create_query { |
179 | 179 |
|
180 | 180 |
my $table = ''; |
181 | 181 |
if (ref $template eq 'ARRAY') { |
182 |
- $table = $template->[0]; |
|
182 |
+ $table = $template->[0] if $template->[0]; |
|
183 | 183 |
$template = $template->[1]; |
184 | 184 |
} |
185 | 185 |
|
... | ... |
@@ -198,10 +198,11 @@ sub create_query { |
198 | 198 |
); |
199 | 199 |
} |
200 | 200 |
else { |
201 |
- $query = eval{$sql_tmpl->create_query([$table , $template])}; |
|
201 |
+ $sql_tmpl->table($table); |
|
202 |
+ $query = eval{$sql_tmpl->create_query($template)}; |
|
202 | 203 |
croak($@) if $@; |
203 | 204 |
|
204 |
- $class->_add_query_cache($template, $query); |
|
205 |
+ $class->_add_query_cache("$table$template", $query); |
|
205 | 206 |
} |
206 | 207 |
|
207 | 208 |
# Connect if not |
... | ... |
@@ -229,14 +230,21 @@ sub create_query { |
229 | 230 |
} |
230 | 231 |
|
231 | 232 |
sub query{ |
232 |
- my ($self, $query, $params) = @_; |
|
233 |
+ my ($self, $query, $params, $query_edit_cb) = @_; |
|
233 | 234 |
$params ||= {}; |
234 | 235 |
|
235 | 236 |
# First argument is SQL template |
236 |
- if (!ref $query) { |
|
237 |
- my $template = $query; |
|
238 |
- $query = $self->create_query($template); |
|
239 |
- my $query_edit_cb = $_[3]; |
|
237 |
+ unless (ref $query eq 'DBIx::Custom::Query') { |
|
238 |
+ my $table; |
|
239 |
+ my $template; |
|
240 |
+ |
|
241 |
+ if (ref $query eq 'ARRAY') { |
|
242 |
+ $table = $query->[0]; |
|
243 |
+ $template = $query->[1]; |
|
244 |
+ } |
|
245 |
+ else { $template = $query } |
|
246 |
+ |
|
247 |
+ $query = $self->create_query([$table, $template]); |
|
240 | 248 |
$query_edit_cb->($query) if ref $query_edit_cb eq 'CODE'; |
241 | 249 |
} |
242 | 250 |
|
... | ... |
@@ -279,112 +287,32 @@ sub query{ |
279 | 287 |
|
280 | 288 |
sub _build_bind_values { |
281 | 289 |
my ($self, $query, $params) = @_; |
282 |
- my $key_infos = $query->key_infos; |
|
283 |
- my $bind_filter = $query->bind_filter; |
|
284 |
- my $no_bind_filters = $query->_no_bind_filters || {}; |
|
290 |
+ my $key_infos = $query->key_infos; |
|
291 |
+ my $filter = $query->bind_filter; |
|
285 | 292 |
|
286 | 293 |
# binding values |
287 | 294 |
my @bind_values; |
288 | 295 |
|
289 |
- # Create bind values |
|
290 |
- KEY_INFOS : |
|
296 |
+ # Build bind values |
|
291 | 297 |
foreach my $key_info (@$key_infos) { |
292 |
- # Set variable |
|
293 |
- my $access_keys = $key_info->{access_keys}; |
|
294 |
- my $original_key = $key_info->{original_key} || ''; |
|
295 |
- my $table = $key_info->{table} || ''; |
|
296 |
- my $column = $key_info->{column} || ''; |
|
298 |
+ my $table = $key_info->table; |
|
299 |
+ my $column = $key_info->column; |
|
300 |
+ my $id = $key_info->id; |
|
301 |
+ my $pos = $key_info->pos; |
|
297 | 302 |
|
298 |
- # Key is found? |
|
299 |
- my $found; |
|
303 |
+ # Value |
|
304 |
+ my $value = $id && $pos ? $params->{$id}->{$column}->[$pos] |
|
305 |
+ : $id ? $params->{$id}->{$column} |
|
306 |
+ : $pos ? $params->{$column}->[$pos] |
|
307 |
+ : $params->{$column}; |
|
300 | 308 |
|
301 |
- # Build bind values |
|
302 |
- ACCESS_KEYS : |
|
303 |
- foreach my $access_key (@$access_keys) { |
|
304 |
- # Root parameter |
|
305 |
- my $root_params = $params; |
|
306 |
- |
|
307 |
- # Search corresponding value |
|
308 |
- for (my $i = 0; $i < @$access_key; $i++) { |
|
309 |
- # Current key |
|
310 |
- my $current_key = $access_key->[$i]; |
|
311 |
- |
|
312 |
- # Last key |
|
313 |
- if ($i == @$access_key - 1) { |
|
314 |
- # Key is array reference |
|
315 |
- if (ref $current_key eq 'ARRAY') { |
|
316 |
- push @bind_values, |
|
317 |
- $self->_filter($root_params->[$current_key->[0]], |
|
318 |
- $key_info, $query); |
|
319 |
- } |
|
320 |
- # Key is string |
|
321 |
- else { |
|
322 |
- # Key is not found |
|
323 |
- next ACCESS_KEYS |
|
324 |
- unless exists $root_params->{$current_key}; |
|
325 |
- |
|
326 |
- push @bind_values, |
|
327 |
- $self->_filter($root_params->{$current_key}, |
|
328 |
- $key_info, $query); |
|
329 |
- } |
|
330 |
- |
|
331 |
- # Key is found |
|
332 |
- $found = 1; |
|
333 |
- next KEY_INFOS; |
|
334 |
- } |
|
335 |
- # First or middle key |
|
336 |
- else { |
|
337 |
- # Key is array reference |
|
338 |
- if (ref $current_key eq 'ARRAY') { |
|
339 |
- # Go next key |
|
340 |
- $root_params = $root_params->[$current_key->[0]]; |
|
341 |
- } |
|
342 |
- # Key is string |
|
343 |
- else { |
|
344 |
- # Not found |
|
345 |
- next ACCESS_KEYS |
|
346 |
- unless exists $root_params->{$current_key}; |
|
347 |
- |
|
348 |
- # Go next key |
|
349 |
- $root_params = $root_params->{$current_key}; |
|
350 |
- } |
|
351 |
- } |
|
352 |
- } |
|
353 |
- } |
|
354 |
- |
|
355 |
- # Key is not found |
|
356 |
- unless ($found) { |
|
357 |
- require Data::Dumper; |
|
358 |
- my $key_info_dump = Data::Dumper->Dump([$key_info], ['*key_info']); |
|
359 |
- my $params_dump = Data::Dumper->Dump([$params], ['*params']); |
|
360 |
- croak("Corresponding key is not found in your parameters\n" . |
|
361 |
- "<Key information>\n$key_info_dump\n\n" . |
|
362 |
- "<Your parameters>\n$params_dump\n"); |
|
363 |
- } |
|
364 |
- } |
|
365 |
- return \@bind_values; |
|
366 |
-} |
|
367 |
- |
|
368 |
-sub _filter { |
|
369 |
- my ($self, $value, $key_info, $query) = @_; |
|
370 |
- |
|
371 |
- my $bind_filter = $query->bind_filter; |
|
372 |
- my $no_bind_filters = $query->_no_bind_filters || {}; |
|
373 |
- |
|
374 |
- my $original_key = $key_info->{original_key} || ''; |
|
375 |
- my $table = $key_info->{table} || ''; |
|
376 |
- my $column = $key_info->{column} || ''; |
|
377 |
- |
|
378 |
- # Filtering |
|
379 |
- if ($bind_filter && |
|
380 |
- !$no_bind_filters->{$original_key}) |
|
381 |
- { |
|
382 |
- return $bind_filter->($value, $original_key, $self, |
|
383 |
- {table => $table, column => $column}); |
|
309 |
+ # Filter |
|
310 |
+ push @bind_values, |
|
311 |
+ $filter ? $filter->($value, $table, $column, $self->filters) |
|
312 |
+ : $value; |
|
384 | 313 |
} |
385 | 314 |
|
386 |
- # Not filtering |
|
387 |
- return $value; |
|
315 |
+ return \@bind_values; |
|
388 | 316 |
} |
389 | 317 |
|
390 | 318 |
sub transaction { DBIx::Custom::Transaction->new(dbi => shift) } |
... | ... |
@@ -436,7 +364,7 @@ sub insert { |
436 | 364 |
my $template = "insert into $table {insert " . join(' ', @insert_keys) . '}'; |
437 | 365 |
$template .= " $append_statement" if $append_statement; |
438 | 366 |
# Create query |
439 |
- my $query = $self->create_query($template); |
|
367 |
+ my $query = $self->create_query([$table, $template]); |
|
440 | 368 |
|
441 | 369 |
# Query edit callback must be code reference |
442 | 370 |
croak("Query edit callback must be code reference") |
... | ... |
@@ -492,7 +420,7 @@ sub update { |
492 | 420 |
$template .= " $append_statement" if $append_statement; |
493 | 421 |
|
494 | 422 |
# Create query |
495 |
- my $query = $self->create_query($template); |
|
423 |
+ my $query = $self->create_query([$table, $template]); |
|
496 | 424 |
|
497 | 425 |
# Query edit callback must be code reference |
498 | 426 |
croak("Query edit callback must be code reference") |
... | ... |
@@ -553,7 +481,7 @@ sub delete { |
553 | 481 |
$template .= " $append_statement" if $append_statement; |
554 | 482 |
|
555 | 483 |
# Create query |
556 |
- my $query = $self->create_query($template); |
|
484 |
+ my $query = $self->create_query([$table, $template]); |
|
557 | 485 |
|
558 | 486 |
# Query edit callback must be code reference |
559 | 487 |
croak("Query edit callback must be code reference") |
... | ... |
@@ -657,7 +585,7 @@ sub select { |
657 | 585 |
} |
658 | 586 |
|
659 | 587 |
# Create query |
660 |
- my $query = $self->create_query($template); |
|
588 |
+ my $query = $self->create_query([$tables->[0], $template]); |
|
661 | 589 |
|
662 | 590 |
# Query edit |
663 | 591 |
$query_edit_cb->($query) if $query_edit_cb; |
... | ... |
@@ -4,11 +4,12 @@ use warnings; |
4 | 4 |
use strict; |
5 | 5 |
|
6 | 6 |
use base 'DBIx::Custom'; |
7 |
+ |
|
7 | 8 |
use Encode qw/decode encode/; |
8 | 9 |
|
9 | 10 |
__PACKAGE__->add_filter( |
10 |
- encode_utf8 => sub { encode('UTF-8', shift) }, |
|
11 |
- decode_utf8 => sub { decode('UTF-8', shift) } |
|
11 |
+ encode_utf8 => sub { encode('UTF-8', $_[0]) }, |
|
12 |
+ decode_utf8 => sub { decode('UTF-8', $_[0]) } |
|
12 | 13 |
); |
13 | 14 |
|
14 | 15 |
__PACKAGE__->add_format( |
... | ... |
@@ -20,16 +21,6 @@ __PACKAGE__->add_format( |
20 | 21 |
'ISO-8601_time' => '%H:%M:%S', |
21 | 22 |
); |
22 | 23 |
|
23 |
-sub utf8_filter_on { |
|
24 |
- my $self = shift; |
|
25 |
- |
|
26 |
- # Set utf8 filters |
|
27 |
- $self->bind_filter($self->filters->{encode_utf8}); |
|
28 |
- $self->fetch_filter($self->filters->{decode_utf8}); |
|
29 |
- |
|
30 |
- return $self; |
|
31 |
-} |
|
32 |
- |
|
33 | 24 |
1; |
34 | 25 |
|
35 | 26 |
=head1 NAME |
... | ... |
@@ -50,17 +41,6 @@ DBIx::Custom::Basic - DBIx::Custom basic implementation |
50 | 41 |
This class is L<DBIx::Custom> subclass. |
51 | 42 |
You can use all methods of L<DBIx::Custom> |
52 | 43 |
|
53 |
-=head2 utf8_filter_on |
|
54 |
- |
|
55 |
-Encode and decode utf8 filter on |
|
56 |
- |
|
57 |
- $dbi->utf8_filter_on; |
|
58 |
- |
|
59 |
-This equel to |
|
60 |
- |
|
61 |
- $dbi->bind_filter($dbi->filters->{encode_utf8}); |
|
62 |
- $dbi->fetch_filter($dbi->filters->{decode_utf8}); |
|
63 |
- |
|
64 | 44 |
=head1 FILTERS |
65 | 45 |
|
66 | 46 |
=head2 encode_utf8 |
... | ... |
@@ -83,7 +63,7 @@ This filter is generally used as fetch filter |
83 | 63 |
|
84 | 64 |
$dbi->fetch_filter($dbi->filters->{decode_utf8}); |
85 | 65 |
|
86 |
-=head1 DATE FORMATS |
|
66 |
+=head1 FORMATS |
|
87 | 67 |
|
88 | 68 |
strptime formats is available |
89 | 69 |
|
... | ... |
@@ -0,0 +1,82 @@ |
1 |
+package DBIx::Custom::KeyInfo; |
|
2 |
+ |
|
3 |
+use strict; |
|
4 |
+use warnings; |
|
5 |
+ |
|
6 |
+use base 'Object::Simple'; |
|
7 |
+ |
|
8 |
+__PACKAGE__->attr([qw/column id table pos/]); |
|
9 |
+ |
|
10 |
+sub new { |
|
11 |
+ my $self = shift; |
|
12 |
+ |
|
13 |
+ if (@_ == 1) { |
|
14 |
+ $self = $self->SUPER::new; |
|
15 |
+ $self->parse($_[0]); |
|
16 |
+ return $self; |
|
17 |
+ } |
|
18 |
+ |
|
19 |
+ return $self->SUPER::new(@_); |
|
20 |
+} |
|
21 |
+ |
|
22 |
+sub parse { |
|
23 |
+ my ($self, $key) = @_; |
|
24 |
+ |
|
25 |
+ # Parse |
|
26 |
+ ($key || '') =~ /^(?:(.+?)\.)?(.+?)(?:@(.+))?$/; |
|
27 |
+ $self->table($1); |
|
28 |
+ $self->column($2); |
|
29 |
+ $self->id($3); |
|
30 |
+ |
|
31 |
+ return $self; |
|
32 |
+} |
|
33 |
+ |
|
34 |
+1; |
|
35 |
+ |
|
36 |
+=head1 NAME |
|
37 |
+ |
|
38 |
+DBIx::Custom::KeyInfo - DBIx::Custom column |
|
39 |
+ |
|
40 |
+=head1 SYNOPSIS |
|
41 |
+ |
|
42 |
+ # New |
|
43 |
+ my $key_info = DBIx::Custom::KeyInfo->new; |
|
44 |
+ |
|
45 |
+ # Parse |
|
46 |
+ $key_info->parse('books.author@IDxxx'); |
|
47 |
+ |
|
48 |
+ # Attributes |
|
49 |
+ my $name = $key_info->name; |
|
50 |
+ my $table = $key_info->table; |
|
51 |
+ my $id = $key_info->id; |
|
52 |
+ |
|
53 |
+=head1 ATTRIBUTES |
|
54 |
+ |
|
55 |
+=head2 id |
|
56 |
+ |
|
57 |
+ $key_info = $key_info->id($id); |
|
58 |
+ $id = $key_info->id |
|
59 |
+ |
|
60 |
+=head2 name |
|
61 |
+ |
|
62 |
+ $key_info = $key_info->name($name); |
|
63 |
+ $name = $key_info->name |
|
64 |
+ |
|
65 |
+=head2 table |
|
66 |
+ |
|
67 |
+ $key_info = $key_info->table($table); |
|
68 |
+ $table = $key_info->table |
|
69 |
+ |
|
70 |
+=head1 METHODS |
|
71 |
+ |
|
72 |
+=head2 new |
|
73 |
+ |
|
74 |
+ $key_info = DBIx::Custom::KeyInfo->new(\%args); |
|
75 |
+ $key_info = DBIx::Custom::KeyInfo->new(%args); |
|
76 |
+ $key_info = DBIx::Custom::KeyInfo->new('books.author@where'); |
|
77 |
+ |
|
78 |
+=head2 parse |
|
79 |
+ |
|
80 |
+ $key_info->parse('books.author@IDxxx'); |
|
81 |
+ |
|
82 |
+=cut |
... | ... |
@@ -7,6 +7,7 @@ use base 'Object::Simple'; |
7 | 7 |
use Carp 'croak'; |
8 | 8 |
use DBIx::Custom::Query; |
9 | 9 |
|
10 |
+__PACKAGE__->attr('table'); |
|
10 | 11 |
__PACKAGE__->dual_attr('tag_processors', default => sub { {} }, |
11 | 12 |
inherit => 'hash_copy'); |
12 | 13 |
|
... | ... |
@@ -176,7 +177,7 @@ sub _build_query { |
176 | 177 |
|
177 | 178 |
# Expand tag using tag processor |
178 | 179 |
my ($expand, $key_infos) |
179 |
- = $tag_processor->($tag_name, $tag_args); |
|
180 |
+ = $tag_processor->($tag_name, $tag_args, $self->table); |
|
180 | 181 |
|
181 | 182 |
# Check tag processor return value |
182 | 183 |
croak("Tag processor '$tag_name' must return (\$expand, \$key_infos)") |
... | ... |
@@ -224,61 +225,37 @@ use strict; |
224 | 225 |
use warnings; |
225 | 226 |
|
226 | 227 |
use Carp 'croak'; |
227 |
-use DBIx::Custom::Column; |
|
228 |
+use DBIx::Custom::KeyInfo; |
|
228 | 229 |
|
229 | 230 |
sub expand_basic_tag { |
230 |
- my ($tag_name, $tag_args) = @_; |
|
231 |
- my $original_key = $tag_args->[0]; |
|
231 |
+ my ($tag_name, $tag_args, $table) = @_; |
|
232 |
+ |
|
233 |
+ # Key |
|
234 |
+ my $key = $tag_args->[0]; |
|
232 | 235 |
|
233 | 236 |
# Key is not exist |
234 | 237 |
croak("You must be pass key as argument to tag '{$tag_name }'") |
235 |
- if !$original_key; |
|
238 |
+ unless $key; |
|
236 | 239 |
|
237 | 240 |
# Expanded tag |
238 | 241 |
my $expand = $tag_name eq '?' |
239 | 242 |
? '?' |
240 |
- : "$original_key $tag_name ?"; |
|
241 |
- |
|
242 |
- # Get table and clumn name |
|
243 |
- my $c = DBIx::Custom::Column->new; |
|
244 |
- $c->parse($original_key); |
|
245 |
- my $table = $c->table; |
|
246 |
- my $column = $c->column; |
|
247 |
- |
|
248 |
- # Parameter key infomation |
|
249 |
- my $key_info = {}; |
|
250 |
- |
|
251 |
- # Original key |
|
252 |
- $key_info->{original_key} = $original_key; |
|
243 |
+ : "$key $tag_name ?"; |
|
253 | 244 |
|
254 |
- # Table |
|
255 |
- $key_info->{table} = $table; |
|
256 |
- |
|
257 |
- # Column name |
|
258 |
- $key_info->{column} = $column; |
|
259 |
- |
|
260 |
- # Access keys |
|
261 |
- my $access_keys = []; |
|
262 |
- push @$access_keys, [$original_key]; |
|
263 |
- push @$access_keys, [$table, $column] if $table && $column; |
|
264 |
- $key_info->{access_keys} = $access_keys; |
|
265 |
- |
|
266 |
- # Add parameter key information |
|
267 |
- my $key_infos = []; |
|
268 |
- push @$key_infos, $key_info; |
|
245 |
+ my $key_info = DBIx::Custom::KeyInfo->new($key); |
|
246 |
+ $key_info->table($table) unless $key_info->table; |
|
269 | 247 |
|
270 |
- return ($expand, $key_infos); |
|
248 |
+ return ($expand, [$key_info]); |
|
271 | 249 |
} |
272 | 250 |
|
273 | 251 |
sub expand_in_tag { |
274 |
- my ($tag_name, $tag_args) = @_; |
|
275 |
- my ($original_key, $placeholder_count) = @$tag_args; |
|
252 |
+ my ($tag_name, $tag_args, $table) = @_; |
|
253 |
+ my ($key, $placeholder_count) = @$tag_args; |
|
276 | 254 |
|
277 | 255 |
# Key must be specified |
278 | 256 |
croak("You must be pass key as first argument of tag '{$tag_name }'\n" . |
279 | 257 |
"Usage: {$tag_name \$key \$placeholder_count}") |
280 |
- unless $original_key; |
|
281 |
- |
|
258 |
+ unless $key; |
|
282 | 259 |
|
283 | 260 |
# Place holder count must be specified |
284 | 261 |
croak("You must be pass placeholder count as second argument of tag '{$tag_name }'\n" . |
... | ... |
@@ -286,7 +263,7 @@ sub expand_in_tag { |
286 | 263 |
if !$placeholder_count || $placeholder_count =~ /\D/; |
287 | 264 |
|
288 | 265 |
# Expand tag |
289 |
- my $expand = "$original_key $tag_name ("; |
|
266 |
+ my $expand = "$key $tag_name ("; |
|
290 | 267 |
for (my $i = 0; $i < $placeholder_count; $i++) { |
291 | 268 |
$expand .= '?, '; |
292 | 269 |
} |
... | ... |
@@ -294,34 +271,14 @@ sub expand_in_tag { |
294 | 271 |
$expand =~ s/, $//; |
295 | 272 |
$expand .= ')'; |
296 | 273 |
|
297 |
- # Get table and clumn name |
|
298 |
- my $c = DBIx::Custom::Column->new; |
|
299 |
- $c->parse($original_key); |
|
300 |
- my $table = $c->table; |
|
301 |
- my $column = $c->column; |
|
302 |
- |
|
303 | 274 |
# Create parameter key infomations |
304 | 275 |
my $key_infos = []; |
305 | 276 |
for (my $i = 0; $i < $placeholder_count; $i++) { |
306 |
- # Parameter key infomation |
|
307 |
- my $key_info = {}; |
|
308 |
- |
|
309 |
- # Original key |
|
310 |
- $key_info->{original_key} = $original_key; |
|
311 |
- |
|
312 |
- # Table |
|
313 |
- $key_info->{table} = $table; |
|
314 |
- |
|
315 |
- # Column name |
|
316 |
- $key_info->{column} = $column; |
|
317 |
- |
|
318 |
- # Access keys |
|
319 |
- my $access_keys = []; |
|
320 |
- push @$access_keys, [$original_key, [$i]]; |
|
321 |
- push @$access_keys, [$table, $column, [$i]] if $table && $column; |
|
322 |
- $key_info->{access_keys} = $access_keys; |
|
323 | 277 |
|
324 | 278 |
# Add parameter key infos |
279 |
+ my $key_info = DBIx::Custom::KeyInfo->new($key); |
|
280 |
+ $key_info->table($table) unless $key_info->table; |
|
281 |
+ $key_info->pos($i); |
|
325 | 282 |
push @$key_infos, $key_info; |
326 | 283 |
} |
327 | 284 |
|
... | ... |
@@ -329,8 +286,8 @@ sub expand_in_tag { |
329 | 286 |
} |
330 | 287 |
|
331 | 288 |
sub expand_insert_tag { |
332 |
- my ($tag_name, $tag_args) = @_; |
|
333 |
- my $original_keys = $tag_args; |
|
289 |
+ my ($tag_name, $tag_args, $table) = @_; |
|
290 |
+ my $keys = $tag_args; |
|
334 | 291 |
|
335 | 292 |
# Insert key (k1, k2, k3, ..) |
336 | 293 |
my $insert_keys = '('; |
... | ... |
@@ -338,12 +295,10 @@ sub expand_insert_tag { |
338 | 295 |
# placeholder (?, ?, ?, ..) |
339 | 296 |
my $place_holders = '('; |
340 | 297 |
|
341 |
- foreach my $original_key (@$original_keys) { |
|
298 |
+ foreach my $key (@$keys) { |
|
342 | 299 |
# Get table and clumn name |
343 |
- my $c = DBIx::Custom::Column->new; |
|
344 |
- $c->parse($original_key); |
|
345 |
- my $table = $c->table; |
|
346 |
- my $column = $c->column; |
|
300 |
+ my $key_info = DBIx::Custom::KeyInfo->new($key); |
|
301 |
+ my $column = $key_info->column; |
|
347 | 302 |
|
348 | 303 |
# Join insert column |
349 | 304 |
$insert_keys .= "$column, "; |
... | ... |
@@ -365,32 +320,9 @@ sub expand_insert_tag { |
365 | 320 |
|
366 | 321 |
# Create parameter key infomations |
367 | 322 |
my $key_infos = []; |
368 |
- foreach my $original_key (@$original_keys) { |
|
369 |
- # Get table and clumn name |
|
370 |
- my $c = DBIx::Custom::Column->new; |
|
371 |
- $c->parse($original_key); |
|
372 |
- my $table = $c->table; |
|
373 |
- my $column = $c->column; |
|
374 |
- |
|
375 |
- # Parameter key infomation |
|
376 |
- my $key_info = {}; |
|
377 |
- |
|
378 |
- # Original key |
|
379 |
- $key_info->{original_key} = $original_key; |
|
380 |
- |
|
381 |
- # Table |
|
382 |
- $key_info->{table} = $table; |
|
383 |
- |
|
384 |
- # Column name |
|
385 |
- $key_info->{column} = $column; |
|
386 |
- |
|
387 |
- # Access keys |
|
388 |
- my $access_keys = []; |
|
389 |
- push @$access_keys, [$original_key]; |
|
390 |
- push @$access_keys, [$table, $column] if $table && $column; |
|
391 |
- $key_info->{access_keys} = $access_keys; |
|
392 |
- |
|
393 |
- # Add parameter key infos |
|
323 |
+ foreach my $key (@$keys) { |
|
324 |
+ my $key_info = DBIx::Custom::KeyInfo->new($key); |
|
325 |
+ $key_info->table($table) unless $key_info->table; |
|
394 | 326 |
push @$key_infos, $key_info; |
395 | 327 |
} |
396 | 328 |
|
... | ... |
@@ -398,19 +330,16 @@ sub expand_insert_tag { |
398 | 330 |
} |
399 | 331 |
|
400 | 332 |
sub expand_update_tag { |
401 |
- my ($tag_name, $tag_args) = @_; |
|
402 |
- my $original_keys = $tag_args; |
|
333 |
+ my ($tag_name, $tag_args, $table) = @_; |
|
334 |
+ my $keys = $tag_args; |
|
403 | 335 |
|
404 | 336 |
# Expanded tag |
405 | 337 |
my $expand = 'set '; |
406 | 338 |
|
407 |
- # |
|
408 |
- foreach my $original_key (@$original_keys) { |
|
339 |
+ foreach my $key (@$keys) { |
|
409 | 340 |
# Get table and clumn name |
410 |
- my $c = DBIx::Custom::Column->new; |
|
411 |
- $c->parse($original_key); |
|
412 |
- my $table = $c->table; |
|
413 |
- my $column = $c->column; |
|
341 |
+ my $key_info = DBIx::Custom::KeyInfo->new($key); |
|
342 |
+ my $column = $key_info->column; |
|
414 | 343 |
|
415 | 344 |
# Join key and placeholder |
416 | 345 |
$expand .= "$column = ?, "; |
... | ... |
@@ -419,34 +348,10 @@ sub expand_update_tag { |
419 | 348 |
# Delete last ', ' |
420 | 349 |
$expand =~ s/, $//; |
421 | 350 |
|
422 |
- # Create parameter key infomations |
|
423 | 351 |
my $key_infos = []; |
424 |
- foreach my $original_key (@$original_keys) { |
|
425 |
- # Get table and clumn name |
|
426 |
- my $c = DBIx::Custom::Column->new; |
|
427 |
- $c->parse($original_key); |
|
428 |
- my $table = $c->table; |
|
429 |
- my $column = $c->column; |
|
430 |
- |
|
431 |
- # Parameter key infomation |
|
432 |
- my $key_info = {}; |
|
433 |
- |
|
434 |
- # Original key |
|
435 |
- $key_info->{original_key} = $original_key; |
|
436 |
- |
|
437 |
- # Table |
|
438 |
- $key_info->{table} = $table; |
|
439 |
- |
|
440 |
- # Column name |
|
441 |
- $key_info->{column} = $column; |
|
442 |
- |
|
443 |
- # Access keys |
|
444 |
- my $access_keys = []; |
|
445 |
- push @$access_keys, [$original_key]; |
|
446 |
- push @$access_keys, [$table, $column] if $table && $column; |
|
447 |
- $key_info->{access_keys} = $access_keys; |
|
448 |
- |
|
449 |
- # Add parameter key infos |
|
352 |
+ foreach my $key (@$keys) { |
|
353 |
+ my $key_info = DBIx::Custom::KeyInfo->new($key); |
|
354 |
+ $key_info->table($table) unless $key_info->table; |
|
450 | 355 |
push @$key_infos, $key_info; |
451 | 356 |
} |
452 | 357 |
|
... | ... |
@@ -619,3 +524,4 @@ The following is update SQL sample |
619 | 524 |
$query->sql : "update table set key1 = ?, key2 = ? where key3 = ?;" |
620 | 525 |
|
621 | 526 |
=cut |
527 |
+ |
... | ... |
@@ -180,17 +180,18 @@ $insert_tmpl = "insert into table1 {insert key1 key2}"; |
180 | 180 |
$dbi->query($insert_tmpl, {key1 => 1, key2 => 2}, sub { |
181 | 181 |
my $query = shift; |
182 | 182 |
$query->bind_filter(sub { |
183 |
- my ($value, $key) = @_; |
|
184 |
- if ($key eq 'key2') { |
|
183 |
+ my ($value, $table, $column) = @_; |
|
184 |
+ if ($column eq 'key2') { |
|
185 | 185 |
return $value + 1; |
186 | 186 |
} |
187 | 187 |
return $value; |
188 | 188 |
}); |
189 | 189 |
}); |
190 |
-$result = $dbi->query($SELECT_TMPL->{0}); |
|
190 |
+$result = $dbi->query(['table1', $SELECT_TMPL->{0}]); |
|
191 | 191 |
$rows = $result->fetch_hash_all; |
192 | 192 |
is_deeply($rows, [{key1 => 1, key2 => 3}], $test); |
193 | 193 |
|
194 |
+__END__ |
|
194 | 195 |
|
195 | 196 |
test 'Filter basic'; |
196 | 197 |
$dbi->do($DROP_TABLE->{0}); |
... | ... |
@@ -199,11 +200,9 @@ $dbi->do($CREATE_TABLE->{0}); |
199 | 200 |
$insert_tmpl = "insert into table1 {insert key1 key2};"; |
200 | 201 |
$insert_query = $dbi->create_query($insert_tmpl); |
201 | 202 |
$insert_query->bind_filter(sub { |
202 |
- my ($value, $key, $dbi, $infos) = @_; |
|
203 |
- my ($table, $column) = @{$infos}{qw/table column/}; |
|
203 |
+ my ($value, $table, $column) = @_; |
|
204 | 204 |
|
205 |
- if ($key eq 'key1' && $table eq '' && $column eq 'key1' |
|
206 |
- && $dbi->isa('DBIx::Custom')) |
|
205 |
+ if ($table eq '' && $column eq 'key1') |
|
207 | 206 |
{ |
208 | 207 |
return $value * 2; |
209 | 208 |
} |
... | ... |
@@ -0,0 +1,69 @@ |
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"); |
... | ... |
@@ -0,0 +1,67 @@ |
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 |
+ |
... | ... |
@@ -0,0 +1,36 @@ |
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 |
+} |
... | ... |
@@ -0,0 +1,223 @@ |
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"); |
... | ... |
@@ -0,0 +1,47 @@ |
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 |
+ |
... | ... |
@@ -0,0 +1,85 @@ |
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 |
+ |
... | ... |
@@ -0,0 +1,37 @@ |
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 |
+ |
... | ... |
@@ -0,0 +1,259 @@ |
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 |
+ |
... | ... |
@@ -0,0 +1,198 @@ |
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 |
+ |
... | ... |
@@ -0,0 +1,85 @@ |
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 |
+ |
... | ... |
@@ -0,0 +1,79 @@ |
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; |