Showing 5 changed files with 146 additions and 67 deletions
+2
Changes
... ...
@@ -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
+4 -6
lib/DBIx/Custom.pm
... ...
@@ -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
            ...
+132 -54
lib/DBIx/Custom/QueryBuilder.pm
... ...
@@ -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
+4 -7
t/dbix-custom-core.t
... ...
@@ -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
 
+4
t/dbix-custom-querybuilder.t
... ...
@@ -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
+