| ... | ... | 
                  @@ -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 {
                 |