removed DBIx::Custom::Query start_tag and end tag...
...attributes
| ... | ... |
@@ -1,4 +1,6 @@ |
| 1 | 1 |
0.1614 |
| 2 |
+ removed DBIx::Custom::Query start_tag and end tag attributes |
|
| 3 |
+ enable escaping '{' and '}' in the source of SQL
|
|
| 2 | 4 |
fixed Carp Carp trust relationship |
| 3 | 5 |
0.1613 |
| 4 | 6 |
added experimental register_method() method |
| ... | ... |
@@ -896,11 +896,11 @@ The following tags is available. |
| 896 | 896 |
|
| 897 | 897 |
See also L<DBIx::Custom::QueryBuilder>. |
| 898 | 898 |
|
| 899 |
-Default start tag is '{'. end tag is '}'.
|
|
| 900 |
-You can change this tag. |
|
| 899 |
+C<{> and C<}> is reserved. If you use these charactors,
|
|
| 900 |
+you must escape them using '\'. Note that '\' is |
|
| 901 |
+already perl escaped charactor, so you must write '\\'. |
|
| 901 | 902 |
|
| 902 |
- $dbi->query_builder->start_tag('|');
|
|
| 903 |
- $dbi->query_builder->end_tag('|');
|
|
| 903 |
+ 'select * from books \\{ something statement \\}'
|
|
| 904 | 904 |
|
| 905 | 905 |
=head2 6. Filtering |
| 906 | 906 |
|
| ... | ... |
@@ -1115,8 +1115,6 @@ You can change Result class if you need. |
| 1115 | 1115 |
You can custamize SQL builder object |
| 1116 | 1116 |
|
| 1117 | 1117 |
my $dbi = DBIx::Custom->connect(...); |
| 1118 |
- $dbi->query_builder->start_tag('|');
|
|
| 1119 |
- $dbi->query_builder->end_tag('|');
|
|
| 1120 | 1118 |
$dbi->query_builder->register_tag_processor( |
| 1121 | 1119 |
name => sub {
|
| 1122 | 1120 |
... |
| ... | ... |
@@ -27,9 +27,6 @@ __PACKAGE__->register_tag_processor( |
| 27 | 27 |
'update_param' => \&DBIx::Custom::QueryBuilder::TagProcessors::expand_update_param_tag |
| 28 | 28 |
); |
| 29 | 29 |
|
| 30 |
-__PACKAGE__->attr(tag_start => '{');
|
|
| 31 |
-__PACKAGE__->attr(tag_end => '}'); |
|
| 32 |
- |
|
| 33 | 30 |
sub register_tag_processor {
|
| 34 | 31 |
my $self = shift; |
| 35 | 32 |
|
| ... | ... |
@@ -59,51 +56,134 @@ sub _parse {
|
| 59 | 56 |
$source ||= ''; |
| 60 | 57 |
|
| 61 | 58 |
# Tree |
| 62 |
- my $tree = []; |
|
| 63 |
- |
|
| 64 |
- # Start tag |
|
| 65 |
- my $tag_start = quotemeta $self->tag_start; |
|
| 66 |
- croak qq{tag_start must be a charactor}
|
|
| 67 |
- if !$tag_start || length $tag_start == 1; |
|
| 59 |
+ my @tree; |
|
| 68 | 60 |
|
| 69 |
- # End tag |
|
| 70 |
- my $tag_end = quotemeta $self->tag_end; |
|
| 71 |
- croak qq{tag_end must be a charactor}
|
|
| 72 |
- if !$tag_end || length $tag_end == 1; |
|
| 61 |
+ # Value |
|
| 62 |
+ my $value = ''; |
|
| 73 | 63 |
|
| 74 |
- # Tokenize |
|
| 64 |
+ # State |
|
| 75 | 65 |
my $state = 'text'; |
| 76 | 66 |
|
| 77 |
- # Save original source |
|
| 78 |
- my $original = $source; |
|
| 67 |
+ # Before charactor |
|
| 68 |
+ my $before = ''; |
|
| 69 |
+ |
|
| 70 |
+ # Position |
|
| 71 |
+ my $pos; |
|
| 79 | 72 |
|
| 80 | 73 |
# Parse |
| 81 |
- while ($source =~ s/([^$tag_start]*?)$tag_start([^$tag_end].*?)$tag_end//sm) {
|
|
| 82 |
- my $text = $1; |
|
| 83 |
- my $tag = $2; |
|
| 74 |
+ while (my $c = substr($source, 0, 1, '')) {
|
|
| 84 | 75 |
|
| 85 |
- # Parse tree |
|
| 86 |
- push @$tree, {type => 'text', tag_args => [$text]} if $text;
|
|
| 76 |
+ # State is text |
|
| 77 |
+ if ($state eq 'text') {
|
|
| 78 |
+ |
|
| 79 |
+ # Tag start charactor |
|
| 80 |
+ if ($c eq '{') {
|
|
| 81 |
+ |
|
| 82 |
+ # Escaped charactor |
|
| 83 |
+ if ($before eq "\\") {
|
|
| 84 |
+ substr($value, -1, 1, ''); |
|
| 85 |
+ $value .= $c; |
|
| 86 |
+ } |
|
| 87 |
+ |
|
| 88 |
+ # Tag start |
|
| 89 |
+ else {
|
|
| 90 |
+ |
|
| 91 |
+ # Change state |
|
| 92 |
+ $state = 'tag'; |
|
| 93 |
+ |
|
| 94 |
+ # Add text |
|
| 95 |
+ push @tree, {type => 'text', value => $value}
|
|
| 96 |
+ if $value; |
|
| 97 |
+ |
|
| 98 |
+ # Clear |
|
| 99 |
+ $value = ''; |
|
| 100 |
+ } |
|
| 101 |
+ } |
|
| 102 |
+ |
|
| 103 |
+ # Tag end charactor |
|
| 104 |
+ elsif ($c eq '}') {
|
|
| 105 |
+ |
|
| 106 |
+ # Escaped charactor |
|
| 107 |
+ if ($before eq "\\") {
|
|
| 108 |
+ substr($value, -1, 1, ''); |
|
| 109 |
+ $value .= $c; |
|
| 110 |
+ } |
|
| 111 |
+ |
|
| 112 |
+ # Unexpected |
|
| 113 |
+ else {
|
|
| 114 |
+ croak qq/Parsing error. unexpected "}". / . |
|
| 115 |
+ qq/pos $pos of "$source"/; |
|
| 116 |
+ } |
|
| 117 |
+ } |
|
| 118 |
+ |
|
| 119 |
+ # Normal charactor |
|
| 120 |
+ else { $value .= $c }
|
|
| 121 |
+ } |
|
| 87 | 122 |
|
| 88 |
- if ($tag) {
|
|
| 89 |
- # Get tag name and arguments |
|
| 90 |
- my ($tag_name, @tag_args) = split /\s+/, $tag; |
|
| 123 |
+ # State is tags |
|
| 124 |
+ elsif ($state eq 'tag') {
|
|
| 125 |
+ |
|
| 126 |
+ # Tag start charactor |
|
| 127 |
+ if ($c eq '{') {
|
|
| 91 | 128 |
|
| 92 |
- # Tag processor not registered |
|
| 93 |
- croak qq{Tag "$tag_name" in "$original" is not registered}
|
|
| 94 |
- unless $self->tag_processors->{$tag_name};
|
|
| 129 |
+ # Escaped charactor |
|
| 130 |
+ if ($before eq "\\") {
|
|
| 131 |
+ substr($value, -1, 1, ''); |
|
| 132 |
+ $value .= $c; |
|
| 133 |
+ } |
|
| 134 |
+ |
|
| 135 |
+ # Unexpected |
|
| 136 |
+ else {
|
|
| 137 |
+ croak qq/Parsing error. unexpected "{". / .
|
|
| 138 |
+ qq/pos $pos of "$source"/; |
|
| 139 |
+ } |
|
| 140 |
+ } |
|
| 95 | 141 |
|
| 96 |
- # Add tag to parsing tree |
|
| 97 |
- push @$tree, {type => 'tag', tag_name => $tag_name,
|
|
| 98 |
- tag_args => [@tag_args]}; |
|
| 142 |
+ # Tag end charactor |
|
| 143 |
+ elsif ($c eq '}') {
|
|
| 144 |
+ |
|
| 145 |
+ # Escaped charactor |
|
| 146 |
+ if ($before eq "\\") {
|
|
| 147 |
+ substr($value, -1, 1, ''); |
|
| 148 |
+ $value .= $c; |
|
| 149 |
+ } |
|
| 150 |
+ |
|
| 151 |
+ # Tag end |
|
| 152 |
+ else {
|
|
| 153 |
+ |
|
| 154 |
+ # Change state |
|
| 155 |
+ $state = 'text'; |
|
| 156 |
+ |
|
| 157 |
+ # Add tag |
|
| 158 |
+ my ($tag_name, @tag_args) = split /\s+/, $value; |
|
| 159 |
+ push @tree, {type => 'tag', tag_name => $tag_name,
|
|
| 160 |
+ tag_args => \@tag_args}; |
|
| 161 |
+ |
|
| 162 |
+ # Clear |
|
| 163 |
+ $value = ''; |
|
| 164 |
+ } |
|
| 165 |
+ } |
|
| 166 |
+ |
|
| 167 |
+ # Normal charactor |
|
| 168 |
+ else { $value .= $c }
|
|
| 99 | 169 |
} |
| 170 |
+ |
|
| 171 |
+ # Save before charactor |
|
| 172 |
+ $before = $c; |
|
| 173 |
+ |
|
| 174 |
+ # increment position |
|
| 175 |
+ $pos++; |
|
| 100 | 176 |
} |
| 101 | 177 |
|
| 102 |
- # Add text to parsing tree |
|
| 103 |
- push @$tree, {type => 'text', tag_args => [$source]}
|
|
| 104 |
- if $source; |
|
| 178 |
+ # Tag not finished |
|
| 179 |
+ croak qq{Tag not finished. "$source"}
|
|
| 180 |
+ if $state eq 'tag'; |
|
| 105 | 181 |
|
| 106 |
- return $tree; |
|
| 182 |
+ # Add rest text |
|
| 183 |
+ push @tree, {type => 'text', value => $value}
|
|
| 184 |
+ if $value; |
|
| 185 |
+ |
|
| 186 |
+ return \@tree; |
|
| 107 | 187 |
} |
| 108 | 188 |
|
| 109 | 189 |
sub _build_query {
|
| ... | ... |
@@ -119,22 +199,30 @@ sub _build_query {
|
| 119 | 199 |
foreach my $node (@$tree) {
|
| 120 | 200 |
|
| 121 | 201 |
# Get type, tag name, and arguments |
| 122 |
- my $type = $node->{type};
|
|
| 123 |
- my $tag_name = $node->{tag_name};
|
|
| 124 |
- my $tag_args = $node->{tag_args};
|
|
| 202 |
+ my $type = $node->{type};
|
|
| 125 | 203 |
|
| 126 | 204 |
# Text |
| 127 | 205 |
if ($type eq 'text') {
|
| 128 | 206 |
# Join text |
| 129 |
- $sql .= $tag_args->[0]; |
|
| 207 |
+ $sql .= $node->{value};
|
|
| 130 | 208 |
} |
| 131 | 209 |
|
| 132 | 210 |
# Tag |
| 133 | 211 |
elsif ($type eq 'tag') {
|
| 134 | 212 |
|
| 213 |
+ # Tag name |
|
| 214 |
+ my $tag_name = $node->{tag_name};
|
|
| 215 |
+ |
|
| 216 |
+ # Tag arguments |
|
| 217 |
+ my $tag_args = $node->{tag_args};
|
|
| 218 |
+ |
|
| 135 | 219 |
# Get tag processor |
| 136 | 220 |
my $tag_processor = $self->tag_processors->{$tag_name};
|
| 137 | 221 |
|
| 222 |
+ # Tag processor is not registered |
|
| 223 |
+ croak qq{Tag "$tag_name" in "{a }" is not registered}
|
|
| 224 |
+ unless $tag_processor; |
|
| 225 |
+ |
|
| 138 | 226 |
# Tag processor not sub reference |
| 139 | 227 |
croak qq{Tag processor "$tag_name" must be sub reference}
|
| 140 | 228 |
unless ref $tag_processor eq 'CODE'; |
| ... | ... |
@@ -207,22 +295,6 @@ DBIx::Custom::QueryBuilder - Query builder |
| 207 | 295 |
|
| 208 | 296 |
Tag processors. |
| 209 | 297 |
|
| 210 |
-=head2 C<tag_start> |
|
| 211 |
- |
|
| 212 |
- my $tag_start = $builder->tag_start; |
|
| 213 |
- $builder = $builder->tag_start('{');
|
|
| 214 |
- |
|
| 215 |
-Tag start charactor. |
|
| 216 |
-Default to '{'.
|
|
| 217 |
- |
|
| 218 |
-=head2 C<tag_end> |
|
| 219 |
- |
|
| 220 |
- my $tag_end = $builder->tag_start; |
|
| 221 |
- $builder = $builder->tag_start('}');
|
|
| 222 |
- |
|
| 223 |
-Tag end charactor. |
|
| 224 |
-Default to '}'. |
|
| 225 |
- |
|
| 226 | 298 |
=head1 METHODS |
| 227 | 299 |
|
| 228 | 300 |
L<DBIx::Custom::QueryBuilder> inherits all methods from L<Object::Simple> |
| ... | ... |
@@ -235,6 +307,12 @@ and implements the following new ones. |
| 235 | 307 |
Create a new L<DBIx::Custom::Query> object from SQL source. |
| 236 | 308 |
SQL source contains tags, such as {= title}, {like author}.
|
| 237 | 309 |
|
| 310 |
+C<{> and C<}> is reserved. If you use these charactors,
|
|
| 311 |
+you must escape them using '\'. Note that '\' is |
|
| 312 |
+already perl escaped charactor, so you must write '\\'. |
|
| 313 |
+ |
|
| 314 |
+ 'select * from books \\{ something statement \\}'
|
|
| 315 |
+ |
|
| 238 | 316 |
B<Example:> |
| 239 | 317 |
|
| 240 | 318 |
SQL source |
| ... | ... |
@@ -12,14 +12,11 @@ sub test {
|
| 12 | 12 |
} |
| 13 | 13 |
|
| 14 | 14 |
# Variables for test |
| 15 |
-our $SQL_TMPL = {
|
|
| 16 |
- 0 => DBIx::Custom::QueryBuilder->new->tag_start(0), |
|
| 17 |
- 1 => DBIx::Custom::QueryBuilder->new->tag_start(1), |
|
| 18 |
- 2 => DBIx::Custom::QueryBuilder->new->tag_start(2) |
|
| 19 |
-}; |
|
| 20 | 15 |
my $dbi; |
| 16 |
+my $query_builder; |
|
| 21 | 17 |
|
| 22 | 18 |
test 'Constructor'; |
| 19 |
+$query_builder = DBIx::Custom::QueryBuilder->new; |
|
| 23 | 20 |
$dbi = DBIx::Custom->new( |
| 24 | 21 |
user => 'a', |
| 25 | 22 |
database => 'a', |
| ... | ... |
@@ -31,12 +28,12 @@ $dbi = DBIx::Custom->new( |
| 31 | 28 |
default_bind_filter => 'f', |
| 32 | 29 |
default_fetch_filter => 'g', |
| 33 | 30 |
result_class => 'g', |
| 34 |
- sql_builder => $SQL_TMPL->{0},
|
|
| 31 |
+ query_builder => $query_builder, |
|
| 35 | 32 |
); |
| 36 | 33 |
is_deeply($dbi,{user => 'a', database => 'a', password => 'b', data_source => 'c',
|
| 37 | 34 |
filters => {f => 3}, default_bind_filter => 'f',
|
| 38 | 35 |
default_fetch_filter => 'g', result_class => 'g', |
| 39 |
- sql_builder => $SQL_TMPL->{0}}, $test);
|
|
| 36 |
+ query_builder => $query_builder}, $test); |
|
| 40 | 37 |
isa_ok($dbi, 'DBIx::Custom'); |
| 41 | 38 |
|
| 42 | 39 |
|
| ... | ... |
@@ -142,3 +142,7 @@ eval{$builder->build_query("{in a r}")};
|
| 142 | 142 |
like($@, qr/\QColumn name and count of values must be specified in tag "{in }"/,
|
| 143 | 143 |
"$test : in : key not exist"); |
| 144 | 144 |
|
| 145 |
+test '_parse'; |
|
| 146 |
+ |
|
| 147 |
+ |
|
| 148 |
+ |