Mercurial > hg > xslscript
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 ############################################################################### |