comparison xsls.pl @ 3:0fa786e03744

XSLScript: some preliminary work on conversion. The aproach seems to be wrong though, it looks like the only correct way is to build a tree, and then process the tree. Major changes expected.
author Maxim Dounin <mdounin@mdounin.ru>
date Thu, 20 Feb 2014 19:16:42 +0400
parents bcd96c403898
children eb959dce273b
comparison
equal deleted inserted replaced
2:bcd96c403898 3:0fa786e03744
34 my $grammar = <<'EOF'; 34 my $grammar = <<'EOF';
35 35
36 # XSLTScript grammar, reconstructed 36 # XSLTScript grammar, reconstructed
37 37
38 startrule : item(s) eofile 38 startrule : item(s) eofile
39 { $return = $item[1] } 39 { $return = $item[1]; 1 }
40 40
41 item : "<!--" <commit> comment 41 item : "<!--" <commit> comment
42 | "!!" <commit> double_exclam 42 | "!!" <commit> exclam_double
43 | "!{" <commit> exclam_xpath 43 | "!{" <commit> exclam_xpath
44 | "!" name <commit> exclam_name 44 | "!" name <commit> exclam_name
45 | "<%" <commit> instruction "%>" 45 | "<%" <commit> instruction "%>"
46 { $return = $item{instruction}; 1 }
46 | "<" name attrs ">" <commit> item(s?) "</" name ">" 47 | "<" name attrs ">" <commit> item(s?) "</" name ">"
48 { $return = ::format_tag($item{name}, $item{attrs}, $item[6]); 1 }
47 | "<" <commit> name attrs "/" ">" 49 | "<" <commit> name attrs "/" ">"
50 { $return = ::format_tag($item{name}, $item{attrs}); 1 }
48 | "X:variable" <commit> xvariable 51 | "X:variable" <commit> xvariable
49 | "X:var" <commit> xvariable 52 | "X:var" <commit> xvariable
50 | "X:template" <commit> xtemplate 53 | "X:template" <commit> xtemplate
51 | "X:if" <commit> xif 54 | "X:if" <commit> xif
52 | "X:param" <commit> xparam 55 | "X:param" <commit> xparam
55 | "X:when" <commit> xwhen 58 | "X:when" <commit> xwhen
56 | "X:attribute" <commit> xattribute 59 | "X:attribute" <commit> xattribute
57 | "X:output" <commit> xoutput 60 | "X:output" <commit> xoutput
58 | "X:copy-of" <commit> xcopyof 61 | "X:copy-of" <commit> xcopyof
59 | instruction <commit> attrs body 62 | instruction <commit> attrs body
63 { $return = ::format_instruction(
64 $item{instruction}, $item{attrs}, $item{body});
65 1 }
60 | text 66 | text
61 | <error> 67 | <error>
62 68
63 # list of simple instructions 69 # list of simple instructions
64 70
89 # comments, <!-- ... --> 95 # comments, <!-- ... -->
90 # not sure if it's something to be interpreted specially 96 # not sure if it's something to be interpreted specially
91 # likely an artifact of our dump process 97 # likely an artifact of our dump process
92 98
93 comment : /((?!-->).)*/ms "-->" 99 comment : /((?!-->).)*/ms "-->"
94 { $return = ""; 1; } 100 { $return = "<!-- " . $item[1] . "-->"; 1; }
95 101
96 # special chars: ', ", {, }, \ 102 # special chars: ', ", {, }, \
97 # if used in text, they needs to be escaped with backslash 103 # if used in text, they needs to be escaped with backslash
98 104
99 text : quoted | unreserved | "'" | "\"" | "{" 105 text : quoted | unreserved | "'" | "\"" | "{"
100 quoted : "\\" special 106 quoted : "\\" special
101 { $return = $item{special}; 1; } 107 { $return = $item{special}; 1; }
102 special : "'" | "\"" | "\\" | "{" | "}" 108 special : "'" | "\"" | "\\" | "{" | "}"
103 unreserved : /[^'"\\{}]/ 109 unreserved : /[^'"\\{}]/
104 110
105 # shortcuts: 111 # shortcuts:
106 # 112 #
113 # !! for X:apply-templates
107 # !{xpath-expression} for X:value-of select="xpath-expression"; 114 # !{xpath-expression} for X:value-of select="xpath-expression";
108 # !! for X:apply-templates
109 # !foo() for X:call-template name="foo" 115 # !foo() for X:call-template name="foo"
110 116
111 # !root (path = { !{ substring($DIRNAME, 2) } }) 117 # !root (path = { !{ substring($DIRNAME, 2) } })
112 # !root (path = "substring-after($path, '/')") 118 # !root (path = "substring-after($path, '/')")
113 119
114 double_exclam : value(?) params attrs ";" 120 exclam_double : value(?) params(?) attrs ";"
121 { $return = ::format_apply($item{value}, $item{params}, $item{attrs}); 1 }
115 122
116 exclam_xpath : xpath(s?) "}" 123 exclam_xpath : xpath(s?) "}"
117 xpath : /[^}'"]+/ 124 xpath : /[^}'"]+/
118 | /"[^"]*"/ 125 | /"[^"]*"/
119 | /'[^']*'/ 126 | /'[^']*'/
129 value : /"[^"]*"/ 136 value : /"[^"]*"/
130 137
131 # template parameters 138 # template parameters
132 # ( bar="init", baz={markup} ) 139 # ( bar="init", baz={markup} )
133 140
134 params : "(" param ("," param)(s?) ")" 141 params : "(" param(s /,/) ")"
135 | "" 142 { $return = $item[2]; 1 }
136 param : name "=" value 143 param : name "=" value
137 | name "=" <commit> "{" item(s) "}" 144 | name "=" <commit> "{" item(s) "}"
138 | name 145 | name
139 146
140 # instruction body 147 # instruction body
141 # ";" for empty body, "{ ... }" otherwise 148 # ";" for empty body, "{ ... }" otherwise
142 149
143 body : ";" 150 body : ";"
151 { $return = ""; }
144 | "{" <commit> item(s?) "}" 152 | "{" <commit> item(s?) "}"
153 { $return = join("\n", @{$item[3]}); 1 }
145 154
146 # special handling of some instructions 155 # special handling of some instructions
147 # X:if attribute is test= 156 # X:if attribute is test=
148 157
149 xif : value(?) attrs body "else" <commit> body 158 xif : value(?) attrs body "else" <commit> body
151 | <error> 160 | <error>
152 161
153 # X:template name(params) = "match" { 162 # X:template name(params) = "match" {
154 # X:template name( bar="init", baz={markup} ) = "match" mode="some" { 163 # X:template name( bar="init", baz={markup} ) = "match" mode="some" {
155 164
156 xtemplate : name(?) params ( "=" value )(?) 165 xtemplate : name(?) params(?) ( "=" value )(?)
157 attrs body 166 attrs body
158 167
159 # X:var LINK = "/article/@link"; 168 # X:var LINK = "/article/@link";
160 # X:var year = { ... } 169 # X:var year = { ... }
161 # semicolon is optional 170 # semicolon is optional
171 180
172 # X:for-each "section[@id and @name]" { ... } 181 # X:for-each "section[@id and @name]" { ... }
173 # X:for-each "link", X:sort "@id" { 182 # X:for-each "link", X:sort "@id" {
174 183
175 xforeach : value attrs body 184 xforeach : value attrs body
185 { $return = ::format_instruction_value(
186 "X:for-each", "select", $item{value}, $item{attrs}, $item{body});
187 1 }
176 | value attrs "," "X:sort" <commit> value attrs body 188 | value attrs "," "X:sort" <commit> value attrs body
177 189
178 # X:sort select 190 # X:sort select
179 # X:sort "@id" 191 # X:sort "@id"
180 192
181 xsort : value attrs body 193 xsort : value attrs body
194 { $return = ::format_instruction_value(
195 "X:sort", "select", $item{value}, $item{attrs}, $item{body});
196 1 }
182 197
183 # X:when "position() = 1" { ... } 198 # X:when "position() = 1" { ... }
184 199
185 xwhen : value attrs body 200 xwhen : value attrs body
201 { $return = ::format_instruction_value(
202 "X:when", "test", $item{value}, $item{attrs}, $item{body});
203 1 }
186 204
187 # X:attribute "href" { ... } 205 # X:attribute "href" { ... }
188 206
189 xattribute : value attrs body 207 xattribute : value attrs body
208 { $return = ::format_instruction_value(
209 "X:attribute", "name", $item{value}, $item{attrs}, $item{body});
210 1 }
190 211
191 # X:output 212 # X:output
192 # semicolon is optional 213 # semicolon is optional
193 214
194 xoutput : attrs body 215 xoutput : attrs body(?)
195 | attrs 216 { $return = ::format_instruction(
217 "X:output", $item{attrs}, $item{body});
218 1 }
196 219
197 # "X:copy-of" 220 # "X:copy-of"
198 # semicolon is optional 221 # semicolon is optional
199 222
200 xcopyof : value attrs body 223 xcopyof : value attrs body(?)
201 | value 224 { $return = ::format_instruction_value(
225 "X:copy-of", "select", $item{value}, $item{attrs}, $item{body});
226 1 }
202 227
203 # eof 228 # eof
204 229
205 eofile : /^\Z/ 230 eofile : /^\Z/
206 231
207 EOF 232 EOF
233
234 ###############################################################################
235
236 # helper formatting functions, used by grammar
237
238 sub format_instruction {
239 my ($instruction, $attrs, $body) = @_;
240 my $s = "<";
241
242 $instruction =~ s/^X:/xsl:/;
243
244 $s .= join(" ", $instruction, @{$attrs});
245
246 if ($body) {
247 $s .= ">\n" . $body . "\n</" . $instruction . ">\n";
248 } else {
249 $s .= "/>\n";
250 }
251
252 return $s;
253 }
254
255 sub format_instruction_value {
256 my ($instruction, $name, $value, $attrs, $body) = @_;
257 my $s = "<";
258
259 if ($value) {
260 push(@{$attrs}, "$name=$value");
261 }
262
263 return format_instruction($instruction, $attrs, $body);
264 }
265
266 sub format_tag {
267 my ($tag, $attrs, $body) = @_;
268 my $s = "\n<";
269
270 $s .= join(" ", $tag, @{$attrs});
271
272 $body = join("\n", @{$body});
273
274 if ($body) {
275 $s .= ">" . $body . "\n</" . $tag . ">\n";
276 } else {
277 $s .= "/>\n";
278 }
279
280 return $s;
281 }
282
283 sub format_apply {
284 my ($select, $params, $attrs) = @_;
285 my $s = "\n<";
286 my $tag = "xsl:apply-templates";
287
288 if ($select) {
289 unshift "select=$select", @{$attrs};
290 }
291
292 $s .= join(" ", $tag, @{$attrs});
293
294 if ($params) {
295 $params = join("\n", @{$params});
296 $s .= ">\n" . $params . "\n</" . $tag . ">\n";
297 } else {
298 $s .= "/>\n";
299 }
300 }
208 301
209 ############################################################################### 302 ###############################################################################
210 303
211 my $parser = Parse::RecDescent->new($grammar) 304 my $parser = Parse::RecDescent->new($grammar)
212 or die "Failed to create parser.\n"; 305 or die "Failed to create parser.\n";
219 } 312 }
220 313
221 my $tree = $parser->startrule($lines) 314 my $tree = $parser->startrule($lines)
222 or die "Failed to parse $ARGV.\n"; 315 or die "Failed to parse $ARGV.\n";
223 316
224 print Dumper($tree); 317 #print Dumper($tree);
225 318 #print join("\n", @{$tree});
226 ############################################################################### 319
227 ############################################################################### 320 ###############################################################################
321 ###############################################################################