... | ... |
@@ -8,7 +8,7 @@ use base 'Object::Simple'; |
8 | 8 |
use Carp 'croak'; |
9 | 9 |
use DBI; |
10 | 10 |
use DBIx::Custom::Result; |
11 |
-use DBIx::Custom::SQL::Template; |
|
11 |
+use DBIx::Custom::SQLTemplate; |
|
12 | 12 |
use DBIx::Custom::Query; |
13 | 13 |
use DBIx::Custom::KeyInfo; |
14 | 14 |
|
... | ... |
@@ -28,9 +28,9 @@ __PACKAGE__->dual_attr([qw/ filters formats/], |
28 | 28 |
default => sub { {} }, inherit => 'hash_copy'); |
29 | 29 |
|
30 | 30 |
__PACKAGE__->attr(result_class => 'DBIx::Custom::Result'); |
31 |
-__PACKAGE__->attr(sql_tmpl => sub { DBIx::Custom::SQL::Template->new }); |
|
31 |
+__PACKAGE__->attr(sql_tmpl => sub { DBIx::Custom::SQLTemplate->new }); |
|
32 | 32 |
|
33 |
-sub add_filter { |
|
33 |
+sub resist_filter { |
|
34 | 34 |
my $invocant = shift; |
35 | 35 |
|
36 | 36 |
# Add filter |
... | ... |
@@ -40,7 +40,7 @@ sub add_filter { |
40 | 40 |
return $invocant; |
41 | 41 |
} |
42 | 42 |
|
43 |
-sub add_format{ |
|
43 |
+sub resist_format{ |
|
44 | 44 |
my $invocant = shift; |
45 | 45 |
|
46 | 46 |
# Add format |
... | ... |
@@ -172,9 +172,7 @@ sub create_query { |
172 | 172 |
|
173 | 173 |
my $class = ref $self; |
174 | 174 |
|
175 |
- my $table = ''; |
|
176 | 175 |
if (ref $template eq 'ARRAY') { |
177 |
- $table = $template->[0] if $template->[0]; |
|
178 | 176 |
$template = $template->[1]; |
179 | 177 |
} |
180 | 178 |
|
... | ... |
@@ -182,7 +180,7 @@ sub create_query { |
182 | 180 |
my $sql_tmpl = $self->sql_tmpl; |
183 | 181 |
|
184 | 182 |
# Try to get cached query |
185 |
- my $cached_query = $class->_query_caches->{"$table$template"}; |
|
183 |
+ my $cached_query = $class->_query_caches->{"$template"}; |
|
186 | 184 |
|
187 | 185 |
# Create query |
188 | 186 |
my $query; |
... | ... |
@@ -193,11 +191,10 @@ sub create_query { |
193 | 191 |
); |
194 | 192 |
} |
195 | 193 |
else { |
196 |
- $sql_tmpl->table($table); |
|
197 | 194 |
$query = eval{$sql_tmpl->create_query($template)}; |
198 | 195 |
croak($@) if $@; |
199 | 196 |
|
200 |
- $class->_add_query_cache("$table$template", $query); |
|
197 |
+ $class->_add_query_cache("$template", $query); |
|
201 | 198 |
} |
202 | 199 |
|
203 | 200 |
# Connect if not |
... | ... |
@@ -209,36 +206,30 @@ sub create_query { |
209 | 206 |
# Set statement handle |
210 | 207 |
$query->sth($sth); |
211 | 208 |
|
212 |
- # Set bind filter |
|
213 |
- $query->query_filter($self->default_query_filter); |
|
214 |
- |
|
215 |
- # Set fetch filter |
|
216 |
- $query->fetch_filter($self->default_fetch_filter); |
|
217 |
- |
|
218 | 209 |
return $query; |
219 | 210 |
} |
220 | 211 |
|
221 | 212 |
sub query{ |
222 |
- my ($self, $query, $params, $query_edit_cb) = @_; |
|
213 |
+ my ($self, $query, $params, $args) = @_; |
|
223 | 214 |
$params ||= {}; |
224 | 215 |
|
216 |
+ # Filter |
|
217 |
+ my $filter = $args->{filter} || {}; |
|
218 |
+ |
|
225 | 219 |
# First argument is SQL template |
226 | 220 |
unless (ref $query eq 'DBIx::Custom::Query') { |
227 |
- my $table; |
|
228 | 221 |
my $template; |
229 | 222 |
|
230 | 223 |
if (ref $query eq 'ARRAY') { |
231 |
- $table = $query->[0]; |
|
232 |
- $template = $query->[1]; |
|
224 |
+ $template = $query->[0]; |
|
233 | 225 |
} |
234 | 226 |
else { $template = $query } |
235 | 227 |
|
236 |
- $query = $self->create_query([$table, $template]); |
|
237 |
- $query_edit_cb->($query) if ref $query_edit_cb eq 'CODE'; |
|
228 |
+ $query = $self->create_query($template); |
|
238 | 229 |
} |
239 |
- |
|
230 |
+ |
|
240 | 231 |
# Create bind value |
241 |
- my $bind_values = $self->_build_bind_values($query, $params); |
|
232 |
+ my $bind_values = $self->_build_bind_values($query, $params, $filter); |
|
242 | 233 |
|
243 | 234 |
# Execute |
244 | 235 |
my $sth = $query->sth; |
... | ... |
@@ -264,9 +255,9 @@ sub query{ |
264 | 255 |
|
265 | 256 |
# Create result |
266 | 257 |
my $result = $result_class->new({ |
267 |
- _dbi => $self, |
|
268 |
- sth => $sth, |
|
269 |
- fetch_filter => $query->fetch_filter, |
|
258 |
+ sth => $sth, |
|
259 |
+ default_filter => $self->default_fetch_filter, |
|
260 |
+ filters => $self->filters |
|
270 | 261 |
}); |
271 | 262 |
return $result; |
272 | 263 |
} |
... | ... |
@@ -274,29 +265,27 @@ sub query{ |
274 | 265 |
} |
275 | 266 |
|
276 | 267 |
sub _build_bind_values { |
277 |
- my ($self, $query, $params) = @_; |
|
278 |
- my $key_infos = $query->key_infos; |
|
279 |
- my $filter = $query->query_filter; |
|
268 |
+ my ($self, $query, $params, $filter) = @_; |
|
269 |
+ my $key_infos = $query->key_infos; |
|
270 |
+ my $default_filter = $self->default_query_filter; |
|
271 |
+ my $filters = $self->filters; |
|
280 | 272 |
|
281 | 273 |
# binding values |
282 | 274 |
my @bind_values; |
283 | 275 |
|
284 | 276 |
# Build bind values |
285 | 277 |
foreach my $key_info (@$key_infos) { |
286 |
- my $table = $key_info->table; |
|
287 |
- my $column = $key_info->column; |
|
288 |
- my $id = $key_info->id; |
|
289 |
- my $pos = $key_info->pos; |
|
278 |
+ my $column = $key_info->{column}; |
|
279 |
+ my $pos = $key_info->{pos}; |
|
290 | 280 |
|
291 | 281 |
# Value |
292 |
- my $value = $id && defined $pos ? $params->{$id}->{$column}->[$pos] |
|
293 |
- : $id ? $params->{$id}->{$column} |
|
294 |
- : defined $pos ? $params->{$column}->[$pos] |
|
295 |
- : $params->{$column}; |
|
282 |
+ my $value = defined $pos ? $params->{$column}->[$pos] : $params->{$column}; |
|
296 | 283 |
|
297 | 284 |
# Filter |
285 |
+ $filter = $filters->{$filter} || $filters->{$default_filter}; |
|
286 |
+ |
|
298 | 287 |
push @bind_values, |
299 |
- $filter ? $filter->($value, $table, $column, $self) |
|
288 |
+ $filter ? $filter->($value) |
|
300 | 289 |
: $value; |
301 | 290 |
} |
302 | 291 |
|
... | ... |
@@ -387,7 +376,7 @@ sub drop_table { |
387 | 376 |
return $self->do($sql); |
388 | 377 |
} |
389 | 378 |
|
390 |
-our %VALID_INSERT_ARGS = map { $_ => 1 } qw/append query_edit_cb/; |
|
379 |
+our %VALID_INSERT_ARGS = map { $_ => 1 } qw/append filter/; |
|
391 | 380 |
|
392 | 381 |
sub insert { |
393 | 382 |
my ($self, $table, $insert_params, $args) = @_; |
... | ... |
@@ -408,7 +397,7 @@ sub insert { |
408 | 397 |
} |
409 | 398 |
|
410 | 399 |
my $append_statement = $args->{append} || ''; |
411 |
- my $query_edit_cb = $args->{query_edit_cb}; |
|
400 |
+ my $filter = $args->{filter}; |
|
412 | 401 |
|
413 | 402 |
# Insert keys |
414 | 403 |
my @insert_keys = keys %$insert_params; |
... | ... |
@@ -420,24 +409,15 @@ sub insert { |
420 | 409 |
# Templte for insert |
421 | 410 |
my $template = "insert into $table {insert " . join(' ', @insert_keys) . '}'; |
422 | 411 |
$template .= " $append_statement" if $append_statement; |
423 |
- # Create query |
|
424 |
- my $query = $self->create_query([$table, $template]); |
|
425 |
- |
|
426 |
- # Query edit callback must be code reference |
|
427 |
- croak("Query edit callback must be code reference") |
|
428 |
- if $query_edit_cb && ref $query_edit_cb ne 'CODE'; |
|
429 |
- |
|
430 |
- # Query edit if need |
|
431 |
- $query_edit_cb->($query) if $query_edit_cb; |
|
432 | 412 |
|
433 | 413 |
# Execute query |
434 |
- my $ret_val = $self->query($query, $insert_params); |
|
414 |
+ my $ret_val = $self->query($template, $insert_params, {filter => $filter}); |
|
435 | 415 |
|
436 | 416 |
return $ret_val; |
437 | 417 |
} |
438 | 418 |
|
439 | 419 |
our %VALID_UPDATE_ARGS |
440 |
- = map { $_ => 1 } qw/where append query_edit_cb allow_update_all/; |
|
420 |
+ = map { $_ => 1 } qw/where append filter allow_update_all/; |
|
441 | 421 |
|
442 | 422 |
sub update { |
443 | 423 |
my ($self, $table, $update_params, $args) = @_; |
... | ... |
@@ -451,7 +431,7 @@ sub update { |
451 | 431 |
# Arguments |
452 | 432 |
my $where_params = $args->{where} || {}; |
453 | 433 |
my $append_statement = $args->{append} || ''; |
454 |
- my $query_edit_cb = $args->{query_edit_cb}; |
|
434 |
+ my $filter = $args->{filter}; |
|
455 | 435 |
my $allow_update_all = $args->{allow_update_all}; |
456 | 436 |
|
457 | 437 |
# Update keys |
... | ... |
@@ -491,21 +471,11 @@ sub update { |
491 | 471 |
my $template = "update $table $update_clause $where_clause"; |
492 | 472 |
$template .= " $append_statement" if $append_statement; |
493 | 473 |
|
494 |
- # Create query |
|
495 |
- my $query = $self->create_query([$table, $template]); |
|
496 |
- |
|
497 |
- # Query edit callback must be code reference |
|
498 |
- croak("Query edit callback must be code reference") |
|
499 |
- if $query_edit_cb && ref $query_edit_cb ne 'CODE'; |
|
500 |
- |
|
501 |
- # Query edit if need |
|
502 |
- $query_edit_cb->($query) if $query_edit_cb; |
|
503 |
- |
|
504 | 474 |
# Rearrange parammeters |
505 | 475 |
my $params = {%$update_params, '@where' => $where_params}; |
506 | 476 |
|
507 | 477 |
# Execute query |
508 |
- my $ret_val = $self->query($query, $params); |
|
478 |
+ my $ret_val = $self->query($template, $params, {filter => $filter}); |
|
509 | 479 |
|
510 | 480 |
return $ret_val; |
511 | 481 |
} |
... | ... |
@@ -522,7 +492,7 @@ sub update_all { |
522 | 492 |
} |
523 | 493 |
|
524 | 494 |
our %VALID_DELETE_ARGS |
525 |
- = map { $_ => 1 } qw/where append query_edit_cb allow_delete_all/; |
|
495 |
+ = map { $_ => 1 } qw/where append filter allow_delete_all/; |
|
526 | 496 |
|
527 | 497 |
sub delete { |
528 | 498 |
my ($self, $table, $args) = @_; |
... | ... |
@@ -539,7 +509,7 @@ sub delete { |
539 | 509 |
# Arguments |
540 | 510 |
my $where_params = $args->{where} || {}; |
541 | 511 |
my $append_statement = $args->{append}; |
542 |
- my $query_edit_cb = $args->{query_edit_cb}; |
|
512 |
+ my $filter = $args->{filter}; |
|
543 | 513 |
my $allow_delete_all = $args->{allow_delete_all}; |
544 | 514 |
|
545 | 515 |
# Where keys |
... | ... |
@@ -563,18 +533,8 @@ sub delete { |
563 | 533 |
my $template = "delete from $table $where_clause"; |
564 | 534 |
$template .= " $append_statement" if $append_statement; |
565 | 535 |
|
566 |
- # Create query |
|
567 |
- my $query = $self->create_query([$table, $template]); |
|
568 |
- |
|
569 |
- # Query edit callback must be code reference |
|
570 |
- croak("Query edit callback must be code reference") |
|
571 |
- if $query_edit_cb && ref $query_edit_cb ne 'CODE'; |
|
572 |
- |
|
573 |
- # Query edit if need |
|
574 |
- $query_edit_cb->($query) if $query_edit_cb; |
|
575 |
- |
|
576 | 536 |
# Execute query |
577 |
- my $ret_val = $self->query($query, $where_params); |
|
537 |
+ my $ret_val = $self->query($template, $where_params, {filter => $filter}); |
|
578 | 538 |
|
579 | 539 |
return $ret_val; |
580 | 540 |
} |
... | ... |
@@ -590,22 +550,8 @@ sub delete_all { |
590 | 550 |
return $self->delete($table, $args); |
591 | 551 |
} |
592 | 552 |
|
593 |
-sub _select_usage { return << 'EOS' } |
|
594 |
-Select usage: |
|
595 |
-$dbi->select( |
|
596 |
- $table, # String or array ref |
|
597 |
- { |
|
598 |
- columns => $columns # Array reference |
|
599 |
- where => $params # Hash reference. |
|
600 |
- append => $statement # String. |
|
601 |
- query_edit_cb => $cb # Sub reference |
|
602 |
- } |
|
603 |
-); |
|
604 |
-EOS |
|
605 |
- |
|
606 | 553 |
our %VALID_SELECT_ARGS |
607 |
- = map { $_ => 1 } qw/columns where append query_edit_cb/; |
|
608 |
- |
|
554 |
+ = map { $_ => 1 } qw/columns where append filter/; |
|
609 | 555 |
|
610 | 556 |
sub select { |
611 | 557 |
my ($self, $tables, $args) = @_; |
... | ... |
@@ -624,7 +570,7 @@ sub select { |
624 | 570 |
my $columns = $args->{columns} || []; |
625 | 571 |
my $where_params = $args->{where} || {}; |
626 | 572 |
my $append_statement = $args->{append} || ''; |
627 |
- my $query_edit_cb = $args->{query_edit_cb}; |
|
573 |
+ my $filter = $args->{filter}; |
|
628 | 574 |
|
629 | 575 |
# SQL template for select statement |
630 | 576 |
my $template = 'select '; |
... | ... |
@@ -684,14 +630,8 @@ sub select { |
684 | 630 |
$template .= " $append_statement"; |
685 | 631 |
} |
686 | 632 |
|
687 |
- # Create query |
|
688 |
- my $query = $self->create_query([$tables->[0], $template]); |
|
689 |
- |
|
690 |
- # Query edit |
|
691 |
- $query_edit_cb->($query) if $query_edit_cb; |
|
692 |
- |
|
693 | 633 |
# Execute query |
694 |
- my $result = $self->query($query, $where_params_new); |
|
634 |
+ my $result = $self->query($template, $where_params_new, {filter => $filter}); |
|
695 | 635 |
|
696 | 636 |
return $result; |
697 | 637 |
} |
... | ... |
@@ -822,12 +762,12 @@ DBI options |
822 | 762 |
|
823 | 763 |
=head2 sql_tmpl |
824 | 764 |
|
825 |
-SQL::Template object |
|
765 |
+SQLTemplate object |
|
826 | 766 |
|
827 |
- $dbi = $dbi->sql_tmpl(DBIx::Cutom::SQL::Template->new); |
|
767 |
+ $dbi = $dbi->sql_tmpl(DBIx::Cutom::SQLTemplate->new); |
|
828 | 768 |
$sql_tmpl = $dbi->sql_tmpl; |
829 | 769 |
|
830 |
-See also L<DBIx::Custom::SQL::Template>. |
|
770 |
+See also L<DBIx::Custom::SQLTemplate>. |
|
831 | 771 |
|
832 | 772 |
=head2 filters |
833 | 773 |
|
... | ... |
@@ -840,7 +780,7 @@ This method is generally used to get a filter. |
840 | 780 |
|
841 | 781 |
$filter = $dbi->filters->{encode_utf8}; |
842 | 782 |
|
843 |
-If you add filter, use add_filter method. |
|
783 |
+If you add filter, use resist_filter method. |
|
844 | 784 |
|
845 | 785 |
=head2 formats |
846 | 786 |
|
... | ... |
@@ -853,7 +793,7 @@ This method is generally used to get a format. |
853 | 793 |
|
854 | 794 |
$filter = $dbi->formats->{datetime}; |
855 | 795 |
|
856 |
-If you add format, use add_format method. |
|
796 |
+If you add format, use resist_format method. |
|
857 | 797 |
|
858 | 798 |
=head2 default_query_filter |
859 | 799 |
|
... | ... |
@@ -864,7 +804,7 @@ Binding filter |
864 | 804 |
|
865 | 805 |
The following is bind filter sample |
866 | 806 |
|
867 |
- $dbi->add_filter(encode_utf8 => sub { |
|
807 |
+ $dbi->resist_filter(encode_utf8 => sub { |
|
868 | 808 |
my $value = shift; |
869 | 809 |
|
870 | 810 |
require Encode 'encode_utf8'; |
... | ... |
@@ -890,7 +830,7 @@ Fetching filter |
890 | 830 |
|
891 | 831 |
The following is fetch filter sample |
892 | 832 |
|
893 |
- $dbi->add_filter(decode_utf8 => sub { |
|
833 |
+ $dbi->resist_filter(decode_utf8 => sub { |
|
894 | 834 |
my $value = shift; |
895 | 835 |
|
896 | 836 |
require Encode 'decode_utf8'; |
... | ... |
@@ -963,15 +903,15 @@ Check if database is connected. |
963 | 903 |
|
964 | 904 |
$is_connected = $dbi->connected; |
965 | 905 |
|
966 |
-=head2 add_filter |
|
906 |
+=head2 resist_filter |
|
967 | 907 |
|
968 | 908 |
Resist filter |
969 | 909 |
|
970 |
- $dbi->add_filter($fname1 => $filter1, $fname => $filter2); |
|
910 |
+ $dbi->resist_filter($fname1 => $filter1, $fname => $filter2); |
|
971 | 911 |
|
972 |
-The following is add_filter sample |
|
912 |
+The following is resist_filter sample |
|
973 | 913 |
|
974 |
- $dbi->add_filter( |
|
914 |
+ $dbi->resist_filter( |
|
975 | 915 |
encode_utf8 => sub { |
976 | 916 |
my ($value, $key, $dbi, $infos) = @_; |
977 | 917 |
utf8::upgrade($value) unless Encode::is_utf8($value); |
... | ... |
@@ -983,15 +923,15 @@ The following is add_filter sample |
983 | 923 |
} |
984 | 924 |
); |
985 | 925 |
|
986 |
-=head2 add_format |
|
926 |
+=head2 resist_format |
|
987 | 927 |
|
988 | 928 |
Add format |
989 | 929 |
|
990 |
- $dbi->add_format($fname1 => $format, $fname2 => $format2); |
|
930 |
+ $dbi->resist_format($fname1 => $format, $fname2 => $format2); |
|
991 | 931 |
|
992 |
-The following is add_format sample. |
|
932 |
+The following is resist_format sample. |
|
993 | 933 |
|
994 |
- $dbi->add_format(date => '%Y:%m:%d', datetime => '%Y-%m-%d %H:%M:%S'); |
|
934 |
+ $dbi->resist_format(date => '%Y:%m:%d', datetime => '%Y-%m-%d %H:%M:%S'); |
|
995 | 935 |
|
996 | 936 |
=head2 create_query |
997 | 937 |
|
... | ... |
@@ -1003,7 +943,7 @@ $query is <DBIx::Query> object. This is executed by query method as the followin |
1003 | 943 |
|
1004 | 944 |
$dbi->query($query, $params); |
1005 | 945 |
|
1006 |
-If you know SQL template, see also L<DBIx::Custom::SQL::Template>. |
|
946 |
+If you know SQL template, see also L<DBIx::Custom::SQLTemplate>. |
|
1007 | 947 |
|
1008 | 948 |
=head2 query |
1009 | 949 |
|
... | ... |
@@ -1020,7 +960,7 @@ The following is query sample |
1020 | 960 |
# do something |
1021 | 961 |
} |
1022 | 962 |
|
1023 |
-If you now syntax of template, See also L<DBIx::Custom::SQL::Template> |
|
963 |
+If you now syntax of template, See also L<DBIx::Custom::SQLTemplate> |
|
1024 | 964 |
|
1025 | 965 |
Return value of query method is L<DBIx::Custom::Result> object |
1026 | 966 |
|
... | ... |
@@ -7,12 +7,13 @@ use base 'DBIx::Custom'; |
7 | 7 |
|
8 | 8 |
use Encode qw/decode encode/; |
9 | 9 |
|
10 |
-__PACKAGE__->add_filter( |
|
10 |
+__PACKAGE__->resist_filter( |
|
11 |
+ none => sub { $_[0] }, |
|
11 | 12 |
encode_utf8 => sub { encode('UTF-8', $_[0]) }, |
12 | 13 |
decode_utf8 => sub { decode('UTF-8', $_[0]) } |
13 | 14 |
); |
14 | 15 |
|
15 |
-__PACKAGE__->add_format( |
|
16 |
+__PACKAGE__->resist_format( |
|
16 | 17 |
'SQL99_date' => '%Y-%m-%d', |
17 | 18 |
'SQL99_datetime' => '%Y-%m-%d %H:%M:%S', |
18 | 19 |
'SQL99_time' => '%H:%M:%S', |
... | ... |
@@ -6,7 +6,7 @@ use strict; |
6 | 6 |
use base 'DBIx::Custom::Basic'; |
7 | 7 |
use Carp 'croak'; |
8 | 8 |
|
9 |
-__PACKAGE__->add_format( |
|
9 |
+__PACKAGE__->resist_format( |
|
10 | 10 |
datetime => __PACKAGE__->formats->{SQL99_datetime}, |
11 | 11 |
date => __PACKAGE__->formats->{SQL99_date}, |
12 | 12 |
time => __PACKAGE__->formats->{SQL99_time}, |
... | ... |
@@ -5,7 +5,7 @@ use warnings; |
5 | 5 |
|
6 | 6 |
use base 'Object::Simple'; |
7 | 7 |
|
8 |
-__PACKAGE__->attr([qw/sql key_infos query_filter fetch_filter sth/]); |
|
8 |
+__PACKAGE__->attr([qw/sql key_infos default_filter filter sth/]); |
|
9 | 9 |
|
10 | 10 |
1; |
11 | 11 |
|
... | ... |
@@ -21,10 +21,6 @@ DBIx::Custom::Query - DBIx::Custom query |
21 | 21 |
# Create by using create_query |
22 | 22 |
my $query = DBIx::Custom->create_query($template); |
23 | 23 |
|
24 |
- # Attributes |
|
25 |
- $query->query_filter($dbi->filters->{default_query_filter}); |
|
26 |
- $query->fetch_filter($dbi->filters->{default_fetch_filter}); |
|
27 |
- |
|
28 | 24 |
=head1 ATTRIBUTES |
29 | 25 |
|
30 | 26 |
=head2 sth |
... | ... |
@@ -41,19 +37,19 @@ SQL |
41 | 37 |
$query = $query->sql($sql); |
42 | 38 |
$sql = $query->sql; |
43 | 39 |
|
44 |
-=head2 query_filter |
|
40 |
+=head2 default_filter |
|
45 | 41 |
|
46 | 42 |
Filter excuted when value is bind |
47 | 43 |
|
48 |
- $query = $query->query_filter($query_filter); |
|
49 |
- $query_filter = $query->query_filter; |
|
44 |
+ $query = $query->default_filter($default_filter); |
|
45 |
+ $default_filter = $query->default_filter; |
|
50 | 46 |
|
51 |
-=head2 fetch_filter |
|
47 |
+=head2 filter |
|
52 | 48 |
|
53 |
-Filter excuted when data is fetched |
|
49 |
+Filter excuted when value is bind |
|
54 | 50 |
|
55 |
- $query = $query->fetch_filter($fetch_filter); |
|
56 |
- $fetch_filter = $query->fetch_filter; |
|
51 |
+ $query = $query->filter($filter); |
|
52 |
+ $filter = $query->filter; |
|
57 | 53 |
|
58 | 54 |
=head2 key_infos |
59 | 55 |
|
... | ... |
@@ -7,35 +7,42 @@ use base 'Object::Simple'; |
7 | 7 |
|
8 | 8 |
use Carp 'croak'; |
9 | 9 |
|
10 |
-__PACKAGE__->attr([qw/_dbi sth fetch_filter/]); |
|
10 |
+__PACKAGE__->attr([qw/sth filters default_filter filter/]); |
|
11 | 11 |
|
12 | 12 |
sub fetch { |
13 | 13 |
my ($self, $type) = @_; |
14 |
- my $sth = $self->sth; |
|
15 |
- my $fetch_filter = $self->fetch_filter; |
|
14 |
+ |
|
15 |
+ my $sth = $self->sth; |
|
16 |
+ my $filters = $self->filters || {}; |
|
17 |
+ my $default_filter = $self->default_filter; |
|
18 |
+ my $filter = $self->filter || {}; |
|
16 | 19 |
|
17 | 20 |
# Fetch |
18 | 21 |
my $row = $sth->fetchrow_arrayref; |
19 | 22 |
|
20 | 23 |
# Cannot fetch |
21 | 24 |
return unless $row; |
25 |
+ |
|
26 |
+ # Key |
|
27 |
+ my $columns = $sth->{NAME_lc}; |
|
22 | 28 |
|
23 | 29 |
# Filter |
24 |
- if ($fetch_filter) { |
|
25 |
- my $keys = $sth->{NAME_lc}; |
|
26 |
- my $types = $sth->{TYPE}; |
|
27 |
- for (my $i = 0; $i < @$keys; $i++) { |
|
28 |
- $row->[$i]= $fetch_filter->($row->[$i], $keys->[$i], $self->_dbi, |
|
29 |
- {type => $types->[$i], sth => $sth, index => $i}); |
|
30 |
- } |
|
30 |
+ for (my $i = 0; $i < @$columns; $i++) { |
|
31 |
+ my $fname = $filter->{$columns->[$i]} || $filters->{$default_filter}; |
|
32 |
+ my $filter = $filters->{$fname}; |
|
33 |
+ $row->[$i] = $filter->($row->[$i]) if $filter; |
|
31 | 34 |
} |
35 |
+ |
|
32 | 36 |
return wantarray ? @$row : $row; |
33 | 37 |
} |
34 | 38 |
|
35 | 39 |
sub fetch_hash { |
36 | 40 |
my $self = shift; |
37 |
- my $sth = $self->sth; |
|
38 |
- my $fetch_filter = $self->fetch_filter; |
|
41 |
+ |
|
42 |
+ my $sth = $self->sth; |
|
43 |
+ my $filters = $self->filters || {}; |
|
44 |
+ my $default_filter = $self->default_filter; |
|
45 |
+ my $filter = $self->filter || {}; |
|
39 | 46 |
|
40 | 47 |
# Fetch |
41 | 48 |
my $row = $sth->fetchrow_arrayref; |
... | ... |
@@ -44,25 +51,18 @@ sub fetch_hash { |
44 | 51 |
return unless $row; |
45 | 52 |
|
46 | 53 |
# Keys |
47 |
- my $keys = $sth->{NAME_lc}; |
|
54 |
+ my $columns = $sth->{NAME_lc}; |
|
48 | 55 |
|
49 | 56 |
# Filter |
50 | 57 |
my $row_hash = {}; |
51 |
- if ($fetch_filter) { |
|
52 |
- my $types = $sth->{TYPE}; |
|
53 |
- for (my $i = 0; $i < @$keys; $i++) { |
|
54 |
- $row_hash->{$keys->[$i]} |
|
55 |
- = $fetch_filter->($row->[$i], $keys->[$i], $self->_dbi, |
|
56 |
- {type => $types->[$i], sth => $sth, index => $i}); |
|
57 |
- } |
|
58 |
+ for (my $i = 0; $i < @$columns; $i++) { |
|
59 |
+ my $fname = $filter->{$columns->[$i]} || $filters->{$default_filter}; |
|
60 |
+ my $filter = $filters->{$fname}; |
|
61 |
+ $row_hash->{$columns->[$i]} = $filter |
|
62 |
+ ? $filter->($columns->[$i]) |
|
63 |
+ : $columns->[$i]; |
|
58 | 64 |
} |
59 | 65 |
|
60 |
- # No filter |
|
61 |
- else { |
|
62 |
- for (my $i = 0; $i < @$keys; $i++) { |
|
63 |
- $row_hash->{$keys->[$i]} = $row->[$i]; |
|
64 |
- } |
|
65 |
- } |
|
66 | 66 |
return wantarray ? %$row_hash : $row_hash; |
67 | 67 |
} |
68 | 68 |
|
... | ... |
@@ -200,12 +200,19 @@ Statement handle |
200 | 200 |
$result = $result->sth($sth); |
201 | 201 |
$sth = $reuslt->sth |
202 | 202 |
|
203 |
-=head2 fetch_filter |
|
203 |
+=head2 default_filter |
|
204 |
+ |
|
205 |
+Filter excuted when data is fetched |
|
206 |
+ |
|
207 |
+ $result = $result->default_filter($sth); |
|
208 |
+ $default_filter = $result->default_filter; |
|
209 |
+ |
|
210 |
+=head2 filter |
|
204 | 211 |
|
205 | 212 |
Filter excuted when data is fetched |
206 | 213 |
|
207 |
- $result = $result->fetch_filter($sth); |
|
208 |
- $fetch_filter = $result->fech_filter; |
|
214 |
+ $result = $result->filter($sth); |
|
215 |
+ $filter = $result->filter; |
|
209 | 216 |
|
210 | 217 |
=head1 METHODS |
211 | 218 |
|
... | ... |
@@ -0,0 +1,506 @@ |
1 |
+package DBIx::Custom::SQLTemplate; |
|
2 |
+ |
|
3 |
+use strict; |
|
4 |
+use warnings; |
|
5 |
+ |
|
6 |
+use base 'Object::Simple'; |
|
7 |
+use Carp 'croak'; |
|
8 |
+use DBIx::Custom::Query; |
|
9 |
+ |
|
10 |
+__PACKAGE__->dual_attr('tag_processors', default => sub { {} }, |
|
11 |
+ inherit => 'hash_copy'); |
|
12 |
+ |
|
13 |
+__PACKAGE__->dual_attr('tag_start', default => '{', inherit => 'scalar_copy'); |
|
14 |
+__PACKAGE__->dual_attr('tag_end', default => '}', inherit => 'scalar_copy'); |
|
15 |
+ |
|
16 |
+__PACKAGE__->dual_attr('tag_syntax', inherit => 'scalar_copy'); |
|
17 |
+ |
|
18 |
+__PACKAGE__->add_tag_processor( |
|
19 |
+ '?' => \&DBIx::Custom::SQLTemplate::TagProcessors::expand_basic_tag, |
|
20 |
+ '=' => \&DBIx::Custom::SQLTemplate::TagProcessors::expand_basic_tag, |
|
21 |
+ '<>' => \&DBIx::Custom::SQLTemplate::TagProcessors::expand_basic_tag, |
|
22 |
+ '>' => \&DBIx::Custom::SQLTemplate::TagProcessors::expand_basic_tag, |
|
23 |
+ '<' => \&DBIx::Custom::SQLTemplate::TagProcessors::expand_basic_tag, |
|
24 |
+ '>=' => \&DBIx::Custom::SQLTemplate::TagProcessors::expand_basic_tag, |
|
25 |
+ '<=' => \&DBIx::Custom::SQLTemplate::TagProcessors::expand_basic_tag, |
|
26 |
+ 'like' => \&DBIx::Custom::SQLTemplate::TagProcessors::expand_basic_tag, |
|
27 |
+ 'in' => \&DBIx::Custom::SQLTemplate::TagProcessors::expand_in_tag, |
|
28 |
+ 'insert' => \&DBIx::Custom::SQLTemplate::TagProcessors::expand_insert_tag, |
|
29 |
+ 'update' => \&DBIx::Custom::SQLTemplate::TagProcessors::expand_update_tag |
|
30 |
+); |
|
31 |
+ |
|
32 |
+__PACKAGE__->tag_syntax(<< 'EOS'); |
|
33 |
+[tag] [expand] |
|
34 |
+{? name} ? |
|
35 |
+{= name} name = ? |
|
36 |
+{<> name} name <> ? |
|
37 |
+ |
|
38 |
+{< name} name < ? |
|
39 |
+{> name} name > ? |
|
40 |
+{>= name} name >= ? |
|
41 |
+{<= name} name <= ? |
|
42 |
+ |
|
43 |
+{like name} name like ? |
|
44 |
+{in name number} name in [?, ?, ..] |
|
45 |
+ |
|
46 |
+{insert key1 key2} (key1, key2) values (?, ?) |
|
47 |
+{update key1 key2} set key1 = ?, key2 = ? |
|
48 |
+EOS |
|
49 |
+ |
|
50 |
+ |
|
51 |
+sub add_tag_processor { |
|
52 |
+ my $invocant = shift; |
|
53 |
+ my $tag_processors = ref $_[0] eq 'HASH' ? $_[0] : {@_}; |
|
54 |
+ $invocant->tag_processors({%{$invocant->tag_processors}, %{$tag_processors}}); |
|
55 |
+ return $invocant; |
|
56 |
+} |
|
57 |
+ |
|
58 |
+sub clone { |
|
59 |
+ my $self = shift; |
|
60 |
+ my $new = $self->new; |
|
61 |
+ |
|
62 |
+ $new->tag_start($self->tag_start); |
|
63 |
+ $new->tag_end($self->tag_end); |
|
64 |
+ $new->tag_syntax($self->tag_syntax); |
|
65 |
+ $new->tag_processors({%{$self->tag_processors || {}}}); |
|
66 |
+ |
|
67 |
+ return $new; |
|
68 |
+} |
|
69 |
+ |
|
70 |
+sub create_query { |
|
71 |
+ my ($self, $template) = @_; |
|
72 |
+ |
|
73 |
+ # Parse template |
|
74 |
+ my $tree = $self->_parse_template($template); |
|
75 |
+ |
|
76 |
+ # Build query |
|
77 |
+ my $query = $self->_build_query($tree); |
|
78 |
+ |
|
79 |
+ return $query; |
|
80 |
+} |
|
81 |
+ |
|
82 |
+sub _parse_template { |
|
83 |
+ my ($self, $template) = @_; |
|
84 |
+ |
|
85 |
+ if (ref $template eq 'ARRAY') { |
|
86 |
+ $template = $template->[1]; |
|
87 |
+ } |
|
88 |
+ $template ||= ''; |
|
89 |
+ |
|
90 |
+ my $tree = []; |
|
91 |
+ |
|
92 |
+ # Tags |
|
93 |
+ my $tag_start = quotemeta $self->tag_start; |
|
94 |
+ my $tag_end = quotemeta $self->tag_end; |
|
95 |
+ |
|
96 |
+ # Tokenize |
|
97 |
+ my $state = 'text'; |
|
98 |
+ |
|
99 |
+ # Save original template |
|
100 |
+ my $original_template = $template; |
|
101 |
+ |
|
102 |
+ # Parse template |
|
103 |
+ while ($template =~ s/([^$tag_start]*?)$tag_start([^$tag_end].*?)$tag_end//sm) { |
|
104 |
+ my $text = $1; |
|
105 |
+ my $tag = $2; |
|
106 |
+ |
|
107 |
+ # Parse tree |
|
108 |
+ push @$tree, {type => 'text', tag_args => [$text]} if $text; |
|
109 |
+ |
|
110 |
+ if ($tag) { |
|
111 |
+ # Get tag name and arguments |
|
112 |
+ my ($tag_name, @tag_args) = split /\s+/, $tag; |
|
113 |
+ |
|
114 |
+ # Tag processor is exist? |
|
115 |
+ unless ($self->tag_processors->{$tag_name}) { |
|
116 |
+ my $tag_syntax = $self->tag_syntax; |
|
117 |
+ croak("Tag '{$tag}' in SQL template is not exist.\n\n" . |
|
118 |
+ "<SQL template tag syntax>\n" . |
|
119 |
+ "$tag_syntax\n" . |
|
120 |
+ "<Your SQL template>\n" . |
|
121 |
+ "$original_template\n\n"); |
|
122 |
+ } |
|
123 |
+ |
|
124 |
+ # Check tag arguments |
|
125 |
+ foreach my $tag_arg (@tag_args) { |
|
126 |
+ # Cannot cantain placehosder '?' |
|
127 |
+ croak("Tag '{t }' arguments cannot contain '?'") |
|
128 |
+ if $tag_arg =~ /\?/; |
|
129 |
+ } |
|
130 |
+ |
|
131 |
+ # Add tag to parsing tree |
|
132 |
+ push @$tree, {type => 'tag', tag_name => $tag_name, tag_args => [@tag_args]}; |
|
133 |
+ } |
|
134 |
+ } |
|
135 |
+ |
|
136 |
+ # Add text to parsing tree |
|
137 |
+ push @$tree, {type => 'text', tag_args => [$template]} if $template; |
|
138 |
+ |
|
139 |
+ return $tree; |
|
140 |
+} |
|
141 |
+ |
|
142 |
+sub _build_query { |
|
143 |
+ my ($self, $tree) = @_; |
|
144 |
+ |
|
145 |
+ # SQL |
|
146 |
+ my $sql = ''; |
|
147 |
+ |
|
148 |
+ # All parameter key infomation |
|
149 |
+ my $all_key_infos = []; |
|
150 |
+ |
|
151 |
+ # Build SQL |
|
152 |
+ foreach my $node (@$tree) { |
|
153 |
+ |
|
154 |
+ # Get type, tag name, and arguments |
|
155 |
+ my $type = $node->{type}; |
|
156 |
+ my $tag_name = $node->{tag_name}; |
|
157 |
+ my $tag_args = $node->{tag_args}; |
|
158 |
+ |
|
159 |
+ # Text |
|
160 |
+ if ($type eq 'text') { |
|
161 |
+ # Join text |
|
162 |
+ $sql .= $tag_args->[0]; |
|
163 |
+ } |
|
164 |
+ |
|
165 |
+ # Tag |
|
166 |
+ elsif ($type eq 'tag') { |
|
167 |
+ |
|
168 |
+ # Get tag processor |
|
169 |
+ my $tag_processor = $self->tag_processors->{$tag_name}; |
|
170 |
+ |
|
171 |
+ # Tag processor is code ref? |
|
172 |
+ croak("Tag processor '$tag_name' must be code reference") |
|
173 |
+ unless ref $tag_processor eq 'CODE'; |
|
174 |
+ |
|
175 |
+ # Expand tag using tag processor |
|
176 |
+ my ($expand, $key_infos) |
|
177 |
+ = $tag_processor->($tag_name, $tag_args); |
|
178 |
+ |
|
179 |
+ # Check tag processor return value |
|
180 |
+ croak("Tag processor '$tag_name' must return (\$expand, \$key_infos)") |
|
181 |
+ if !defined $expand || ref $key_infos ne 'ARRAY'; |
|
182 |
+ |
|
183 |
+ # Check placeholder count |
|
184 |
+ croak("Placeholder count in SQL created by tag processor '$tag_name' " . |
|
185 |
+ "must be same as key informations count") |
|
186 |
+ unless $self->_placeholder_count($expand) eq @$key_infos; |
|
187 |
+ |
|
188 |
+ # Add key information |
|
189 |
+ push @$all_key_infos, @$key_infos; |
|
190 |
+ |
|
191 |
+ # Join expand tag to SQL |
|
192 |
+ $sql .= $expand; |
|
193 |
+ } |
|
194 |
+ } |
|
195 |
+ |
|
196 |
+ # Add semicolon |
|
197 |
+ $sql .= ';' unless $sql =~ /;$/; |
|
198 |
+ |
|
199 |
+ # Query |
|
200 |
+ my $query = DBIx::Custom::Query->new(sql => $sql, key_infos => $all_key_infos); |
|
201 |
+ |
|
202 |
+ return $query; |
|
203 |
+} |
|
204 |
+ |
|
205 |
+sub _placeholder_count { |
|
206 |
+ my ($self, $expand) = @_; |
|
207 |
+ $expand ||= ''; |
|
208 |
+ |
|
209 |
+ my $count = 0; |
|
210 |
+ my $pos = -1; |
|
211 |
+ while (($pos = index($expand, '?', $pos + 1)) != -1) { |
|
212 |
+ $count++; |
|
213 |
+ } |
|
214 |
+ return $count; |
|
215 |
+} |
|
216 |
+ |
|
217 |
+1; |
|
218 |
+ |
|
219 |
+package DBIx::Custom::SQLTemplate::TagProcessors; |
|
220 |
+ |
|
221 |
+use strict; |
|
222 |
+use warnings; |
|
223 |
+ |
|
224 |
+use Carp 'croak'; |
|
225 |
+use DBIx::Custom::KeyInfo; |
|
226 |
+ |
|
227 |
+sub expand_basic_tag { |
|
228 |
+ my ($tag_name, $tag_args) = @_; |
|
229 |
+ |
|
230 |
+ # Key |
|
231 |
+ my $column = $tag_args->[0]; |
|
232 |
+ |
|
233 |
+ # Key is not exist |
|
234 |
+ croak("You must be pass key as argument to tag '{$tag_name }'") |
|
235 |
+ unless $column; |
|
236 |
+ |
|
237 |
+ # Expanded tag |
|
238 |
+ my $expand = $tag_name eq '?' |
|
239 |
+ ? '?' |
|
240 |
+ : "$column $tag_name ?"; |
|
241 |
+ |
|
242 |
+ return ($expand, [{column => $column}]); |
|
243 |
+} |
|
244 |
+ |
|
245 |
+sub expand_in_tag { |
|
246 |
+ my ($tag_name, $tag_args) = @_; |
|
247 |
+ my ($column, $placeholder_count) = @$tag_args; |
|
248 |
+ |
|
249 |
+ # Key must be specified |
|
250 |
+ croak("You must be pass key as first argument of tag '{$tag_name }'\n" . |
|
251 |
+ "Usage: {$tag_name \$key \$placeholder_count}") |
|
252 |
+ unless $column; |
|
253 |
+ |
|
254 |
+ # Place holder count must be specified |
|
255 |
+ croak("You must be pass placeholder count as second argument of tag '{$tag_name }'\n" . |
|
256 |
+ "Usage: {$tag_name \$key \$placeholder_count}") |
|
257 |
+ if !$placeholder_count || $placeholder_count =~ /\D/; |
|
258 |
+ |
|
259 |
+ # Expand tag |
|
260 |
+ my $expand = "$column $tag_name ("; |
|
261 |
+ for (my $i = 0; $i < $placeholder_count; $i++) { |
|
262 |
+ $expand .= '?, '; |
|
263 |
+ } |
|
264 |
+ |
|
265 |
+ $expand =~ s/, $//; |
|
266 |
+ $expand .= ')'; |
|
267 |
+ |
|
268 |
+ # Create parameter key infomations |
|
269 |
+ my $key_infos = []; |
|
270 |
+ for (my $i = 0; $i < $placeholder_count; $i++) { |
|
271 |
+ |
|
272 |
+ # Add parameter key infos |
|
273 |
+ push @$key_infos, {column => $column, pos => $i}; |
|
274 |
+ } |
|
275 |
+ |
|
276 |
+ return ($expand, $key_infos); |
|
277 |
+} |
|
278 |
+ |
|
279 |
+sub expand_insert_tag { |
|
280 |
+ my ($tag_name, $columns) = @_; |
|
281 |
+ |
|
282 |
+ # Insert key (k1, k2, k3, ..) |
|
283 |
+ my $insert_keys = '('; |
|
284 |
+ |
|
285 |
+ # placeholder (?, ?, ?, ..) |
|
286 |
+ my $place_holders = '('; |
|
287 |
+ |
|
288 |
+ foreach my $column (@$columns) { |
|
289 |
+ |
|
290 |
+ # Join insert column |
|
291 |
+ $insert_keys .= "$column, "; |
|
292 |
+ |
|
293 |
+ # Join place holder |
|
294 |
+ $place_holders .= "?, "; |
|
295 |
+ } |
|
296 |
+ |
|
297 |
+ # Delete last ', ' |
|
298 |
+ $insert_keys =~ s/, $//; |
|
299 |
+ |
|
300 |
+ # Close |
|
301 |
+ $insert_keys .= ')'; |
|
302 |
+ $place_holders =~ s/, $//; |
|
303 |
+ $place_holders .= ')'; |
|
304 |
+ |
|
305 |
+ # Expand tag |
|
306 |
+ my $expand = "$insert_keys values $place_holders"; |
|
307 |
+ |
|
308 |
+ # Create parameter key infomations |
|
309 |
+ my $key_infos = []; |
|
310 |
+ foreach my $column (@$columns) { |
|
311 |
+ push @$key_infos, {column => $column}; |
|
312 |
+ } |
|
313 |
+ |
|
314 |
+ return ($expand, $key_infos); |
|
315 |
+} |
|
316 |
+ |
|
317 |
+sub expand_update_tag { |
|
318 |
+ my ($tag_name, $columns) = @_; |
|
319 |
+ |
|
320 |
+ # Expanded tag |
|
321 |
+ my $expand = 'set '; |
|
322 |
+ |
|
323 |
+ foreach my $column (@$columns) { |
|
324 |
+ |
|
325 |
+ # Join key and placeholder |
|
326 |
+ $expand .= "$column = ?, "; |
|
327 |
+ } |
|
328 |
+ |
|
329 |
+ # Delete last ', ' |
|
330 |
+ $expand =~ s/, $//; |
|
331 |
+ |
|
332 |
+ my $key_infos = []; |
|
333 |
+ foreach my $column (@$columns) { |
|
334 |
+ push @$key_infos, {column => $column}; |
|
335 |
+ } |
|
336 |
+ |
|
337 |
+ return ($expand, $key_infos); |
|
338 |
+} |
|
339 |
+ |
|
340 |
+package DBIx::Custom::SQLTemplate; |
|
341 |
+ |
|
342 |
+1; |
|
343 |
+ |
|
344 |
+=head1 NAME |
|
345 |
+ |
|
346 |
+DBIx::Custom::SQLTemplate - DBIx::Custom SQL Template |
|
347 |
+ |
|
348 |
+=head1 SYNOPSIS |
|
349 |
+ |
|
350 |
+ my $sql_tmpl = DBIx::Custom::SQLTemplate->new; |
|
351 |
+ |
|
352 |
+ my $tmpl = "select from table {= k1} && {<> k2} || {like k3}"; |
|
353 |
+ my $param = {k1 => 1, k2 => 2, k3 => 3}; |
|
354 |
+ |
|
355 |
+ my $query = $sql_template->create_query($tmpl); |
|
356 |
+ |
|
357 |
+=head1 ATTRIBUTES |
|
358 |
+ |
|
359 |
+=head2 tag_processors |
|
360 |
+ |
|
361 |
+ $sql_tmpl = $sql_tmpl->tag_processors($name1 => $tag_processor1 |
|
362 |
+ $name2 => $tag_processor2); |
|
363 |
+ $tag_processors = $sql_tmpl->tag_processors; |
|
364 |
+ |
|
365 |
+=head2 tag_start |
|
366 |
+ |
|
367 |
+ $sql_tmpl = $sql_tmpl->tag_start('{'); |
|
368 |
+ $tag_start = $sql_tmpl->tag_start; |
|
369 |
+ |
|
370 |
+Default is '{' |
|
371 |
+ |
|
372 |
+=head2 tag_end |
|
373 |
+ |
|
374 |
+ $sql_tmpl = $sql_tmpl->tag_start('}'); |
|
375 |
+ $tag_end = $sql_tmpl->tag_start; |
|
376 |
+ |
|
377 |
+Default is '}' |
|
378 |
+ |
|
379 |
+=head2 tag_syntax |
|
380 |
+ |
|
381 |
+ $sql_tmpl = $sql_tmpl->tag_syntax($tag_syntax); |
|
382 |
+ $tag_syntax = $sql_tmpl->tag_syntax; |
|
383 |
+ |
|
384 |
+=head1 METHODS |
|
385 |
+ |
|
386 |
+This class is L<Object::Simple> subclass. |
|
387 |
+You can use all methods of L<Object::Simple> |
|
388 |
+ |
|
389 |
+=head2 create_query |
|
390 |
+ |
|
391 |
+Create L<DBIx::Custom::Query> object parsing SQL template |
|
392 |
+ |
|
393 |
+ $query = $sql_tmpl->create_query($tmpl); |
|
394 |
+ |
|
395 |
+ # Sample |
|
396 |
+ $query = $sql_tmpl->create_sql( |
|
397 |
+ "select * from table where {= title} && {like author} || {<= price}") |
|
398 |
+ |
|
399 |
+ # Expanded |
|
400 |
+ $qeury->sql : "select * from table where title = ? && author like ? price <= ?;" |
|
401 |
+ $query->key_infos : [['title'], ['author'], ['price']] |
|
402 |
+ |
|
403 |
+ # Sample with table name |
|
404 |
+ ($sql, @bind_values) = $sql_tmpl->create_sql( |
|
405 |
+ "select * from table where {= table.title} && {like table.author}", |
|
406 |
+ {table => {title => 'Perl', author => '%Taro%'}} |
|
407 |
+ ) |
|
408 |
+ |
|
409 |
+ # Expanded |
|
410 |
+ $query->sql : "select * from table where table.title = ? && table.title like ?;" |
|
411 |
+ $query->key_infos :[ [['table.title'],['table', 'title']], |
|
412 |
+ [['table.author'],['table', 'author']] ] |
|
413 |
+ |
|
414 |
+This method create query using by L<DBIx::Custom>. |
|
415 |
+query has two infomation |
|
416 |
+ |
|
417 |
+ 1. sql : SQL |
|
418 |
+ 2. key_infos : Parameter access key information |
|
419 |
+ |
|
420 |
+=head2 add_tag_processor |
|
421 |
+ |
|
422 |
+Add tag processor |
|
423 |
+ |
|
424 |
+ $sql_tmpl = $sql_tmpl->add_tag_processor($tag_processor); |
|
425 |
+ |
|
426 |
+The following is add_tag_processor sample |
|
427 |
+ |
|
428 |
+ $sql_tmpl->add_tag_processor( |
|
429 |
+ '?' => sub { |
|
430 |
+ my ($tag_name, $tag_args) = @_; |
|
431 |
+ |
|
432 |
+ my $key1 = $tag_args->[0]; |
|
433 |
+ my $key2 = $tag_args->[1]; |
|
434 |
+ |
|
435 |
+ my $key_infos = []; |
|
436 |
+ |
|
437 |
+ # Expand tag and create key informations |
|
438 |
+ |
|
439 |
+ # Return expand tags and key informations |
|
440 |
+ return ($expand, $key_infos); |
|
441 |
+ } |
|
442 |
+ ); |
|
443 |
+ |
|
444 |
+Tag processor recieve 2 argument |
|
445 |
+ |
|
446 |
+ 1. Tag name (?, =, <>, or etc) |
|
447 |
+ 2. Tag arguments (arg1 and arg2 in {tag_name arg1 arg2}) |
|
448 |
+ |
|
449 |
+Tag processor return 2 value |
|
450 |
+ |
|
451 |
+ 1. Expanded Tag (For exsample, '{= title}' is expanded to 'title = ?') |
|
452 |
+ 2. Key infomations |
|
453 |
+ |
|
454 |
+You must be return expanded tag and key infomations. |
|
455 |
+ |
|
456 |
+Key information is a little complex. so I will explan this in future. |
|
457 |
+ |
|
458 |
+If you want to know more, Please see DBIx::Custom::SQLTemplate source code. |
|
459 |
+ |
|
460 |
+=head2 clone |
|
461 |
+ |
|
462 |
+Clone DBIx::Custom::SQLTemplate object |
|
463 |
+ |
|
464 |
+ $clone = $sql_tmpl->clone; |
|
465 |
+ |
|
466 |
+=head1 Available Tags |
|
467 |
+ |
|
468 |
+Available Tags |
|
469 |
+ |
|
470 |
+ [tag] [expand] |
|
471 |
+ {? name} ? |
|
472 |
+ {= name} name = ? |
|
473 |
+ {<> name} name <> ? |
|
474 |
+ |
|
475 |
+ {< name} name < ? |
|
476 |
+ {> name} name > ? |
|
477 |
+ {>= name} name >= ? |
|
478 |
+ {<= name} name <= ? |
|
479 |
+ |
|
480 |
+ {like name} name like ? |
|
481 |
+ {in name} name in [?, ?, ..] |
|
482 |
+ |
|
483 |
+ {insert} (key1, key2, key3) values (?, ?, ?) |
|
484 |
+ {update} set key1 = ?, key2 = ?, key3 = ? |
|
485 |
+ |
|
486 |
+ |
|
487 |
+The following is insert SQL sample |
|
488 |
+ |
|
489 |
+ $query = $sql_tmpl->create_sql( |
|
490 |
+ "insert into table {insert key1 key2}" |
|
491 |
+ ); |
|
492 |
+ |
|
493 |
+ # Expanded |
|
494 |
+ $query->sql : "insert into table (key1, key2) values (?, ?)" |
|
495 |
+ |
|
496 |
+The following is update SQL sample |
|
497 |
+ |
|
498 |
+ $query = $sql_tmpl->create_sql( |
|
499 |
+ "update table {update key1 key2} where {= key3}" |
|
500 |
+ ); |
|
501 |
+ |
|
502 |
+ # Expanded |
|
503 |
+ $query->sql : "update table set key1 = ?, key2 = ? where key3 = ?;" |
|
504 |
+ |
|
505 |
+=cut |
|
506 |
+ |
... | ... |
@@ -7,7 +7,7 @@ use base 'DBIx::Custom::Basic'; |
7 | 7 |
use Carp 'croak'; |
8 | 8 |
|
9 | 9 |
# Add format |
10 |
-__PACKAGE__->add_format( |
|
10 |
+__PACKAGE__->resist_format( |
|
11 | 11 |
datetime => __PACKAGE__->formats->{SQL99_datetime}, |
12 | 12 |
date => __PACKAGE__->formats->{SQL99_date}, |
13 | 13 |
time => __PACKAGE__->formats->{SQL99_time}, |
... | ... |
@@ -260,7 +260,7 @@ $rows = $result->fetch_hash_all; |
260 | 260 |
is_deeply($rows, [{key1 => 2, key2 => 4}], "$test : query_filter"); |
261 | 261 |
|
262 | 262 |
|
263 |
-test 'DBIx::Custom::SQL::Template basic tag'; |
|
263 |
+test 'DBIx::Custom::SQLTemplate basic tag'; |
|
264 | 264 |
$dbi->do($DROP_TABLE->{0}); |
265 | 265 |
$dbi->do($CREATE_TABLE->{1}); |
266 | 266 |
$sth = $dbi->prepare("insert into table1 (key1, key2, key3, key4, key5) values (?, ?, ?, ?, ?);"); |
... | ... |
@@ -304,7 +304,7 @@ $rows = $result->fetch_hash_all; |
304 | 304 |
is_deeply($rows, [{key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5}], "$test : basic tag2 with table dot"); |
305 | 305 |
|
306 | 306 |
|
307 |
-test 'DIB::Custom::SQL::Template in tag'; |
|
307 |
+test 'DIB::Custom::SQLTemplate in tag'; |
|
308 | 308 |
$dbi->do($DROP_TABLE->{0}); |
309 | 309 |
$dbi->do($CREATE_TABLE->{1}); |
310 | 310 |
$sth = $dbi->prepare("insert into table1 (key1, key2, key3, key4, key5) values (?, ?, ?, ?, ?);"); |
... | ... |
@@ -330,7 +330,7 @@ $rows = $result->fetch_hash_all; |
330 | 330 |
is_deeply($rows, [{key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5}], "$test : with table dot"); |
331 | 331 |
|
332 | 332 |
|
333 |
-test 'DBIx::Custom::SQL::Template insert tag'; |
|
333 |
+test 'DBIx::Custom::SQLTemplate insert tag'; |
|
334 | 334 |
$dbi->do("delete from table1"); |
335 | 335 |
$insert_tmpl = 'insert into table1 {insert key1 key2 key3 key4 key5}'; |
336 | 336 |
$dbi->query($insert_tmpl, {key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5}); |
... | ... |
@@ -346,7 +346,7 @@ $result = $dbi->query($SELECT_TMPLS->{0}); |
346 | 346 |
$rows = $result->fetch_hash_all; |
347 | 347 |
is_deeply($rows, [{key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5}], "$test : with table name"); |
348 | 348 |
|
349 |
-test 'DBIx::Custom::SQL::Template update tag'; |
|
349 |
+test 'DBIx::Custom::SQLTemplate update tag'; |
|
350 | 350 |
$dbi->do("delete from table1"); |
351 | 351 |
$insert_tmpl = "insert into table1 {insert key1 key2 key3 key4 key5}"; |
352 | 352 |
$dbi->query($insert_tmpl, {key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5}); |
... | ... |
@@ -0,0 +1,15 @@ |
1 |
+#!perl -T |
|
2 |
+ |
|
3 |
+use Test::More tests => 7; |
|
4 |
+ |
|
5 |
+BEGIN { |
|
6 |
+ use_ok( 'DBIx::Custom' ); |
|
7 |
+ use_ok( 'DBIx::Custom::Basic' ); |
|
8 |
+ use_ok( 'DBIx::Custom::MySQL' ); |
|
9 |
+ use_ok( 'DBIx::Custom::Query' ); |
|
10 |
+ use_ok( 'DBIx::Custom::Result' ); |
|
11 |
+ use_ok( 'DBIx::Custom::SQLTemplate' ); |
|
12 |
+ use_ok( 'DBIx::Custom::SQLite' ); |
|
13 |
+} |
|
14 |
+ |
|
15 |
+diag( "Testing DBIx::Custom $DBIx::Custom::VERSION, Perl $], $^X" ); |
... | ... |
@@ -0,0 +1,51 @@ |
1 |
+#!perl -T |
|
2 |
+ |
|
3 |
+use strict; |
|
4 |
+use warnings; |
|
5 |
+use Test::More tests => 3; |
|
6 |
+ |
|
7 |
+sub not_in_file_ok { |
|
8 |
+ my ($filename, %regex) = @_; |
|
9 |
+ open( my $fh, '<', $filename ) |
|
10 |
+ or die "couldn't open $filename for reading: $!"; |
|
11 |
+ |
|
12 |
+ my %violated; |
|
13 |
+ |
|
14 |
+ while (my $line = <$fh>) { |
|
15 |
+ while (my ($desc, $regex) = each %regex) { |
|
16 |
+ if ($line =~ $regex) { |
|
17 |
+ push @{$violated{$desc}||=[]}, $.; |
|
18 |
+ } |
|
19 |
+ } |
|
20 |
+ } |
|
21 |
+ |
|
22 |
+ if (%violated) { |
|
23 |
+ fail("$filename contains boilerplate text"); |
|
24 |
+ diag "$_ appears on lines @{$violated{$_}}" for keys %violated; |
|
25 |
+ } else { |
|
26 |
+ pass("$filename contains no boilerplate text"); |
|
27 |
+ } |
|
28 |
+} |
|
29 |
+ |
|
30 |
+sub module_boilerplate_ok { |
|
31 |
+ my ($module) = @_; |
|
32 |
+ not_in_file_ok($module => |
|
33 |
+ 'the great new $MODULENAME' => qr/ - The great new /, |
|
34 |
+ 'boilerplate description' => qr/Quick summary of what the module/, |
|
35 |
+ 'stub function definition' => qr/function[12]/, |
|
36 |
+ ); |
|
37 |
+} |
|
38 |
+ |
|
39 |
+ |
|
40 |
+ not_in_file_ok(README => |
|
41 |
+ "The README is used..." => qr/The README is used/, |
|
42 |
+ "'version information here'" => qr/to provide version information/, |
|
43 |
+ ); |
|
44 |
+ |
|
45 |
+ not_in_file_ok(Changes => |
|
46 |
+ "placeholder date/time" => qr(Date/time) |
|
47 |
+ ); |
|
48 |
+ |
|
49 |
+ module_boilerplate_ok('lib/DBIx/Custom.pm'); |
|
50 |
+ |
|
51 |
+ |
... | ... |
@@ -0,0 +1,55 @@ |
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 |
+ |
... | ... |
@@ -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,127 @@ |
1 |
+use Test::More 'no_plan'; |
|
2 |
+use strict; |
|
3 |
+use warnings; |
|
4 |
+ |
|
5 |
+use DBIx::Custom; |
|
6 |
+use DBIx::Custom::SQLTemplate; |
|
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::SQLTemplate->new->tag_start(0), |
|
17 |
+ 1 => DBIx::Custom::SQLTemplate->new->tag_start(1), |
|
18 |
+ 2 => DBIx::Custom::SQLTemplate->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 |
+ default_bind_filter => 'f', |
|
34 |
+ default_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}, default_bind_filter => 'f', |
|
40 |
+ default_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 |
+ ->filters({f => 3}) |
|
52 |
+ ->formats({f => 3}) |
|
53 |
+ ; |
|
54 |
+} |
|
55 |
+$dbi = DBIx::Custom::T1->new( |
|
56 |
+ filters => { |
|
57 |
+ fo => 30, |
|
58 |
+ }, |
|
59 |
+ formats => { |
|
60 |
+ fo => 30, |
|
61 |
+ }, |
|
62 |
+); |
|
63 |
+is_deeply(scalar $dbi->filters, {fo => 30}, "$test : filters"); |
|
64 |
+is_deeply(scalar $dbi->formats, {fo => 30}, "$test : formats"); |
|
65 |
+ |
|
66 |
+test 'Sub class constructor default'; |
|
67 |
+$dbi = DBIx::Custom::T1->new; |
|
68 |
+is_deeply($dbi->filters, {f => 3}, "$test : filters"); |
|
69 |
+is_deeply($dbi->formats, {f => 3}, "$test : formats"); |
|
70 |
+isa_ok($dbi, 'DBIx::Custom::T1'); |
|
71 |
+ |
|
72 |
+ |
|
73 |
+test 'Sub sub class constructor default'; |
|
74 |
+{ |
|
75 |
+ package DBIx::Custom::T1_2; |
|
76 |
+ use base 'DBIx::Custom::T1'; |
|
77 |
+} |
|
78 |
+$dbi = DBIx::Custom::T1_2->new; |
|
79 |
+is_deeply(scalar $dbi->filters, {f => 3}, "$test : filters"); |
|
80 |
+is_deeply(scalar $dbi->formats, {f => 3}, "$test : formats"); |
|
81 |
+isa_ok($dbi, 'DBIx::Custom::T1_2'); |
|
82 |
+ |
|
83 |
+ |
|
84 |
+test 'Customized sub class constructor default'; |
|
85 |
+{ |
|
86 |
+ package DBIx::Custom::T1_3; |
|
87 |
+ use base 'DBIx::Custom::T1'; |
|
88 |
+ |
|
89 |
+ __PACKAGE__ |
|
90 |
+ ->filters({fo => 30}) |
|
91 |
+ ->formats({fo => 30}) |
|
92 |
+ ; |
|
93 |
+} |
|
94 |
+$dbi = DBIx::Custom::T1_3->new; |
|
95 |
+is_deeply(scalar $dbi->filters, {fo => 30}, "$test : filters"); |
|
96 |
+is_deeply(scalar $dbi->formats, {fo => 30}, "$test : formats"); |
|
97 |
+isa_ok($dbi, 'DBIx::Custom::T1_3'); |
|
98 |
+ |
|
99 |
+ |
|
100 |
+test 'Customized sub class constructor'; |
|
101 |
+$dbi = DBIx::Custom::T1_3->new( |
|
102 |
+ filters => { |
|
103 |
+ f => 3, |
|
104 |
+ }, |
|
105 |
+ formats => { |
|
106 |
+ f => 3, |
|
107 |
+ }, |
|
108 |
+); |
|
109 |
+is_deeply($dbi->filters, {f => 3}, "$test : filters"); |
|
110 |
+is_deeply($dbi->formats, {f => 3}, "$test : formats"); |
|
111 |
+isa_ok($dbi, 'DBIx::Custom'); |
|
112 |
+ |
|
113 |
+ |
|
114 |
+test 'resist_filters'; |
|
115 |
+$dbi = DBIx::Custom->new; |
|
116 |
+$dbi->resist_filter(a => sub {1}); |
|
117 |
+is($dbi->filters->{a}->(), 1, $test); |
|
118 |
+ |
|
119 |
+test 'resist_formats'; |
|
120 |
+$dbi = DBIx::Custom->new; |
|
121 |
+$dbi->resist_format(a => sub {1}); |
|
122 |
+is($dbi->formats->{a}->(), 1, $test); |
|
123 |
+ |
|
124 |
+test 'Accessor'; |
|
125 |
+$dbi = DBIx::Custom->new; |
|
126 |
+$dbi->options({opt1 => 1, opt2 => 2}); |
|
127 |
+is_deeply(scalar $dbi->options, {opt1 => 1, opt2 => 2}, "$test : options"); |
... | ... |
@@ -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,29 @@ |
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 |
+ query_filter => 'c', |
|
21 |
+ sth => 'e', |
|
22 |
+ fetch_filter => 'f', |
|
23 |
+); |
|
24 |
+ |
|
25 |
+is($query->sql, 'a', "$test : sql"); |
|
26 |
+is($query->key_infos, 'b', "$test : key_infos "); |
|
27 |
+is($query->query_filter, 'c', "$test : query_filter"); |
|
28 |
+is($query->sth, 'e', "$test : sth"); |
|
29 |
+ |
... | ... |
@@ -0,0 +1,248 @@ |
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 |
+test 'finish'; |
|
231 |
+$result = query($dbh, $sql); |
|
232 |
+$result->fetch; |
|
233 |
+$result->finish; |
|
234 |
+ok(!$result->fetch, $test); |
|
235 |
+ |
|
236 |
+test 'error'; # Cannot real test |
|
237 |
+$result = query($dbh, $sql); |
|
238 |
+$sth = $result->sth; |
|
239 |
+ |
|
240 |
+@error = $result->error; |
|
241 |
+is(scalar @error, 3, "$test list context count"); |
|
242 |
+is($error[0], $sth->errstr, "$test list context errstr"); |
|
243 |
+is($error[1], $sth->err, "$test list context err"); |
|
244 |
+is($error[2], $sth->state, "$test list context state"); |
|
245 |
+ |
|
246 |
+$error = $result->error; |
|
247 |
+is($error, $sth->errstr, "$test scalar context"); |
|
248 |
+ |
... | ... |
@@ -0,0 +1,198 @@ |
1 |
+use strict; |
|
2 |
+use warnings; |
|
3 |
+ |
|
4 |
+use Test::More 'no_plan'; |
|
5 |
+ |
|
6 |
+use DBIx::Custom::SQLTemplate; |
|
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 |
+ {table => '', column => 'k1', id => ''}, |
|
29 |
+ {table => '', column => 'k2', id => ''}, |
|
30 |
+ {table => '', column => 'k3', id => ''}, |
|
31 |
+ {table => '', column => 'k4', id => ''}, |
|
32 |
+ {table => '', column => 'k5', id => ''}, |
|
33 |
+ {table => '', column => 'k6', id => ''}, |
|
34 |
+ {table => '', column => 'k7', id => ''}, |
|
35 |
+ {table => '', column => 'k8', id => ''}, |
|
36 |
+ ], |
|
37 |
+ }, |
|
38 |
+ { |
|
39 |
+ name => 'placeholder in', |
|
40 |
+ tmpl => "{in k1 3};", |
|
41 |
+ sql_expected => "k1 in (?, ?, ?);", |
|
42 |
+ key_infos_expected => [ |
|
43 |
+ {table => '', column => 'k1', id => '', pos => 0}, |
|
44 |
+ {table => '', column => 'k1', id => '', pos => 1}, |
|
45 |
+ {table => '', column => 'k1', id => '', pos => 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 |
+ {table => 'a', column => 'k1', id => ''}, |
|
56 |
+ {table => 'a', column => 'k2', id => ''}, |
|
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 |
+ {table => 'a', column => 'k1', id => '', pos => 0}, |
|
65 |
+ {table => 'a', column => 'k1', id => '', pos => 1}, |
|
66 |
+ {table => 'b', column => 'k2', id => '', pos => 0}, |
|
67 |
+ {table => 'b', column => 'k2', id => '', pos => 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::SQLTemplate->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::SQLTemplate->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::SQLTemplate'); |
|
104 |
+ |
|
105 |
+ |
|
106 |
+test "Tag processor error case"; |
|
107 |
+$sql_tmpl = DBIx::Custom::SQLTemplate->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::SQLTemplate->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::SQLTemplate->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,78 @@ |
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->insert('table1', {key1 => 'a', key2 => 2}); |
|
43 |
+$rows = $dbi->select('table1', {where => {key1 => 'a'}})->fetch_hash_all; |
|
44 |
+is_deeply($rows, [{key1 => 'a', key2 => 2}], "$test : select rows"); |
|
45 |
+ |
|
46 |
+test 'connect_memory error'; |
|
47 |
+eval{$dbi->connect_memory}; |
|
48 |
+like($@, qr/Already connected/, "$test : already connected"); |
|
49 |
+ |
|
50 |
+test 'reconnect_memory'; |
|
51 |
+$dbi = DBIx::Custom::SQLite->new; |
|
52 |
+$dbi->reconnect_memory; |
|
53 |
+$ret_val = $dbi->do($CREATE_TABLE->{0}); |
|
54 |
+ok(defined $ret_val, "$test : connect first"); |
|
55 |
+$dbi->reconnect_memory; |
|
56 |
+$ret_val = $dbi->do($CREATE_TABLE->{2}); |
|
57 |
+ok(defined $ret_val, "$test : connect first"); |
|
58 |
+ |
|
59 |
+test 'connect'; |
|
60 |
+$db_file = 't/test.db'; |
|
61 |
+unlink $db_file if -f $db_file; |
|
62 |
+$dbi = DBIx::Custom::SQLite->new(database => $db_file); |
|
63 |
+$dbi->connect; |
|
64 |
+ok(-f $db_file, "$test : database file"); |
|
65 |
+$ret_val = $dbi->do($CREATE_TABLE->{0}); |
|
66 |
+ok(defined $ret_val, "$test : database"); |
|
67 |
+$dbi->disconnect; |
|
68 |
+unlink $db_file if -f $db_file; |
|
69 |
+ |
|
70 |
+test 'last_insert_rowid'; |
|
71 |
+$dbi = DBIx::Custom::SQLite->new; |
|
72 |
+$dbi->connect_memory; |
|
73 |
+$ret_val = $dbi->do($CREATE_TABLE->{0}); |
|
74 |
+$dbi->insert('table1', {key1 => 1, key2 => 2}); |
|
75 |
+is($dbi->last_insert_rowid, 1, "$test: first"); |
|
76 |
+$dbi->insert('table1', {key1 => 1, key2 => 2}); |
|
77 |
+is($dbi->last_insert_rowid, 2, "$test: second"); |
|
78 |
+$dbi->disconnect; |
... | ... |
@@ -0,0 +1,18 @@ |
1 |
+use strict; |
|
2 |
+use warnings; |
|
3 |
+use Test::More; |
|
4 |
+ |
|
5 |
+# Ensure a recent version of Test::Pod::Coverage |
|
6 |
+my $min_tpc = 1.08; |
|
7 |
+eval "use Test::Pod::Coverage $min_tpc"; |
|
8 |
+plan skip_all => "Test::Pod::Coverage $min_tpc required for testing POD coverage" |
|
9 |
+ if $@; |
|
10 |
+ |
|
11 |
+# Test::Pod::Coverage doesn't require a minimum Pod::Coverage version, |
|
12 |
+# but older versions don't recognize some common documentation styles |
|
13 |
+my $min_pc = 0.18; |
|
14 |
+eval "use Pod::Coverage $min_pc"; |
|
15 |
+plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage" |
|
16 |
+ if $@; |
|
17 |
+ |
|
18 |
+all_pod_coverage_ok(); |
... | ... |
@@ -0,0 +1,12 @@ |
1 |
+#!perl -T |
|
2 |
+ |
|
3 |
+use strict; |
|
4 |
+use warnings; |
|
5 |
+use Test::More; |
|
6 |
+ |
|
7 |
+# Ensure a recent version of Test::Pod |
|
8 |
+my $min_tp = 1.22; |
|
9 |
+eval "use Test::Pod $min_tp"; |
|
10 |
+plan skip_all => "Test::Pod $min_tp required for testing POD" if $@; |
|
11 |
+ |
|
12 |
+all_pod_files_ok(); |