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 |
+ |