| ... | ... |
@@ -114,20 +114,25 @@ Object::Simple->build_class; |
| 114 | 114 |
|
| 115 | 115 |
package DBI::Custom::SQLTemplate; |
| 116 | 116 |
use Object::Simple; |
| 117 |
+use Carp 'croak'; |
|
| 117 | 118 |
|
| 118 | 119 |
### Attributes; |
| 119 |
-sub tag_start : Attr { default => '{' }
|
|
| 120 |
-sub tag_end : Attr { default => '}' }
|
|
| 121 |
-sub template : Attr {};
|
|
| 122 |
-sub tree : Attr { auto_build => sub { shift->tree([]) } }
|
|
| 123 |
- |
|
| 120 |
+sub tag_start : Attr { default => '{' }
|
|
| 121 |
+sub tag_end : Attr { default => '}' }
|
|
| 122 |
+sub template : Attr {};
|
|
| 123 |
+sub tree : Attr { auto_build => sub { shift->tree([]) } }
|
|
| 124 |
+sub bind_filter : Attr {}
|
|
| 125 |
+sub values : Attr {}
|
|
| 126 |
+sub upper_case : Attr {default => 0}
|
|
| 124 | 127 |
|
| 125 | 128 |
sub create_sql {
|
| 126 | 129 |
my ($self, $template, $values, $filter) = @_; |
| 127 | 130 |
|
| 131 |
+ $filter ||= $self->bind_filter; |
|
| 132 |
+ |
|
| 128 | 133 |
$self->parse($template); |
| 129 | 134 |
|
| 130 |
- my ($sql, @bind); |
|
| 135 |
+ my ($sql, @bind) = $self->build_sql({bind_filter => $filter, values => $values});
|
|
| 131 | 136 |
|
| 132 | 137 |
return ($sql, @bind); |
| 133 | 138 |
} |
| ... | ... |
@@ -135,7 +140,7 @@ sub create_sql {
|
| 135 | 140 |
our $TAG_SYNTAX = <<'EOS'; |
| 136 | 141 |
[tag] [expand] |
| 137 | 142 |
{= name} name = ?
|
| 138 |
-{!= name} name != ?
|
|
| 143 |
+{<> name} name <> ?
|
|
| 139 | 144 |
|
| 140 | 145 |
{< name} name < ?
|
| 141 | 146 |
{> name} name > ?
|
| ... | ... |
@@ -149,7 +154,7 @@ our $TAG_SYNTAX = <<'EOS'; |
| 149 | 154 |
{update_values} set key1 = ?, key2 = ?, key3 = ?
|
| 150 | 155 |
EOS |
| 151 | 156 |
|
| 152 |
-our %VALID_TAG_NAMES = map {$_ => 1} qw/=/;
|
|
| 157 |
+our %VALID_TAG_NAMES = map {$_ => 1} qw/= <> < > >= <= like in insert_values update_values/;
|
|
| 153 | 158 |
sub parse {
|
| 154 | 159 |
my ($self, $template) = @_; |
| 155 | 160 |
$self->template($template); |
| ... | ... |
@@ -169,37 +174,67 @@ sub parse {
|
| 169 | 174 |
|
| 170 | 175 |
# Text |
| 171 | 176 |
while ($template =~ s/([^$tag_start]*?)$tag_start([^$tag_end].*?)$tag_end//sm) {
|
| 172 |
- my $text = $1; |
|
| 177 |
+ my $text = $1; |
|
| 173 | 178 |
my $tag = $2; |
| 174 | 179 |
|
| 175 |
- push @{$self->tree}, ['text', $text] if $text;
|
|
| 180 |
+ push @{$self->tree}, {type => 'text', args => [$text]} if $text;
|
|
| 176 | 181 |
|
| 177 | 182 |
if ($tag) {
|
| 178 | 183 |
|
| 179 |
- my ($tag_name, @params) = split /\s+/, $tag; |
|
| 184 |
+ my ($tag_name, @args) = split /\s+/, $tag; |
|
| 180 | 185 |
|
| 181 |
- croak("Tag name is empty in '$tag'.\n" .
|
|
| 182 |
- "Tag Syntax\n$TAG_SYNTAX.\n" . |
|
| 183 |
- "Your SQL template is \n$original_template") |
|
| 184 |
- unless length $tag_name; |
|
| 186 |
+ $tag ||= ''; |
|
| 187 |
+ croak("Tag '$tag' in SQL template is invalid.\n\n" .
|
|
| 188 |
+ "SQL template tag syntax\n$TAG_SYNTAX\n\n" . |
|
| 189 |
+ "Your SQL template is \n$original_template\n\n") |
|
| 190 |
+ unless $VALID_TAG_NAMES{$tag_name};
|
|
| 185 | 191 |
|
| 186 |
- croak("Tag name '$tag_name' in '$tag' is invalid.\n" .
|
|
| 187 |
- "Tag Syntax\n$TAG_SYNTAX.\n" . |
|
| 188 |
- "Your SQL template is \n$original_template") |
|
| 189 |
- unless $VALID_TAG_NAMES{$tag_name};
|
|
| 190 |
- |
|
| 191 |
- push @{$self->tree}, [$tag_name, @params];
|
|
| 192 |
+ push @{$self->tree}, {type => 'tag', tag_name => $tag_name, args => [@args]};
|
|
| 192 | 193 |
} |
| 193 | 194 |
} |
| 194 | 195 |
|
| 195 |
- push @{$self->tree}, ['text', $template] if $template;
|
|
| 196 |
+ push @{$self->tree}, {type => 'text', args => [$template]} if $template;
|
|
| 196 | 197 |
} |
| 197 | 198 |
|
| 198 |
- |
|
| 199 |
- |
|
| 200 |
- |
|
| 201 |
- |
|
| 202 |
- |
|
| 199 |
+our %EXPAND_PLACE_HOLDER = map {$_ => 1} qw/= <> < > >= <= like/;
|
|
| 200 |
+sub build_sql {
|
|
| 201 |
+ my ($self, $args) = @_; |
|
| 202 |
+ |
|
| 203 |
+ my $tree = $args->{tree} || $self->tree;
|
|
| 204 |
+ my $bind_filter = $args->{bind_filter} || $self->bind_filter;
|
|
| 205 |
+ my $values = exists $args->{values} ? $args->{values} : $self->values;
|
|
| 206 |
+ |
|
| 207 |
+ my @bind_values; |
|
| 208 |
+ my $sql = ''; |
|
| 209 |
+ foreach my $node (@$tree) {
|
|
| 210 |
+ my $type = $node->{type};
|
|
| 211 |
+ my $tag_name = $node->{tag_name};
|
|
| 212 |
+ my $args = $node->{args};
|
|
| 213 |
+ |
|
| 214 |
+ if ($type eq 'text') {
|
|
| 215 |
+ # Join text |
|
| 216 |
+ $sql .= $args->[0]; |
|
| 217 |
+ } |
|
| 218 |
+ elsif ($type eq 'tag') {
|
|
| 219 |
+ if ($EXPAND_PLACE_HOLDER{$tag_name}) {
|
|
| 220 |
+ my $key = $args->[0]; |
|
| 221 |
+ |
|
| 222 |
+ # Filter Value |
|
| 223 |
+ if ($bind_filter) {
|
|
| 224 |
+ push @bind_values, scalar $bind_filter->($values->{$key});
|
|
| 225 |
+ } |
|
| 226 |
+ else {
|
|
| 227 |
+ push @bind_values, $values->{$key};
|
|
| 228 |
+ } |
|
| 229 |
+ $tag_name = uc $tag_name if $self->upper_case; |
|
| 230 |
+ my $place_holder = "$key $tag_name ?"; |
|
| 231 |
+ $sql .= $place_holder; |
|
| 232 |
+ } |
|
| 233 |
+ } |
|
| 234 |
+ } |
|
| 235 |
+ $sql .= ';' unless $sql =~ /;$/; |
|
| 236 |
+ return ($sql, @bind_values); |
|
| 237 |
+} |
|
| 203 | 238 |
|
| 204 | 239 |
|
| 205 | 240 |
Object::Simple->build_class; |
| ... | ... |
@@ -177,9 +177,19 @@ our ($U, $P, $D) = connect_info(); |
| 177 | 177 |
my $tmpl = "select * from table where {= title};";
|
| 178 | 178 |
my $values = {title => 'a'};
|
| 179 | 179 |
my ($sql, @bind) = $dbi->create_sql($tmpl, $values); |
| 180 |
- is($sql, "select * from table where title = ?;"); |
|
| 181 |
- is_deeply(\@bind, ['a']); |
|
| 180 |
+ is($sql, "select * from table where title = ?;", 'sql template'); |
|
| 181 |
+ is_deeply(\@bind, ['a'], 'sql template bind' ); |
|
| 182 |
+} |
|
| 183 |
+ |
|
| 184 |
+{
|
|
| 185 |
+ # Expand place holer |
|
| 186 |
+ my $dbi = DBI::Custom->new; |
|
| 187 |
+ my $tmpl = "select * from table where {= k1} && {<> k2} && {< k3} && {> k4} && {>= k5} && {<= k6} && {like k7}";
|
|
| 188 |
+ my $values = {k1 => 'a', k2 => 'b', k3 => 'c', k4 => 'd', k5 => 'e', k6 => 'f', k7 => 'g'};
|
|
| 182 | 189 |
|
| 190 |
+ my ($sql, @bind) = $dbi->create_sql($tmpl, $values); |
|
| 191 |
+ is($sql, "select * from table where k1 = ? && k2 <> ? && k3 < ? && k4 > ? && k5 >= ? && k6 <= ? && k7 like ?;", 'sql template2'); |
|
| 192 |
+ is_deeply(\@bind, ['a', 'b', 'c', 'd', 'e', 'f', 'g'], 'sql template bind2' ); |
|
| 183 | 193 |
} |
| 184 | 194 |
|
| 185 | 195 |
sub connect_info {
|