... | ... |
@@ -1,3 +1,8 @@ |
1 |
+0.1401 |
|
2 |
+ renamed fetch_rows to fetch_multi |
|
3 |
+ renamed fetch_hash_rows to fetch_hash_multi |
|
4 |
+0.1301 |
|
5 |
+ Changed many(not backword compatible) |
|
1 | 6 |
0.1201 |
2 | 7 |
Changed many(not backword compatible) |
3 | 8 |
0.1101 |
... | ... |
@@ -627,15 +627,15 @@ sub _add_query_cache { |
627 | 627 |
|
628 | 628 |
=head1 NAME |
629 | 629 |
|
630 |
-DBIx::Custom - Customizable DBI |
|
630 |
+DBIx::Custom - DBI with hash bind and filtering system |
|
631 | 631 |
|
632 | 632 |
=head1 VERSION |
633 | 633 |
|
634 |
-Version 0.1201 |
|
634 |
+Version 0.1301 |
|
635 | 635 |
|
636 | 636 |
=cut |
637 | 637 |
|
638 |
-our $VERSION = '0.1201'; |
|
638 |
+our $VERSION = '0.1301'; |
|
639 | 639 |
|
640 | 640 |
=head1 STATE |
641 | 641 |
|
... | ... |
@@ -658,17 +658,31 @@ This module is not stable. Method name and functionality will be change. |
658 | 658 |
$dbi->insert('books', {title => 'perl', author => 'Ken'}); |
659 | 659 |
|
660 | 660 |
# Update |
661 |
- $dbi->update('books', {title => 'aaa', author => 'Ken'}, {id => 5}); |
|
661 |
+ $dbi->update('books', {title => 'aaa', author => 'Ken'}, {where => {id => 5}}); |
|
662 | 662 |
|
663 | 663 |
# Delete |
664 |
- $dbi->delete('books', {author => 'Ken'}); |
|
664 |
+ $dbi->delete('books', {where => {author => 'Ken'}}); |
|
665 | 665 |
|
666 | 666 |
# Select |
667 |
- $dbi->select('books'); |
|
668 |
- $dbi->select('books', {author => 'taro'}); |
|
669 |
- $dbi->select('books', [qw/author title/], {author => 'Ken'}); |
|
670 |
- $dbi->select('books', [qw/author title/], {author => 'Ken'}, |
|
671 |
- 'order by id limit 1'); |
|
667 |
+ my $result = $dbi->select('books'); |
|
668 |
+ my $result = $dbi->select('books', {where => {author => 'taro'}}); |
|
669 |
+ |
|
670 |
+ my $result = $dbi->select( |
|
671 |
+ 'books', |
|
672 |
+ { |
|
673 |
+ columns => [qw/author title/], |
|
674 |
+ where => {author => 'Ken'} |
|
675 |
+ } |
|
676 |
+ ); |
|
677 |
+ |
|
678 |
+ my $result = $dbi->select( |
|
679 |
+ 'books', |
|
680 |
+ { |
|
681 |
+ columns => [qw/author title/], |
|
682 |
+ where => {author => 'Ken'}, |
|
683 |
+ append => 'order by id limit 1' |
|
684 |
+ } |
|
685 |
+ ); |
|
672 | 686 |
|
673 | 687 |
=head1 ATTRIBUTES |
674 | 688 |
|
... | ... |
@@ -1,82 +0,0 @@ |
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 |
... | ... |
@@ -96,7 +96,7 @@ sub fetch_hash_single { |
96 | 96 |
return wantarray ? %$row : $row; |
97 | 97 |
} |
98 | 98 |
|
99 |
-sub fetch_rows { |
|
99 |
+sub fetch_multi { |
|
100 | 100 |
my ($self, $count) = @_; |
101 | 101 |
|
102 | 102 |
# Not specified Row count |
... | ... |
@@ -117,7 +117,7 @@ sub fetch_rows { |
117 | 117 |
return wantarray ? @$rows : $rows; |
118 | 118 |
} |
119 | 119 |
|
120 |
-sub fetch_hash_rows { |
|
120 |
+sub fetch_hash_multi { |
|
121 | 121 |
my ($self, $count) = @_; |
122 | 122 |
|
123 | 123 |
# Not specified Row count |
... | ... |
@@ -279,29 +279,29 @@ The following is fetch_hash_single sample |
279 | 279 |
|
280 | 280 |
This method fetch only single row and finish statement handle |
281 | 281 |
|
282 |
-=head2 fetch_rows |
|
282 |
+=head2 fetch_multi |
|
283 | 283 |
|
284 | 284 |
Fetch rows |
285 | 285 |
|
286 |
- $rows = $result->fetch_rows($row_count); # array ref of array ref |
|
287 |
- @rows = $result->fetch_rows($row_count); # array of array ref |
|
286 |
+ $rows = $result->fetch_multi($row_count); # array ref of array ref |
|
287 |
+ @rows = $result->fetch_multi($row_count); # array of array ref |
|
288 | 288 |
|
289 |
-The following is fetch_rows sample |
|
289 |
+The following is fetch_multi sample |
|
290 | 290 |
|
291 |
- while(my $rows = $result->fetch_rows(10)) { |
|
291 |
+ while(my $rows = $result->fetch_multi(10)) { |
|
292 | 292 |
# do someting |
293 | 293 |
} |
294 | 294 |
|
295 |
-=head2 fetch_hash_rows |
|
295 |
+=head2 fetch_hash_multi |
|
296 | 296 |
|
297 | 297 |
Fetch rows as hash |
298 | 298 |
|
299 |
- $rows = $result->fetch_hash_rows($row_count); # array ref of hash ref |
|
300 |
- @rows = $result->fetch_hash_rows($row_count); # array of hash ref |
|
299 |
+ $rows = $result->fetch_hash_multi($row_count); # array ref of hash ref |
|
300 |
+ @rows = $result->fetch_hash_multi($row_count); # array of hash ref |
|
301 | 301 |
|
302 |
-The following is fetch_hash_rows sample |
|
302 |
+The following is fetch_hash_multi sample |
|
303 | 303 |
|
304 |
- while(my $rows = $result->fetch_hash_rows(10)) { |
|
304 |
+ while(my $rows = $result->fetch_hash_multi(10)) { |
|
305 | 305 |
# do someting |
306 | 306 |
} |
307 | 307 |
|
... | ... |
@@ -1,536 +0,0 @@ |
1 |
-package DBIx::Custom::SQL::Template; |
|
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__->attr('table'); |
|
11 |
-__PACKAGE__->dual_attr('tag_processors', default => sub { {} }, |
|
12 |
- inherit => 'hash_copy'); |
|
13 |
- |
|
14 |
-__PACKAGE__->dual_attr('tag_start', default => '{', inherit => 'scalar_copy'); |
|
15 |
-__PACKAGE__->dual_attr('tag_end', default => '}', inherit => 'scalar_copy'); |
|
16 |
- |
|
17 |
-__PACKAGE__->dual_attr('tag_syntax', inherit => 'scalar_copy'); |
|
18 |
- |
|
19 |
-__PACKAGE__->add_tag_processor( |
|
20 |
- '?' => \&DBIx::Custom::SQL::Template::TagProcessors::expand_basic_tag, |
|
21 |
- '=' => \&DBIx::Custom::SQL::Template::TagProcessors::expand_basic_tag, |
|
22 |
- '<>' => \&DBIx::Custom::SQL::Template::TagProcessors::expand_basic_tag, |
|
23 |
- '>' => \&DBIx::Custom::SQL::Template::TagProcessors::expand_basic_tag, |
|
24 |
- '<' => \&DBIx::Custom::SQL::Template::TagProcessors::expand_basic_tag, |
|
25 |
- '>=' => \&DBIx::Custom::SQL::Template::TagProcessors::expand_basic_tag, |
|
26 |
- '<=' => \&DBIx::Custom::SQL::Template::TagProcessors::expand_basic_tag, |
|
27 |
- 'like' => \&DBIx::Custom::SQL::Template::TagProcessors::expand_basic_tag, |
|
28 |
- 'in' => \&DBIx::Custom::SQL::Template::TagProcessors::expand_in_tag, |
|
29 |
- 'insert' => \&DBIx::Custom::SQL::Template::TagProcessors::expand_insert_tag, |
|
30 |
- 'update' => \&DBIx::Custom::SQL::Template::TagProcessors::expand_update_tag |
|
31 |
-); |
|
32 |
- |
|
33 |
-__PACKAGE__->tag_syntax(<< 'EOS'); |
|
34 |
-[tag] [expand] |
|
35 |
-{? name} ? |
|
36 |
-{= name} name = ? |
|
37 |
-{<> name} name <> ? |
|
38 |
- |
|
39 |
-{< name} name < ? |
|
40 |
-{> name} name > ? |
|
41 |
-{>= name} name >= ? |
|
42 |
-{<= name} name <= ? |
|
43 |
- |
|
44 |
-{like name} name like ? |
|
45 |
-{in name number} name in [?, ?, ..] |
|
46 |
- |
|
47 |
-{insert key1 key2} (key1, key2) values (?, ?) |
|
48 |
-{update key1 key2} set key1 = ?, key2 = ? |
|
49 |
-EOS |
|
50 |
- |
|
51 |
- |
|
52 |
-sub add_tag_processor { |
|
53 |
- my $invocant = shift; |
|
54 |
- my $tag_processors = ref $_[0] eq 'HASH' ? $_[0] : {@_}; |
|
55 |
- $invocant->tag_processors({%{$invocant->tag_processors}, %{$tag_processors}}); |
|
56 |
- return $invocant; |
|
57 |
-} |
|
58 |
- |
|
59 |
-sub clone { |
|
60 |
- my $self = shift; |
|
61 |
- my $new = $self->new; |
|
62 |
- |
|
63 |
- $new->tag_start($self->tag_start); |
|
64 |
- $new->tag_end($self->tag_end); |
|
65 |
- $new->tag_syntax($self->tag_syntax); |
|
66 |
- $new->tag_processors({%{$self->tag_processors || {}}}); |
|
67 |
- |
|
68 |
- return $new; |
|
69 |
-} |
|
70 |
- |
|
71 |
-sub create_query { |
|
72 |
- my ($self, $template) = @_; |
|
73 |
- |
|
74 |
- # Parse template |
|
75 |
- my $tree = $self->_parse_template($template); |
|
76 |
- |
|
77 |
- # Build query |
|
78 |
- my $query = $self->_build_query($tree); |
|
79 |
- |
|
80 |
- return $query; |
|
81 |
-} |
|
82 |
- |
|
83 |
-sub _parse_template { |
|
84 |
- my ($self, $template) = @_; |
|
85 |
- |
|
86 |
- my $table = ''; |
|
87 |
- if (ref $template eq 'ARRAY') { |
|
88 |
- $table = $template->[0]; |
|
89 |
- $template = $template->[1]; |
|
90 |
- } |
|
91 |
- $template ||= ''; |
|
92 |
- |
|
93 |
- my $tree = []; |
|
94 |
- |
|
95 |
- # Tags |
|
96 |
- my $tag_start = quotemeta $self->tag_start; |
|
97 |
- my $tag_end = quotemeta $self->tag_end; |
|
98 |
- |
|
99 |
- # Tokenize |
|
100 |
- my $state = 'text'; |
|
101 |
- |
|
102 |
- # Save original template |
|
103 |
- my $original_template = $template; |
|
104 |
- |
|
105 |
- # Parse template |
|
106 |
- while ($template =~ s/([^$tag_start]*?)$tag_start([^$tag_end].*?)$tag_end//sm) { |
|
107 |
- my $text = $1; |
|
108 |
- my $tag = $2; |
|
109 |
- |
|
110 |
- # Parse tree |
|
111 |
- push @$tree, {type => 'text', tag_args => [$text]} if $text; |
|
112 |
- |
|
113 |
- if ($tag) { |
|
114 |
- # Get tag name and arguments |
|
115 |
- my ($tag_name, @tag_args) = split /\s+/, $tag; |
|
116 |
- |
|
117 |
- # Tag processor is exist? |
|
118 |
- unless ($self->tag_processors->{$tag_name}) { |
|
119 |
- my $tag_syntax = $self->tag_syntax; |
|
120 |
- croak("Tag '{$tag}' in SQL template is not exist.\n\n" . |
|
121 |
- "<SQL template tag syntax>\n" . |
|
122 |
- "$tag_syntax\n" . |
|
123 |
- "<Your SQL template>\n" . |
|
124 |
- "$original_template\n\n"); |
|
125 |
- } |
|
126 |
- |
|
127 |
- # Check tag arguments |
|
128 |
- foreach my $tag_arg (@tag_args) { |
|
129 |
- # Cannot cantain placehosder '?' |
|
130 |
- croak("Tag '{t }' arguments cannot contain '?'") |
|
131 |
- if $tag_arg =~ /\?/; |
|
132 |
- } |
|
133 |
- |
|
134 |
- # Add tag to parsing tree |
|
135 |
- push @$tree, {type => 'tag', tag_name => $tag_name, tag_args => [@tag_args]}; |
|
136 |
- } |
|
137 |
- } |
|
138 |
- |
|
139 |
- # Add text to parsing tree |
|
140 |
- push @$tree, {type => 'text', tag_args => [$template]} if $template; |
|
141 |
- |
|
142 |
- return $tree; |
|
143 |
-} |
|
144 |
- |
|
145 |
-sub _build_query { |
|
146 |
- my ($self, $tree) = @_; |
|
147 |
- |
|
148 |
- # SQL |
|
149 |
- my $sql = ''; |
|
150 |
- |
|
151 |
- # All parameter key infomation |
|
152 |
- my $all_key_infos = []; |
|
153 |
- |
|
154 |
- # Build SQL |
|
155 |
- foreach my $node (@$tree) { |
|
156 |
- |
|
157 |
- # Get type, tag name, and arguments |
|
158 |
- my $type = $node->{type}; |
|
159 |
- my $tag_name = $node->{tag_name}; |
|
160 |
- my $tag_args = $node->{tag_args}; |
|
161 |
- |
|
162 |
- # Text |
|
163 |
- if ($type eq 'text') { |
|
164 |
- # Join text |
|
165 |
- $sql .= $tag_args->[0]; |
|
166 |
- } |
|
167 |
- |
|
168 |
- # Tag |
|
169 |
- elsif ($type eq 'tag') { |
|
170 |
- |
|
171 |
- # Get tag processor |
|
172 |
- my $tag_processor = $self->tag_processors->{$tag_name}; |
|
173 |
- |
|
174 |
- # Tag processor is code ref? |
|
175 |
- croak("Tag processor '$tag_name' must be code reference") |
|
176 |
- unless ref $tag_processor eq 'CODE'; |
|
177 |
- |
|
178 |
- # Expand tag using tag processor |
|
179 |
- my ($expand, $key_infos) |
|
180 |
- = $tag_processor->($tag_name, $tag_args, $self->table || ''); |
|
181 |
- |
|
182 |
- # Check tag processor return value |
|
183 |
- croak("Tag processor '$tag_name' must return (\$expand, \$key_infos)") |
|
184 |
- if !defined $expand || ref $key_infos ne 'ARRAY'; |
|
185 |
- |
|
186 |
- # Check placeholder count |
|
187 |
- croak("Placeholder count in SQL created by tag processor '$tag_name' " . |
|
188 |
- "must be same as key informations count") |
|
189 |
- unless $self->_placeholder_count($expand) eq @$key_infos; |
|
190 |
- |
|
191 |
- # Add key information |
|
192 |
- push @$all_key_infos, @$key_infos; |
|
193 |
- |
|
194 |
- # Join expand tag to SQL |
|
195 |
- $sql .= $expand; |
|
196 |
- } |
|
197 |
- } |
|
198 |
- |
|
199 |
- # Add semicolon |
|
200 |
- $sql .= ';' unless $sql =~ /;$/; |
|
201 |
- |
|
202 |
- # Query |
|
203 |
- my $query = DBIx::Custom::Query->new(sql => $sql, key_infos => $all_key_infos); |
|
204 |
- |
|
205 |
- return $query; |
|
206 |
-} |
|
207 |
- |
|
208 |
-sub _placeholder_count { |
|
209 |
- my ($self, $expand) = @_; |
|
210 |
- $expand ||= ''; |
|
211 |
- |
|
212 |
- my $count = 0; |
|
213 |
- my $pos = -1; |
|
214 |
- while (($pos = index($expand, '?', $pos + 1)) != -1) { |
|
215 |
- $count++; |
|
216 |
- } |
|
217 |
- return $count; |
|
218 |
-} |
|
219 |
- |
|
220 |
-1; |
|
221 |
- |
|
222 |
-package DBIx::Custom::SQL::Template::TagProcessors; |
|
223 |
- |
|
224 |
-use strict; |
|
225 |
-use warnings; |
|
226 |
- |
|
227 |
-use Carp 'croak'; |
|
228 |
-use DBIx::Custom::KeyInfo; |
|
229 |
- |
|
230 |
-sub expand_basic_tag { |
|
231 |
- my ($tag_name, $tag_args, $table) = @_; |
|
232 |
- |
|
233 |
- # Key |
|
234 |
- my $key = $tag_args->[0]; |
|
235 |
- |
|
236 |
- # Key is not exist |
|
237 |
- croak("You must be pass key as argument to tag '{$tag_name }'") |
|
238 |
- unless $key; |
|
239 |
- |
|
240 |
- # Key info |
|
241 |
- my $key_info = DBIx::Custom::KeyInfo->new($key); |
|
242 |
- $key_info->table($table) unless $key_info->table; |
|
243 |
- |
|
244 |
- # Expanded tag |
|
245 |
- my $column = $key_info->table |
|
246 |
- ? $key_info->table . '.' . $key_info->column |
|
247 |
- : $key_info->column; |
|
248 |
- my $expand = $tag_name eq '?' |
|
249 |
- ? '?' |
|
250 |
- : "$column $tag_name ?"; |
|
251 |
- |
|
252 |
- return ($expand, [$key_info]); |
|
253 |
-} |
|
254 |
- |
|
255 |
-sub expand_in_tag { |
|
256 |
- my ($tag_name, $tag_args, $table) = @_; |
|
257 |
- my ($key, $placeholder_count) = @$tag_args; |
|
258 |
- |
|
259 |
- # Key must be specified |
|
260 |
- croak("You must be pass key as first argument of tag '{$tag_name }'\n" . |
|
261 |
- "Usage: {$tag_name \$key \$placeholder_count}") |
|
262 |
- unless $key; |
|
263 |
- |
|
264 |
- # Place holder count must be specified |
|
265 |
- croak("You must be pass placeholder count as second argument of tag '{$tag_name }'\n" . |
|
266 |
- "Usage: {$tag_name \$key \$placeholder_count}") |
|
267 |
- if !$placeholder_count || $placeholder_count =~ /\D/; |
|
268 |
- |
|
269 |
- # Expand tag |
|
270 |
- my $key_info = DBIx::Custom::KeyInfo->new($key); |
|
271 |
- my $column = $key_info->table |
|
272 |
- ? $key_info->table . '.' . $key_info->column |
|
273 |
- : $key_info->column; |
|
274 |
- |
|
275 |
- my $expand = "$column $tag_name ("; |
|
276 |
- for (my $i = 0; $i < $placeholder_count; $i++) { |
|
277 |
- $expand .= '?, '; |
|
278 |
- } |
|
279 |
- |
|
280 |
- $expand =~ s/, $//; |
|
281 |
- $expand .= ')'; |
|
282 |
- |
|
283 |
- # Create parameter key infomations |
|
284 |
- my $key_infos = []; |
|
285 |
- for (my $i = 0; $i < $placeholder_count; $i++) { |
|
286 |
- |
|
287 |
- # Add parameter key infos |
|
288 |
- my $key_info = DBIx::Custom::KeyInfo->new($key); |
|
289 |
- $key_info->table($table) unless $key_info->table; |
|
290 |
- $key_info->pos($i); |
|
291 |
- push @$key_infos, $key_info; |
|
292 |
- } |
|
293 |
- |
|
294 |
- return ($expand, $key_infos); |
|
295 |
-} |
|
296 |
- |
|
297 |
-sub expand_insert_tag { |
|
298 |
- my ($tag_name, $tag_args, $table) = @_; |
|
299 |
- my $keys = $tag_args; |
|
300 |
- |
|
301 |
- # Insert key (k1, k2, k3, ..) |
|
302 |
- my $insert_keys = '('; |
|
303 |
- |
|
304 |
- # placeholder (?, ?, ?, ..) |
|
305 |
- my $place_holders = '('; |
|
306 |
- |
|
307 |
- foreach my $key (@$keys) { |
|
308 |
- # Get table and clumn name |
|
309 |
- my $key_info = DBIx::Custom::KeyInfo->new($key); |
|
310 |
- my $column = $key_info->column; |
|
311 |
- |
|
312 |
- # Join insert column |
|
313 |
- $insert_keys .= "$column, "; |
|
314 |
- |
|
315 |
- # Join place holder |
|
316 |
- $place_holders .= "?, "; |
|
317 |
- } |
|
318 |
- |
|
319 |
- # Delete last ', ' |
|
320 |
- $insert_keys =~ s/, $//; |
|
321 |
- |
|
322 |
- # Close |
|
323 |
- $insert_keys .= ')'; |
|
324 |
- $place_holders =~ s/, $//; |
|
325 |
- $place_holders .= ')'; |
|
326 |
- |
|
327 |
- # Expand tag |
|
328 |
- my $expand = "$insert_keys values $place_holders"; |
|
329 |
- |
|
330 |
- # Create parameter key infomations |
|
331 |
- my $key_infos = []; |
|
332 |
- foreach my $key (@$keys) { |
|
333 |
- my $key_info = DBIx::Custom::KeyInfo->new($key); |
|
334 |
- $key_info->table($table) unless $key_info->table; |
|
335 |
- push @$key_infos, $key_info; |
|
336 |
- } |
|
337 |
- |
|
338 |
- return ($expand, $key_infos); |
|
339 |
-} |
|
340 |
- |
|
341 |
-sub expand_update_tag { |
|
342 |
- my ($tag_name, $tag_args, $table) = @_; |
|
343 |
- my $keys = $tag_args; |
|
344 |
- |
|
345 |
- # Expanded tag |
|
346 |
- my $expand = 'set '; |
|
347 |
- |
|
348 |
- foreach my $key (@$keys) { |
|
349 |
- # Get table and clumn name |
|
350 |
- my $key_info = DBIx::Custom::KeyInfo->new($key); |
|
351 |
- my $column = $key_info->column; |
|
352 |
- |
|
353 |
- # Join key and placeholder |
|
354 |
- $expand .= "$column = ?, "; |
|
355 |
- } |
|
356 |
- |
|
357 |
- # Delete last ', ' |
|
358 |
- $expand =~ s/, $//; |
|
359 |
- |
|
360 |
- my $key_infos = []; |
|
361 |
- foreach my $key (@$keys) { |
|
362 |
- my $key_info = DBIx::Custom::KeyInfo->new($key); |
|
363 |
- $key_info->table($table) unless $key_info->table; |
|
364 |
- push @$key_infos, $key_info; |
|
365 |
- } |
|
366 |
- |
|
367 |
- return ($expand, $key_infos); |
|
368 |
-} |
|
369 |
- |
|
370 |
-package DBIx::Custom::SQL::Template; |
|
371 |
- |
|
372 |
-1; |
|
373 |
- |
|
374 |
-=head1 NAME |
|
375 |
- |
|
376 |
-DBIx::Custom::SQL::Template - DBIx::Custom SQL Template |
|
377 |
- |
|
378 |
-=head1 SYNOPSIS |
|
379 |
- |
|
380 |
- my $sql_tmpl = DBIx::Custom::SQL::Template->new; |
|
381 |
- |
|
382 |
- my $tmpl = "select from table {= k1} && {<> k2} || {like k3}"; |
|
383 |
- my $param = {k1 => 1, k2 => 2, k3 => 3}; |
|
384 |
- |
|
385 |
- my $query = $sql_template->create_query($tmpl); |
|
386 |
- |
|
387 |
-=head1 ATTRIBUTES |
|
388 |
- |
|
389 |
-=head2 tag_processors |
|
390 |
- |
|
391 |
- $sql_tmpl = $sql_tmpl->tag_processors($name1 => $tag_processor1 |
|
392 |
- $name2 => $tag_processor2); |
|
393 |
- $tag_processors = $sql_tmpl->tag_processors; |
|
394 |
- |
|
395 |
-=head2 tag_start |
|
396 |
- |
|
397 |
- $sql_tmpl = $sql_tmpl->tag_start('{'); |
|
398 |
- $tag_start = $sql_tmpl->tag_start; |
|
399 |
- |
|
400 |
-Default is '{' |
|
401 |
- |
|
402 |
-=head2 tag_end |
|
403 |
- |
|
404 |
- $sql_tmpl = $sql_tmpl->tag_start('}'); |
|
405 |
- $tag_end = $sql_tmpl->tag_start; |
|
406 |
- |
|
407 |
-Default is '}' |
|
408 |
- |
|
409 |
-=head2 tag_syntax |
|
410 |
- |
|
411 |
- $sql_tmpl = $sql_tmpl->tag_syntax($tag_syntax); |
|
412 |
- $tag_syntax = $sql_tmpl->tag_syntax; |
|
413 |
- |
|
414 |
-=head1 METHODS |
|
415 |
- |
|
416 |
-This class is L<Object::Simple> subclass. |
|
417 |
-You can use all methods of L<Object::Simple> |
|
418 |
- |
|
419 |
-=head2 create_query |
|
420 |
- |
|
421 |
-Create L<DBIx::Custom::Query> object parsing SQL template |
|
422 |
- |
|
423 |
- $query = $sql_tmpl->create_query($tmpl); |
|
424 |
- |
|
425 |
- # Sample |
|
426 |
- $query = $sql_tmpl->create_sql( |
|
427 |
- "select * from table where {= title} && {like author} || {<= price}") |
|
428 |
- |
|
429 |
- # Expanded |
|
430 |
- $qeury->sql : "select * from table where title = ? && author like ? price <= ?;" |
|
431 |
- $query->key_infos : [['title'], ['author'], ['price']] |
|
432 |
- |
|
433 |
- # Sample with table name |
|
434 |
- ($sql, @bind_values) = $sql_tmpl->create_sql( |
|
435 |
- "select * from table where {= table.title} && {like table.author}", |
|
436 |
- {table => {title => 'Perl', author => '%Taro%'}} |
|
437 |
- ) |
|
438 |
- |
|
439 |
- # Expanded |
|
440 |
- $query->sql : "select * from table where table.title = ? && table.title like ?;" |
|
441 |
- $query->key_infos :[ [['table.title'],['table', 'title']], |
|
442 |
- [['table.author'],['table', 'author']] ] |
|
443 |
- |
|
444 |
-This method create query using by L<DBIx::Custom>. |
|
445 |
-query has two infomation |
|
446 |
- |
|
447 |
- 1. sql : SQL |
|
448 |
- 2. key_infos : Parameter access key information |
|
449 |
- |
|
450 |
-=head2 add_tag_processor |
|
451 |
- |
|
452 |
-Add tag processor |
|
453 |
- |
|
454 |
- $sql_tmpl = $sql_tmpl->add_tag_processor($tag_processor); |
|
455 |
- |
|
456 |
-The following is add_tag_processor sample |
|
457 |
- |
|
458 |
- $sql_tmpl->add_tag_processor( |
|
459 |
- '?' => sub { |
|
460 |
- my ($tag_name, $tag_args) = @_; |
|
461 |
- |
|
462 |
- my $key1 = $tag_args->[0]; |
|
463 |
- my $key2 = $tag_args->[1]; |
|
464 |
- |
|
465 |
- my $key_infos = []; |
|
466 |
- |
|
467 |
- # Expand tag and create key informations |
|
468 |
- |
|
469 |
- # Return expand tags and key informations |
|
470 |
- return ($expand, $key_infos); |
|
471 |
- } |
|
472 |
- ); |
|
473 |
- |
|
474 |
-Tag processor recieve 2 argument |
|
475 |
- |
|
476 |
- 1. Tag name (?, =, <>, or etc) |
|
477 |
- 2. Tag arguments (arg1 and arg2 in {tag_name arg1 arg2}) |
|
478 |
- |
|
479 |
-Tag processor return 2 value |
|
480 |
- |
|
481 |
- 1. Expanded Tag (For exsample, '{= title}' is expanded to 'title = ?') |
|
482 |
- 2. Key infomations |
|
483 |
- |
|
484 |
-You must be return expanded tag and key infomations. |
|
485 |
- |
|
486 |
-Key information is a little complex. so I will explan this in future. |
|
487 |
- |
|
488 |
-If you want to know more, Please see DBIx::Custom::SQL::Template source code. |
|
489 |
- |
|
490 |
-=head2 clone |
|
491 |
- |
|
492 |
-Clone DBIx::Custom::SQL::Template object |
|
493 |
- |
|
494 |
- $clone = $sql_tmpl->clone; |
|
495 |
- |
|
496 |
-=head1 Available Tags |
|
497 |
- |
|
498 |
-Available Tags |
|
499 |
- |
|
500 |
- [tag] [expand] |
|
501 |
- {? name} ? |
|
502 |
- {= name} name = ? |
|
503 |
- {<> name} name <> ? |
|
504 |
- |
|
505 |
- {< name} name < ? |
|
506 |
- {> name} name > ? |
|
507 |
- {>= name} name >= ? |
|
508 |
- {<= name} name <= ? |
|
509 |
- |
|
510 |
- {like name} name like ? |
|
511 |
- {in name} name in [?, ?, ..] |
|
512 |
- |
|
513 |
- {insert} (key1, key2, key3) values (?, ?, ?) |
|
514 |
- {update} set key1 = ?, key2 = ?, key3 = ? |
|
515 |
- |
|
516 |
- |
|
517 |
-The following is insert SQL sample |
|
518 |
- |
|
519 |
- $query = $sql_tmpl->create_sql( |
|
520 |
- "insert into table {insert key1 key2}" |
|
521 |
- ); |
|
522 |
- |
|
523 |
- # Expanded |
|
524 |
- $query->sql : "insert into table (key1, key2) values (?, ?)" |
|
525 |
- |
|
526 |
-The following is update SQL sample |
|
527 |
- |
|
528 |
- $query = $sql_tmpl->create_sql( |
|
529 |
- "update table {update key1 key2} where {= key3}" |
|
530 |
- ); |
|
531 |
- |
|
532 |
- # Expanded |
|
533 |
- $query->sql : "update table set key1 = ?, key2 = ? where key3 = ?;" |
|
534 |
- |
|
535 |
-=cut |
|
536 |
- |
... | ... |
@@ -111,75 +111,75 @@ is_deeply({@row}, {key1 => 1, key2 => 2}, "$test : row"); |
111 | 111 |
ok(!@row, "$test : finished"); |
112 | 112 |
|
113 | 113 |
|
114 |
-test 'fetch_rows'; |
|
114 |
+test 'fetch_multi'; |
|
115 | 115 |
$dbh->do("insert into table1 (key1, key2) values ('5', '6');"); |
116 | 116 |
$dbh->do("insert into table1 (key1, key2) values ('7', '8');"); |
117 | 117 |
$dbh->do("insert into table1 (key1, key2) values ('9', '10');"); |
118 | 118 |
$result = query($dbh, $sql); |
119 |
-$rows = $result->fetch_rows(2); |
|
119 |
+$rows = $result->fetch_multi(2); |
|
120 | 120 |
is_deeply($rows, [[1, 2], |
121 |
- [3, 4]], "$test : fetch_rows first"); |
|
122 |
-$rows = $result->fetch_rows(2); |
|
121 |
+ [3, 4]], "$test : fetch_multi first"); |
|
122 |
+$rows = $result->fetch_multi(2); |
|
123 | 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); |
|
124 |
+ [7, 8]], "$test : fetch_multi secound"); |
|
125 |
+$rows = $result->fetch_multi(2); |
|
126 |
+is_deeply($rows, [[9, 10]], "$test : fetch_multi third"); |
|
127 |
+$rows = $result->fetch_multi(2); |
|
128 | 128 |
ok(!$rows); |
129 | 129 |
|
130 | 130 |
|
131 |
-test 'fetch_rows list context'; |
|
131 |
+test 'fetch_multi list context'; |
|
132 | 132 |
$result = query($dbh, $sql); |
133 |
-@rows = $result->fetch_rows(2); |
|
133 |
+@rows = $result->fetch_multi(2); |
|
134 | 134 |
is_deeply([@rows], [[1, 2], |
135 |
- [3, 4]], "$test : fetch_rows first"); |
|
136 |
-@rows = $result->fetch_rows(2); |
|
135 |
+ [3, 4]], "$test : fetch_multi first"); |
|
136 |
+@rows = $result->fetch_multi(2); |
|
137 | 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); |
|
138 |
+ [7, 8]], "$test : fetch_multi secound"); |
|
139 |
+@rows = $result->fetch_multi(2); |
|
140 |
+is_deeply([@rows], [[9, 10]], "$test : fetch_multi third"); |
|
141 |
+@rows = $result->fetch_multi(2); |
|
142 | 142 |
ok(!@rows); |
143 | 143 |
|
144 | 144 |
|
145 |
-test 'fetch_rows error'; |
|
145 |
+test 'fetch_multi error'; |
|
146 | 146 |
$result = query($dbh, $sql); |
147 |
-eval {$result->fetch_rows}; |
|
147 |
+eval {$result->fetch_multi}; |
|
148 | 148 |
like($@, qr/Row count must be specified/, "$test : Not specified row count"); |
149 | 149 |
|
150 | 150 |
|
151 |
-test 'fetch_hash_rows'; |
|
151 |
+test 'fetch_hash_multi'; |
|
152 | 152 |
$result = query($dbh, $sql); |
153 |
-$rows = $result->fetch_hash_rows(2); |
|
153 |
+$rows = $result->fetch_hash_multi(2); |
|
154 | 154 |
is_deeply($rows, [{key1 => 1, key2 => 2}, |
155 |
- {key1 => 3, key2 => 4}], "$test : fetch_rows first"); |
|
156 |
-$rows = $result->fetch_hash_rows(2); |
|
155 |
+ {key1 => 3, key2 => 4}], "$test : fetch_multi first"); |
|
156 |
+$rows = $result->fetch_hash_multi(2); |
|
157 | 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); |
|
158 |
+ {key1 => 7, key2 => 8}], "$test : fetch_multi secound"); |
|
159 |
+$rows = $result->fetch_hash_multi(2); |
|
160 |
+is_deeply($rows, [{key1 => 9, key2 => 10}], "$test : fetch_multi third"); |
|
161 |
+$rows = $result->fetch_hash_multi(2); |
|
162 | 162 |
ok(!$rows); |
163 | 163 |
|
164 | 164 |
|
165 |
-test 'fetch_rows list context'; |
|
165 |
+test 'fetch_multi list context'; |
|
166 | 166 |
$result = query($dbh, $sql); |
167 |
-@rows = $result->fetch_hash_rows(2); |
|
167 |
+@rows = $result->fetch_hash_multi(2); |
|
168 | 168 |
is_deeply([@rows], [{key1 => 1, key2 => 2}, |
169 |
- {key1 => 3, key2 => 4}], "$test : fetch_rows first"); |
|
170 |
-@rows = $result->fetch_hash_rows(2); |
|
169 |
+ {key1 => 3, key2 => 4}], "$test : fetch_multi first"); |
|
170 |
+@rows = $result->fetch_hash_multi(2); |
|
171 | 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); |
|
172 |
+ {key1 => 7, key2 => 8}], "$test : fetch_multi secound"); |
|
173 |
+@rows = $result->fetch_hash_multi(2); |
|
174 |
+is_deeply([@rows], [{key1 => 9, key2 => 10}], "$test : fetch_multi third"); |
|
175 |
+@rows = $result->fetch_hash_multi(2); |
|
176 | 176 |
ok(!@rows); |
177 | 177 |
$dbh->do("delete from table1 where key1 = 5 or key1 = 7 or key1 = 9"); |
178 | 178 |
|
179 | 179 |
|
180 |
-test 'fetch_rows error'; |
|
180 |
+test 'fetch_multi error'; |
|
181 | 181 |
$result = query($dbh, $sql); |
182 |
-eval {$result->fetch_hash_rows}; |
|
182 |
+eval {$result->fetch_hash_multi}; |
|
183 | 183 |
like($@, qr/Row count must be specified/, "$test : Not specified row count"); |
184 | 184 |
|
185 | 185 |
|
... | ... |
@@ -1,15 +0,0 @@ |
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" ); |
... | ... |
@@ -1,51 +0,0 @@ |
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 |
- |
... | ... |
@@ -1,55 +0,0 @@ |
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 |
- |
... | ... |
@@ -1,67 +0,0 @@ |
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 |
- |
... | ... |
@@ -1,36 +0,0 @@ |
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 |
-} |
... | ... |
@@ -1,127 +0,0 @@ |
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"); |
... | ... |
@@ -1,47 +0,0 @@ |
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 |
- |
... | ... |
@@ -1,85 +0,0 @@ |
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 |
- |
... | ... |
@@ -1,29 +0,0 @@ |
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 |
- |
... | ... |
@@ -1,248 +0,0 @@ |
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 |
- |
... | ... |
@@ -1,198 +0,0 @@ |
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->resist_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 : resist_tag_processor sql"); |
|
102 |
-is_deeply($query->{key_infos}, [2], "$test : resist_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->resist_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->resist_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->resist_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->resist_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->resist_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 |
- |
... | ... |
@@ -1,85 +0,0 @@ |
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 |
- |
... | ... |
@@ -1,78 +0,0 @@ |
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; |
... | ... |
@@ -1,18 +0,0 @@ |
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(); |
... | ... |
@@ -1,12 +0,0 @@ |
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(); |