1package XML::STX::Parser; 2 3require 5.005_02; 4BEGIN { require warnings if $] >= 5.006; } 5use strict; 6use XML::STX::Base; 7use XML::STX::Stylesheet; 8use XML::STX::Buffer; 9use Clone qw(clone); 10 11@XML::STX::Parser::ISA = qw(XML::STX::Base); 12 13my $ATT_NUMBER = '\d+(\\.\d*)?|\\.\d+'; 14my $ATT_URIREF = '[a-z][\w\;\/\?\:\@\&\=\+\$\,\-\_\.\!\~\*\'\(\)\%]+'; 15my $ATT_STRING = '[\w][\w-]*'; 16my $ATT_NCNAME = '[A-Za-z_][\w\\.\\-]*'; 17my $ATT_QNAME = "($ATT_NCNAME:)?$ATT_NCNAME"; 18my $ATT_QNAMES = "$ATT_QNAME( $ATT_QNAME)*"; 19 20# -------------------------------------------------- 21 22sub new { 23 my $class = shift; 24 my $options = ($#_ == 0) ? shift : { @_ }; 25 26 my $self = bless $options, $class; 27 return $self; 28} 29 30# content ---------------------------------------- 31 32sub start_document { 33 my $self = shift; 34 35 $self->{e_stack} ||= []; 36 $self->{g_stack} ||= []; 37 $self->{c_template} ||= []; 38 $self->{nsc} ||= XML::NamespaceSupport->new({ xmlns => 1 }); 39} 40 41sub end_document { 42 my $self = shift; 43 44 # post-processing 45 $self->_process_templates($self->{Sheet}->{dGroup}) 46 if $self->{Sheet}->{alias}->[0]; 47 48 return $self->{Sheet}; 49} 50 51sub start_element { 52 my $self = shift; 53 my $el = shift; 54 55 #print "COMP: $el->{Name}\n"; 56 $self->doError(201, 3) if $self->{end}; 57 58 $el->{vars} = []; 59 $self->{nsc}->pushContext; 60 61 my $a = exists $el->{Attributes} ? $el->{Attributes} : {}; 62 my $e_stack_top = $#{$self->{e_stack}} == -1 ? undef 63 : $self->{e_stack}->[-1]; 64 my $g_stack_top = $#{$self->{g_stack}} == -1 ? undef 65 : $self->{g_stack}->[-1]; 66 67 # STX instructions ================================================== 68 if (defined $el->{NamespaceURI} and $el->{NamespaceURI} eq STX_NS_URI) { 69 70 # <stx:transform> ---------------------------------------- 71 if ($el->{LocalName} eq 'transform') { 72 73 $el->{LocalName} = 'group' if $self->{include}; 74 75 if ($self->_allowed($el->{LocalName})) { 76 77 # included module 78 if ($self->{include}) { 79 #print "COMP: >include\n"; 80 $el->{LocalName} = 'transform'; 81 82 my $g = XML::STX::Group->new($self->{Sheet}->{next_gid}, 83 $g_stack_top); 84 #print "COMP: >new group $self->{Sheet}->{next_gid} $g\n"; 85 86 # the group is linked from the previous group 87 $g_stack_top->{groups}->{$self->{Sheet}->{next_gid}} = $g; 88 89 push @{$self->{g_stack}}, $g; 90 $self->{Sheet}->{next_gid}++; 91 92 # principal module 93 } else { 94 $self->{Sheet} = XML::STX::Stylesheet->new(); 95 push @{$self->{g_stack}}, $self->{Sheet}->{dGroup}; 96 #print "COMP: >new stylesheet $self->{Sheet}\n"; 97 #print "COMP: >default group $self->{Sheet}->{dGroup}->{gid}\n"; 98 99 $self->doError(212, 3, '<stx:transform>', 'version') 100 unless exists $el->{Attributes}->{'{}version'}; 101 102 $self->doError(214, 3, 'version', '<stx:transform>', '1.0') 103 unless $el->{Attributes}->{'{}version'}->{Value} eq STX_VERSION; 104 } 105 106 # options: stxpath-default-namespace 107 if (exists $a->{'{}stxpath-default-namespace'}) { 108 if ($a->{'{}stxpath-default-namespace'}->{Value} 109 =~ /^$ATT_URIREF$/) { 110 push @{$self->{Sheet}->{Options}-> 111 {'stxpath-default-namespace'}}, 112 $a->{'{}stxpath-default-namespace'}->{Value}; 113 } else { 114 $self->doError(217, 3, 'stxpath-default-namespace', 115 $a->{'{}stxpath-default-namespace'}->{Value}, 116 'uri-reference', ); 117 } 118 } 119 120 # options: output-encoding 121 unless ($self->{include}) { 122 if (exists $a->{'{}output-encoding'}) { 123 if ($a->{'{}output-encoding'}->{Value} 124 =~ /^$ATT_STRING$/) { 125 $self->{Sheet}->{Options}->{'output-encoding'} 126 = $a->{'{}output-encoding'}->{Value}; 127 } else { 128 $self->doError(217, 3, 'output-encoding', 129 $a->{'{}output-encoding'}->{Value}, 130 'string'); 131 } 132 } 133 } 134 135 # options: recognize-cdata 136 if (exists $a->{'{}recognize-cdata'}) { 137 if ($a->{'{}recognize-cdata'}->{Value} eq 'no') { 138 $self->{g_stack}->[-1]->{Options}->{'recognize-cdata'} = 0 139 } elsif ($a->{'{}recognize-cdata'}->{Value} ne 'yes') { 140 $self->doError(205, 3, 'recognize-data', 141 $a->{'{}recognize-cdata'}->{Value}); 142 } 143 } 144 145 # options: pass-through 146 if (exists $a->{'{}pass-through'}) { 147 if ($a->{'{}pass-through'}->{Value} eq 'all') { 148 $self->{g_stack}->[-1]->{Options}->{'pass-through'} = 1 149 150 } elsif ($a->{'{}pass-through'}->{Value} eq 'text') { 151 $self->{g_stack}->[-1]->{Options}->{'pass-through'} = 2 152 153 } elsif ($a->{'{}pass-through'}->{Value} ne 'none') { 154 $self->doError(206, 3, 155 $a->{'{}pass-through'}->{Value}); 156 } 157 } 158 159 # options: strip-space 160 if (exists $a->{'{}strip-space'}) { 161 if ($a->{'{}strip-space'}->{Value} eq 'yes') { 162 $self->{g_stack}->[-1]->{Options}->{'strip-space'} = 1 163 } elsif ($a->{'{}strip-space'}->{Value} ne 'no') { 164 $self->doError(205, 3, 'strip-space', 165 $a->{'{}strip-space'}->{Value}); 166 } 167 } 168 169 } 170 171 # <stx:include> ---------------------------------------- 172 } elsif ($el->{LocalName} eq 'include') { 173 174 if ($self->_allowed($el->{LocalName})) { 175 176 $self->doError(212, 3, '<stx:include>', 'href') 177 unless exists $a->{'{}href'}; 178 179 $self->doError(214,3,'href','<stx:include>', 'URI reference') 180 unless $a->{'{}href'}->{Value} =~ /^$ATT_URIREF$/; 181 182 my $source = $self->{URIResolver}->resolve($a->{'{}href'}->{Value}, 183 $self->{URI}); 184 185 # nested compiler inherits properties from the current one 186 my $iP = XML::STX::Parser->new({include => 1}); 187 $iP->{Sheet} = $self->{Sheet}; 188 $iP->{e_stack} = $self->{e_stack}; 189 $iP->{g_stack} = $self->{g_stack}; 190 $iP->{nsc} = $self->{nsc}; 191 $iP->{DBG} = $self->{DBG}; 192 $iP->{URIResolver} = $self->{URIResolver}; 193 $iP->{ErrorListener} = $self->{ErrorListener}; 194 $iP->{URI} = $self->{URI}; 195 196 $source->{XMLReader}->{Handler} = $iP; 197 $source->{XMLReader}->parse_uri($source->{SystemId}); 198 } 199 200 # <stx:namespace-alias> ---------------------------------------- 201 } elsif ($el->{LocalName} eq 'namespace-alias') { 202 203 if ($self->_allowed($el->{LocalName})) { 204 205 # --- stylesheet-prefix --- 206 $self->doError(212, 3, '<stx:namespace-alias>', 'stylesheet-prefix') 207 unless exists $a->{'{}stylesheet-prefix'}; 208 209 $self->doError(214, 3, 'stylesheet-prefix', 210 '<stx:namespace-alias>', 'NCName') 211 unless $a->{'{}stylesheet-prefix'}->{Value} =~ /^$ATT_NCNAME$/ 212 or $a->{'{}stylesheet-prefix'}->{Value} eq '#default'; 213 214 my $pre1 = $a->{'{}stylesheet-prefix'}->{Value} eq '#default' 215 ? '' : $a->{'{}stylesheet-prefix'}->{Value}; 216 my $ns1 = $self->{nsc}->get_uri($pre1); 217 #print "COMP: ns-alias> $pre1:$ns1\n"; 218 219 $self->doError(221, 3, $a->{'{}stylesheet-prefix'}->{Value}, 220 'stx:namespace-alias') unless $ns1; 221 222 # --- result-prefix --- 223 $self->doError(212, 3, '<stx:namespace-alias>', 'result-prefix') 224 unless exists $a->{'{}result-prefix'}; 225 226 $self->doError(214, 3, 'result-prefix', 227 '<stx:namespace-alias>', 'NCName') 228 unless $a->{'{}result-prefix'}->{Value} =~ /^$ATT_NCNAME$/ 229 or $a->{'{}result-prefix'}->{Value} eq '#default'; 230 231 my $pre2 = $a->{'{}result-prefix'}->{Value} eq '#default' 232 ? '' : $a->{'{}result-prefix'}->{Value}; 233 my $ns2 = $self->{nsc}->get_uri($pre2); 234 #print "COMP: ns-alias> $pre2:$ns2\n"; 235 236 $self->doError(221, 3, $a->{'{}result-prefix'}->{Value}, 237 'stx:namespace-alias') unless $ns2; 238 239 unshift @{$self->{Sheet}->{alias}}, [[$ns1, $pre1], [$ns2, $pre2]]; 240 } 241 242 # <stx:group> ---------------------------------------- 243 } elsif ($el->{LocalName} eq 'group') { 244 245 if ($self->_allowed($el->{LocalName})) { 246 247 my $g = XML::STX::Group->new($self->{Sheet}->{next_gid}, 248 $g_stack_top); 249 #print "COMP: >new group $self->{Sheet}->{next_gid} $g\n"; 250 251 # the group is linked from the previous group 252 $g_stack_top->{groups}->{$self->{Sheet}->{next_gid}} = $g; 253 254 # the group inherits pc2 templates from all ancestors 255 foreach (@{$self->{g_stack}}) { 256 push @{$g->{pc2}}, @{$_->{vGroup}}; 257 push @{$g->{pc2A}}, @{$_->{vGroupA}}; 258 259 foreach my $p (@{$_->{vGroupP}}) { 260 $self->doError(220, 3, $p->{name}, 2) 261 if $g->{pc2P}->{$p->{name}}; 262 $g->{pc2P}->{$p->{name}} = $p; 263 } 264 } 265 266 if (exists $a->{'{}name'}) { 267 $self->doError(214,3,'name','<stx:group>', 'qname') 268 unless $a->{'{}name'}->{Value} =~ /^$ATT_QNAME$/; 269 $g->{name} = $a->{'{}name'}->{Value}; 270 271 $g->{name} = $self->_expand_qname($g->{name}); 272 273 $self->doError(219, 3, 'group', $g->{name}) 274 if exists $self->{Sheet}->{named_groups}->{$g->{name}}; 275 276 $self->{Sheet}->{named_groups}->{$g->{name}} = $g; 277 } 278 279 # options: recognize-cdata 280 if (exists $a->{'{}recognize-cdata'}) { 281 if ($a->{'{}recognize-cdata'}->{Value} eq 'no') { 282 $g->{Options}->{'recognize-cdata'} = 0 283 284 } elsif ($a->{'{}recognize-cdata'}->{Value} eq 'yes') { 285 $g->{Options}->{'recognize-cdata'} = 1 286 287 } elsif ($a->{'{}recognize-cdata'}->{Value} eq 'inherit') { 288 $g->{Options}->{'recognize-cdata'} 289 = $g->{group}->{Options}->{'recognize-cdata'} 290 291 } else { 292 $self->doError(205, 3, 'recognize-data', 293 $a->{'{}recognize-cdata'}->{Value}); 294 } 295 } else { 296 $g->{Options}->{'recognize-cdata'} 297 = $g->{group}->{Options}->{'recognize-cdata'} 298 } 299 300 # options: pass-through 301 if (exists $a->{'{}pass-through'}) { 302 if ($a->{'{}pass-through'}->{Value} eq 'all') { 303 $g->{Options}->{'pass-through'} = 1 304 305 } elsif ($a->{'{}pass-through'}->{Value} eq 'text') { 306 $g->{Options}->{'pass-through'} = 2 307 308 } elsif ($a->{'{}pass-through'}->{Value} eq 'none') { 309 $g->{Options}->{'pass-through'} = 0 310 311 } elsif ($a->{'{}pass-through'}->{Value} eq 'inherit') { 312 $g->{Options}->{'pass-through'} 313 = $g->{group}->{Options}->{'pass-through'} 314 315 } else { 316 $self->doError(206, 3, 317 $a->{'{}pass-through'}->{Value}); 318 } 319 } else { 320 $g->{Options}->{'pass-through'} 321 = $g->{group}->{Options}->{'pass-through'} 322 } 323 324 # options: strip-space 325 if (exists $a->{'{}strip-space'}) { 326 if ($a->{'{}strip-space'}->{Value} eq 'yes') { 327 $g->{Options}->{'strip-space'} = 1 328 329 } elsif ($a->{'{}strip-space'}->{Value} eq 'no') { 330 $g->{Options}->{'strip-space'} = 0 331 332 } elsif ($a->{'{}strip-space'}->{Value} eq 'inherit') { 333 $g->{Options}->{'strip-space'} 334 = $g->{group}->{Options}->{'strip-space'} 335 336 } else { 337 $self->doError(205, 3, 'strip-space', 338 $a->{'{}strip-space'}->{Value}); 339 } 340 } else { 341 $g->{Options}->{'strip-space'} 342 = $g->{group}->{Options}->{'strip-space'} 343 } 344 345 push @{$self->{g_stack}}, $g; 346 $self->{Sheet}->{next_gid}++; 347 } 348 349 # <stx:template> ---------------------------------------- 350 } elsif ($el->{LocalName} eq'template') { 351 352 if ($self->_allowed($el->{LocalName})) { 353 354 my $t = XML::STX::Template->new($self->{Sheet}->{next_tid}, 355 $g_stack_top); 356 357 # --- match --- 358 $self->doError(212, 3, '<stx:template>', 'match') 359 unless exists $a->{'{}match'}; 360 361 $t->{pattern} = $a->{'{}match'}->{Value}; 362 $t->{match} = $self->tokenize_match($a->{'{}match'}->{Value}); 363 364 if ($#{$t->{match}->[0]->[0]->{step}} > -1) { 365 foreach (@{$t->{match}}) { 366 if ($_->[-1]->{step}->[0] =~ /^@/) { 367 $t->{_att} = 1; 368 $t->{_not_att} = 0; 369 } elsif ($_->[-1]->{step}->[0] =~ /^node\(\)/) { 370 $t->{_att} = 1; 371 $t->{_not_att} = 1; 372 } else { 373 $t->{_att} = 0; 374 $t->{_not_att} = 1; 375 } 376 } 377 } else { # '/' root 378 $t->{_att} = 0; 379 $t->{_not_att} = 1; 380 } 381 #print "COMP: att: $t->{_att}, not att: $t->{_not_att}\n"; 382 383 # --- priority --- 384 if (exists $a->{'{}priority'}) { 385 $self->doError(214, 3, 'priority', 386 '<stx:template>', 'number') 387 unless $a->{'{}priority'}->{Value} 388 =~ /^$ATT_NUMBER$/; 389 $t->{priority} = [$a->{'{}priority'}->{Value}]; 390 $t->{eff_p} = $a->{'{}priority'}->{Value}; 391 } 392 unless (exists $t->{priority}) { 393 $t->{priority} 394 = $self->match_priority($a->{'{}match'}->{Value}); 395 396 if (defined $t->{priority}->[1]) { 397 $t->{eff_p} = 10; 398 $g_stack_top->{_complex_priority} = 1; 399 400 } else { 401 $t->{eff_p} = $t->{priority}->[0]; 402 } 403 } 404 405 # --- public --- 406 $t->{public} = 0; 407 # visible from the current group 408 unshift @{$g_stack_top->{pc1}}, $t if $t->{_not_att}; 409 unshift @{$g_stack_top->{pc1A}}, $t if $t->{_att}; 410 411 if (exists $a->{'{}public'}) { 412 413 if ($a->{'{}public'}->{Value} eq 'yes') { 414 $t->{public} = 1; 415 416 if ($t->{_not_att}) { 417 # visible from the parent group 418 unshift @{$self->{g_stack}->[-2]->{pc1}}, $t 419 if $#{$self->{g_stack}} > 0; 420 } 421 if ($t->{_att}) { # to match against attributes 422 # visible from the parent group 423 unshift @{$self->{g_stack}->[-2]->{pc1A}}, $t 424 if $#{$self->{g_stack}} > 0; 425 } 426 427 } elsif ($a->{'{}public'}->{Value} ne 'no') { 428 $self->doError(205, 3, 'public', $a->{'{}public'}->{Value}); 429 } 430 } elsif ($e_stack_top->{LocalName} eq 'transform') { 431 $t->{public} = 1; 432 433 if ($t->{_not_att}) { 434 # visible from the parent group 435 unshift @{$self->{g_stack}->[-2]->{pc1}}, $t 436 if $#{$self->{g_stack}} > 0; 437 } 438 if ($t->{_att}) { # to match against attributes 439 # visible from the parent group 440 unshift @{$self->{g_stack}->[-2]->{pc1A}}, $t 441 if $#{$self->{g_stack}} > 0; 442 } 443 } 444 445 # --- visibility --- 446 $t->{visibility} = 1; 447 if (exists $a->{'{}visibility'}) { 448 449 if ($a->{'{}visibility'}->{Value} eq 'group') { 450 $t->{visibility} = 2; 451 push @{$g_stack_top->{vGroup}}, $t if $t->{_not_att}; 452 push @{$g_stack_top->{vGroupA}}, $t if $t->{_att}; 453 454 } elsif ($a->{'{}visibility'}->{Value} eq 'global') { 455 $t->{visibility} = 3; 456 457 if ($t->{_not_att}) { 458 push @{$g_stack_top->{vGroup}}, $t; 459 unshift @{$self->{Sheet}->{dGroup}->{pc3}}, $t; 460 } 461 if ($t->{_att}) { # to match against attributes 462 push @{$g_stack_top->{vGroupA}}, $t; 463 unshift @{$self->{Sheet}->{dGroup}->{pc3A}}, $t; 464 } 465 466 } elsif ($a->{'{}visibility'}->{Value} ne 'local') { 467 $self->doError(204, 3, $a->{'{}visibility'}->{Value}); 468 } 469 } 470 471 # --- new-scope --- 472 $t->{'new-scope'} = 0; 473 if (exists $a->{'{}new-scope'}) { 474 if ($a->{'{}new-scope'}->{Value} eq 'yes') { 475 $t->{'new-scope'} = 1 476 } elsif ($a->{'{}new-scope'}->{Value} ne 'no') { 477 $self->doError(205, 3, 'new-scope', 478 $a->{'{}new-scope'}->{Value}); 479 } 480 } 481 482 #print "COMP: >new template $self->{Sheet}->{next_tid} $t\n"; 483 #print "COMP: >matching $t->{match}\n"; 484 $g_stack_top->{templates}->{$self->{Sheet}->{next_tid}} = $t; 485 486 push @{$self->{c_template}}, $t; 487 $self->{Sheet}->{next_tid}++; 488 } 489 490 # <stx:procedure> ---------------------------------------- 491 492 } elsif ($el->{LocalName} eq'procedure') { 493 494 if ($self->_allowed($el->{LocalName})) { 495 496 my $p = XML::STX::Template->new($self->{Sheet}->{next_tid}, 497 $g_stack_top); 498 499 # --- name --- 500 $self->doError(212, 3, '<stx:procedure>', 'name') 501 unless exists $a->{'{}name'}; 502 503 $self->doError(214,3,'name','<stx:procedure>', 'qname') 504 unless $a->{'{}name'}->{Value} =~ /^$ATT_QNAME$/; 505 $p->{name} = $a->{'{}name'}->{Value}; 506 507 $p->{name} = $self->_expand_qname($p->{name}); 508 509 # --- public --- 510 $p->{public} = 0; 511 # visible from the current group 512 $g_stack_top->{pc1P}->{$p->{name}} = $p; 513 514 if (exists $a->{'{}public'}) { 515 516 if ($a->{'{}public'}->{Value} eq 'yes') { 517 $p->{public} = 1; 518 #push @{$g_stack_top->{vPublicP}}, $p; 519 520 # visible from the parent group 521 $self->{g_stack}->[-2]->{pc1P}->{$p->{name}} = $p 522 if $#{$self->{g_stack}} > 0; 523 524 } elsif ($a->{'{}public'}->{Value} ne 'no') { 525 $self->doError(205, 3, 'public', $a->{'{}public'}->{Value}); 526 } 527 528 } elsif ($e_stack_top->{LocalName} eq 'transform') { 529 $p->{public} = 1; 530 #push @{$g_stack_top->{vPublicP}}, $p; 531 532 # visible from the parent group 533 $self->{g_stack}->[-2]->{pc1P}->{$p->{name}} = $p 534 if $#{$self->{g_stack}} > 0; 535 } 536 537 # --- visibility --- 538 $p->{visibility} = 1; 539 if (exists $a->{'{}visibility'}) { 540 541 if ($a->{'{}visibility'}->{Value} eq 'group') { 542 $p->{visibility} = 2; 543 push @{$g_stack_top->{vGroupP}}, $p; 544 545 } elsif ($a->{'{}visibility'}->{Value} eq 'global') { 546 $p->{visibility} = 3; 547 548 push @{$g_stack_top->{vGroupP}}, $p; 549 $self->{Sheet}->{dGroup}->{pc3P}->{$p->{name}} = $p; 550 551 } elsif ($a->{'{}visibility'}->{Value} ne 'local') { 552 $self->doError(204, 3, $a->{'{}visibility'}->{Value}); 553 } 554 } 555 556 # --- new-scope --- 557 if (exists $a->{'{}new-scope'}) { 558 if ($a->{'{}new-scope'}->{Value} eq 'yes') { 559 $p->{'new-scope'} = 1 560 } elsif ($a->{'{}new-scope'}->{Value} ne 'no') { 561 $self->doError(205, 3, 'new-scope', 562 $a->{'{}new-scope'}->{Value}); 563 } 564 } 565 566 #print "COMP: >new procedure $self->{Sheet}->{next_tid} $p\n"; 567 #print "COMP: >name $p->{name}\n"; 568 $g_stack_top->{procedures}->{$self->{Sheet}->{next_tid}} = $p; 569 570 push @{$self->{c_template}}, $p; 571 $self->{Sheet}->{next_tid}++; 572 } 573 574 # <stx:process-children> ---------------------------------------- 575 } elsif ($el->{LocalName} eq'process-children') { 576 577 if ($self->_allowed($el->{LocalName})) { 578 579 my $group; 580 if (exists $a->{'{}group'}) { 581 $self->doError(214,3,'group','<stx:process-children>', 582 'qname') 583 unless $a->{'{}group'}->{Value} =~ /^$ATT_QNAME$/; 584 $group = $a->{'{}group'}->{Value}; 585 586 $group = $self->_expand_qname($group); 587 } 588 589 #TBD: filter attributes 590 591 push @{$self->{c_template}->[-1]->{instructions}}, 592 [I_P_CHILDREN_START, $group]; 593 #print "COMP: >PROCESS_CHILDREN_START\n"; 594 } 595 596 # <stx:process-siblings> ---------------------------------------- 597 } elsif ($el->{LocalName} eq'process-siblings') { 598 599 if ($self->_allowed($el->{LocalName})) { 600 601 my $group; 602 if (exists $a->{'{}group'}) { 603 $self->doError(214,3,'group','<stx:process-siblings>', 604 'qname') 605 unless $a->{'{}group'}->{Value} =~ /^$ATT_QNAME$/; 606 $group = $a->{'{}group'}->{Value}; 607 608 $group = $self->_expand_qname($group); 609 } 610 611 # --- while --- 612 $self->{_sib}->[0] = exists $a->{'{}while'} 613 ? $self->tokenize_match($a->{'{}while'}->{Value}) : undef; 614 615 # --- until --- 616 $self->{_sib}->[1] = exists $a->{'{}until'} 617 ? $self->tokenize_match($a->{'{}until'}->{Value}) : undef; 618 619 #TBD: filter attributes 620 621 push @{$self->{c_template}->[-1]->{instructions}}, 622 [I_P_SIBLINGS_START, $group]; 623 #print "COMP: >PROCESS_SIBLINGS_START\n"; 624 } 625 626 # <stx:process-attributes> ---------------------------------------- 627 } elsif ($el->{LocalName} eq'process-attributes') { 628 629 if ($self->_allowed($el->{LocalName})) { 630 631 my $group; 632 if (exists $a->{'{}group'}) { 633 $self->doError(214,3,'group','<stx:process-attributes>', 634 'qname') 635 unless $a->{'{}group'}->{Value} =~ /^$ATT_QNAME$/; 636 $group = $a->{'{}group'}->{Value}; 637 638 $group = $self->_expand_qname($group); 639 } 640 641 push @{$self->{c_template}->[-1]->{instructions}}, 642 [I_P_ATTRIBUTES_START, $group]; 643 #print "COMP: >PROCESS ATTRIBUTES START\n"; 644 } 645 646 # <stx:process-self> ---------------------------------------- 647 } elsif ($el->{LocalName} eq'process-self') { 648 649 if ($self->_allowed($el->{LocalName})) { 650 651 my $group; 652 if (exists $a->{'{}group'}) { 653 $self->doError(214,3,'group','<stx:process-self>', 654 'qname') 655 unless $a->{'{}group'}->{Value} =~ /^$ATT_QNAME$/; 656 $group = $a->{'{}group'}->{Value}; 657 658 $group = $self->_expand_qname($group); 659 } 660 661 $self->{c_template}->[-1]->{_self} = 1; 662 663 push @{$self->{c_template}->[-1]->{instructions}}, 664 [I_P_SELF_START, $group]; 665 #print "COMP: >PROCESS SELF START\n"; 666 } 667 668 # <stx:call-procedure> ---------------------------------------- 669 } elsif ($el->{LocalName} eq'call-procedure') { 670 671 if ($self->_allowed($el->{LocalName})) { 672 673 # --- name --- 674 $self->doError(212, 3, '<stx:call-procedure>', 'name') 675 unless exists $a->{'{}name'}; 676 $self->doError(214,3,'name','<stx:call-procedure>','qname') 677 unless $a->{'{}name'}->{Value} =~ /^$ATT_QNAME$/; 678 679 my $name = $a->{'{}name'}->{Value}; 680 $name = $self->_expand_qname($name); 681 682 # --- group --- 683 my $group; 684 if (exists $a->{'{}group'}) { 685 $self->doError(214,3,'group','<stx:call-procedure>', 'qname') 686 unless $a->{'{}group'}->{Value} =~ /^$ATT_QNAME$/; 687 $group = $a->{'{}group'}->{Value}; 688 689 $group = $self->_expand_qname($group); 690 } 691 692 push @{$self->{c_template}->[-1]->{instructions}}, 693 [I_CALL_PROCEDURE_START, $name, $group]; 694 #print "COMP: >CALL PROCEDURE START\n"; 695 } 696 697 # <stx:if> ---------------------------------------- 698 } elsif ($el->{LocalName} eq 'if') { 699 700 if ($self->_allowed($el->{LocalName})) { 701 702 $self->doError(212, 3, '<stx:if>', 'test') 703 unless exists $a->{'{}test'}; 704 705 my $expr = $self->tokenize($a->{'{}test'}->{Value}); 706 push @{$self->{c_template}->[-1]->{instructions}}, 707 [I_IF_START, $expr]; 708 #print "COMP: >IF\n"; 709 } 710 711 # <stx:else> ---------------------------------------- 712 } elsif ($el->{LocalName} eq 'else') { 713 714 if ($self->_allowed($el->{LocalName})) { 715 716 my $last = $self->{c_template}->[-1]->{instructions}->[-1]->[0]; 717 $self->doError(218, 3, 'stx:else', 'stx:if', $last) 718 if $last != I_IF_END; 719 720 push @{$self->{c_template}->[-1]->{instructions}}, [I_ELSE_START]; 721 #print "COMP: >ELSE\n"; 722 } 723 724 # <stx:choose> ---------------------------------------- 725 } elsif ($el->{LocalName} eq 'choose') { 726 727 if ($self->_allowed($el->{LocalName})) { 728 729 $self->doError(208, 3, 'stx:choose') if $self->{_choose}; 730 731 $self->{_choose} = 1; 732 #print "COMP: >CHOOSE\n"; 733 } 734 735 # <stx:when> ---------------------------------------- 736 } elsif ($el->{LocalName} eq 'when') { 737 738 if ($self->_allowed($el->{LocalName})) { 739 740 $self->doError(212, 3, '<stx:when>', 'test') 741 unless exists $a->{'{}test'}; 742 743 my $expr = $self->tokenize($a->{'{}test'}->{Value}); 744 push @{$self->{c_template}->[-1]->{instructions}}, 745 [I_ELSIF_START, $expr]; 746 #print "COMP: >WHEN\n"; 747 } 748 749 # <stx:otherwise> ---------------------------------------- 750 } elsif ($el->{LocalName} eq 'otherwise') { 751 752 if ($self->_allowed($el->{LocalName})) { 753 754 my $last = $self->{c_template}->[-1]->{instructions}->[-1]->[0]; 755 $self->doError(218, 3, 'stx:otherwise', 'stx:when', $last) 756 if $last != I_ELSIF_END; 757 758 push @{$self->{c_template}->[-1]->{instructions}}, [I_ELSE_START]; 759 #print "COMP: >OTHERWISE\n"; 760 } 761 762 # <stx:value-of> ---------------------------------------- 763 } elsif ($el->{LocalName} eq 'value-of') { 764 765 if ($self->_allowed($el->{LocalName})) { 766 767 $self->doError(212, 3, '<stx:value-of>', 'select') 768 unless exists $a->{'{}select'}; 769 770 $self->doError(213, 3, 'select', '<stx:value-of>') 771 if $a->{'{}select'}->{Value} =~ /\{|\}/; 772 773 my $expr = $self->tokenize($a->{'{}select'}->{Value}); 774 775 my $sep = exists $a->{'{}separator'} 776 ? $self->_avt($a->{'{}separator'}->{Value}) : ' '; 777 778 push @{$self->{c_template}->[-1]->{instructions}}, 779 [I_CHARACTERS, $expr, $sep]; 780 #print "COMP: >CHARACTER\n"; 781 } 782 783 # <stx:copy> ---------------------------------------- 784 } elsif ($el->{LocalName} eq 'copy') { 785 786 if ($self->_allowed($el->{LocalName})) { 787 788 my $attributes = '#all'; # TBD: changed in the spec!!! 789 if (exists $a->{'{}attributes'}) { 790 $self->doError(217, 3, 'attributes', 791 $a->{'{}attributes'}->{Value}, 792 'list of qnames') 793 unless $a->{'{}attributes'}->{Value} 794 =~ /^($ATT_QNAMES|#none|#all)$/ 795 or $a->{'{}attributes'}->{Value} eq ''; 796 797 $attributes = $a->{'{}attributes'}->{Value}; 798 } 799 800 push @{$self->{c_template}->[-1]->{instructions}}, 801 [I_COPY_START, $attributes]; 802 #print "COMP: >COPY_START $attributes\n"; 803 } 804 805 # <stx:element> or <stx:start-element> ----------------- 806 } elsif ($el->{LocalName} eq 'element' 807 or $el->{LocalName} eq 'start-element') { 808 809 if ($self->_allowed($el->{LocalName})) { 810 811 $self->doError(212, 3, "<stx:$el->{LocalName}>", 'name') 812 unless exists $el->{Attributes}->{'{}name'}; 813 814 my $qn = $self->_avt($a->{'{}name'}->{Value}); 815 816 my $ns = exists $a->{'{}namespace'} 817 ? $self->_avt($a->{'{}namespace'}->{Value}) : undef; 818 819 push @{$self->{c_template}->[-1]->{instructions}}, 820 [I_ELEMENT_START, $qn, $ns, clone($self->{nsc})]; 821 #print "COMP: >ELEMENT_START\n"; 822 } 823 824 # <stx:end-element> ---------------------------------------- 825 } elsif ($el->{LocalName} eq'end-element') { 826 827 if ($self->_allowed($el->{LocalName})) { 828 829 $self->doError(212, 3, '<stx:end-element>', 'name') 830 unless exists $el->{Attributes}->{'{}name'}; 831 832 my $qn = $self->_avt($a->{'{}name'}->{Value}); 833 834 my $ns = exists $a->{'{}namespace'} 835 ? $self->_avt($a->{'{}namespace'}->{Value}) : undef; 836 837 push @{$self->{c_template}->[-1]->{instructions}}, 838 [I_ELEMENT_END, $qn, $ns, clone($self->{nsc})]; 839 #print "COMP: >ELEMENT_END\n"; 840 } 841 842 # <stx:attribute> ---------------------------------------- 843 } elsif ($el->{LocalName} eq'attribute') { 844 845 if ($self->_allowed($el->{LocalName})) { 846 847 my $ok; 848 my $insts = $self->{c_template}->[-1]->{instructions}; 849 for (my $i = 0; $i < @$insts; $i++) { 850 851 last if $insts->[$#$insts - $i]->[0] == I_ATTRIBUTE_END 852 or $insts->[$#$insts - $i]->[0] == I_ELEMENT_START 853 or $insts->[$#$insts - $i]->[0] == I_LITERAL_START 854 or $insts->[$#$insts - $i]->[0] == I_COPY_START; 855 # these instructions don't output anything 856 $self->doError(207, 3, $insts->[$#$insts - $i]->[0]) 857 unless $insts->[$#$insts - $i]->[0] > 100; 858 } 859 860 $self->doError(212, 3, "<stx:$el->{LocalName}>", 'name') 861 unless exists $el->{Attributes}->{'{}name'}; 862 863 my $qn = $self->_avt($a->{'{}name'}->{Value}); 864 865 my $ns = exists $a->{'{}namespace'} 866 ? $self->_avt($a->{'{}namespace'}->{Value}) : undef; 867 868 my $sel = exists $a->{'{}select'} ? 869 $self->tokenize($a->{'{}select'}->{Value}) : undef; 870 871 $self->{_attribute_select} = $sel; 872 push @{$self->{c_template}->[-1]->{instructions}}, 873 [I_ATTRIBUTE_START, $qn, $ns, clone($self->{nsc}), $sel]; 874 #print "COMP: >ATTRIBUTE_START\n"; 875 } 876 877 # <stx:text> ---------------------------------------- 878 } elsif ($el->{LocalName} eq 'text') { 879 880 $self->_allowed($el->{LocalName}); 881 882 # <stx:cdata> ---------------------------------------- 883 } elsif ($el->{LocalName} eq 'cdata') { 884 885 if ($self->_allowed($el->{LocalName})) { 886 887 push @{$self->{c_template}->[-1]->{instructions}}, 888 [I_CDATA_START]; 889 #print "COMP: >CDATA_START\n"; 890 } 891 892 # <stx:comment> ---------------------------------------- 893 } elsif ($el->{LocalName} eq'comment') { 894 895 if ($self->_allowed($el->{LocalName})) { 896 897 push @{$self->{c_template}->[-1]->{instructions}}, 898 [I_COMMENT_START]; 899 #print "COMP: >COMMENT_START\n"; 900 } 901 902 # <stx:processing-instruction> ----------------------------------- 903 } elsif ($el->{LocalName} eq'processing-instruction') { 904 905 if ($self->_allowed($el->{LocalName})) { 906 907 $self->doError(212, 3, "<stx:$el->{LocalName}>", 'name') 908 unless exists $el->{Attributes}->{'{}name'}; 909 910 my $target = $self->_avt($el->{Attributes}->{'{}name'}->{Value}); 911 912 push @{$self->{c_template}->[-1]->{instructions}}, 913 [I_PI_START, $target]; 914 #print "COMP: >PI_START\n"; 915 } 916 917 # <stx:variable> ---------------------------------------- 918 } elsif ($el->{LocalName} eq 'variable') { 919 920 if ($self->_allowed($el->{LocalName})) { 921 922 $self->doError(212, 3, "<stx:$el->{LocalName}>", 'name') 923 unless exists $el->{Attributes}->{'{}name'}; 924 $self->doError(217, 3, 'name', 925 $a->{'{}name'}->{Value}, 'qname') 926 unless $a->{'{}name'}->{Value} =~ /^($ATT_QNAME)$/; 927 928 my $name = $a->{'{}name'}->{Value}; 929 $name = $self->_expand_qname($name); 930 931 my $select; 932 my $default_select; 933 if (exists $a->{'{}select'}) { 934 $self->doError(213, 3, 'select', '<stx:variable>') 935 if $a->{'{}select'}->{Value} =~ /^\{|\}/; 936 $select = $self->tokenize($a->{'{}select'}->{Value}); 937 $default_select = 0; 938 } else { 939 $select = ['""']; # the empty string 940 $default_select = 1; 941 } 942 943 $self->{_variable_select} = $select; 944 945 # local variable ------------------------------ 946 if ($self->{c_template}->[0]) { 947 948 # variable already declared 949 $self->doError(211, 3, 'Local variable', "\'$name\'") 950 if exists $self->{c_template}->[-1]->{vars}->[0]->{$name}; 951 952 push @{$e_stack_top->{vars}}, $name; 953 $self->{c_template}->[-1]->{vars}->[0]->{$name} = []; 954 955 push @{$self->{c_template}->[-1]->{instructions}}, 956 [I_VARIABLE_START, $name, $select, $default_select]; 957 #print "COMP: >VARIABLE_START\n"; 958 959 # group variable ------------------------------ 960 } else { 961 962 # variable already declared 963 $self->doError(211, 3, 'Group variable', "\'$name\'") 964 if $g_stack_top->{vars}->[0]->{$name}; 965 966 my $keep_value = 0; 967 if (exists $a->{'{}keep-value'}) { 968 if ($a->{'{}keep-value'}->{Value} eq 'yes') { 969 $keep_value = 1 970 } elsif ($a->{'{}keep-value'}->{Value} ne 'no') { 971 $self->doError(205, 3, 'keep-value', 972 $a->{'{}keep-value'}->{Value}); 973 } 974 } 975 976 # actual value 977 $g_stack_top->{vars}->[0]->{$name}->[0] 978 = $self->_static_eval($select); 979 # init value 980 $g_stack_top->{vars}->[0]->{$name}->[1] 981 = clone($g_stack_top->{vars}->[0]->{$name}->[0]); 982 # keep value 983 $g_stack_top->{vars}->[0]->{$name}->[2] 984 = $keep_value; 985 #print "COMP: >GROUP_VARIABLE\n"; 986 } 987 } 988 989 # <stx:param> ---------------------------------------- 990 } elsif ($el->{LocalName} eq 'param') { 991 992 if ($self->_allowed($el->{LocalName})) { 993 994 $self->doError(212, 3, "<stx:$el->{LocalName}>", 'name') 995 unless exists $el->{Attributes}->{'{}name'}; 996 $self->doError(217, 3, 'name', 997 $a->{'{}name'}->{Value}, 'qname') 998 unless $a->{'{}name'}->{Value} =~ /^($ATT_QNAME)$/; 999 1000 my $name = $a->{'{}name'}->{Value}; 1001 $name = $self->_expand_qname($name); 1002 1003 my $select; 1004 my $default_select; 1005 if (exists $a->{'{}select'}) { 1006 $self->doError(213, 3, 'select', '<stx:param>') 1007 if $a->{'{}select'}->{Value} =~ /^\{|\}/; 1008 $select = $self->tokenize($a->{'{}select'}->{Value}); 1009 $default_select = 0; 1010 } else { 1011 $select = ['""']; # the empty string 1012 $default_select = 1; 1013 } 1014 1015 my $req = 0; 1016 if (exists $a->{'{}required'}) { 1017 if ($a->{'{}required'}->{Value} eq 'yes') { 1018 $req = 1 1019 } elsif ($a->{'{}required'}->{Value} ne 'no') { 1020 $self->doError(205, 3, 'required', 1021 $a->{'{}required'}->{Value}); 1022 } 1023 } 1024 1025 $self->{_variable_select} = $select; 1026 1027 # local parameter ------------------------------ 1028 if ($self->{c_template}->[0]) { 1029 1030 # parameter already declared 1031 $self->doError(211, 3, 'Local parameter', "\'$name\'") 1032 if exists $self->{c_template}->[-1]->{vars}->[0]->{$name}; 1033 1034 push @{$e_stack_top->{vars}}, $name; 1035 $self->{c_template}->[-1]->{vars}->[0]->{$name} = []; 1036 1037 push @{$self->{c_template}->[-1]->{instructions}}, 1038 [I_PARAMETER_START, $name, $select, $default_select, $req]; 1039 #print "COMP: >PARAMETER_START\n"; 1040 1041 # stylesheet parameter ------------------------------ 1042 } else { 1043 1044 # parameter already declared 1045 $self->doError(211, 3, 'Stylesheet parameter', "\'$name\'") 1046 if $self->{Sheet}->{dGroup}->{vars}->[0]->{$name}; 1047 1048 # actual value 1049 $self->{Sheet}->{dGroup}->{vars}->[0]->{$name}->[0] 1050 = $self->_static_eval($select); 1051 # init value 1052 $self->{Sheet}->{dGroup}->{vars}->[0]->{$name}->[1] 1053 = clone($self->{Sheet}->{dGroup}->{vars}->[0]->{$name}->[0]); 1054 # keep value 1055 $self->{Sheet}->{dGroup}->{vars}->[0]->{$name}->[2] = 0; 1056 1057 # list of params 1058 $self->{Sheet}->{dGroup}->{pars}->{$name} = $req; 1059 #print "COMP: >GROUP_VARIABLE - parameter\n"; 1060 } 1061 1062 } 1063 1064 # <stx:with-param> ---------------------------------------- 1065 } elsif ($el->{LocalName} eq 'with-param') { 1066 1067 if ($self->_allowed($el->{LocalName})) { 1068 1069 $self->doError(212, 3, "<stx:$el->{LocalName}>", 'name') 1070 unless exists $el->{Attributes}->{'{}name'}; 1071 $self->doError(217, 3, 'name', 1072 $a->{'{}name'}->{Value}, 'qname') 1073 unless $a->{'{}name'}->{Value} =~ /^($ATT_QNAME)$/; 1074 1075 my $name = $a->{'{}name'}->{Value}; 1076 $name = $self->_expand_qname($name); 1077 1078 my $select; 1079 my $default_select; 1080 if (exists $a->{'{}select'}) { 1081 $self->doError(213, 3, 'select', '<stx:with-param>') 1082 if $a->{'{}select'}->{Value} =~ /^\{|\}/; 1083 $select = $self->tokenize($a->{'{}select'}->{Value}); 1084 $default_select = 0; 1085 } else { 1086 $select = ['""']; # the empty string 1087 $default_select = 1; 1088 } 1089 1090 push @{$self->{c_template}->[-1]->{instructions}}, 1091 [I_WITH_PARAM_START, $name, $select, $default_select]; 1092 #print "COMP: >WITH_PARAM\n"; 1093 } 1094 1095 # <stx:assign> ---------------------------------------- 1096 } elsif ($el->{LocalName} eq 'assign') { 1097 1098 if ($self->_allowed($el->{LocalName})) { 1099 1100 $self->doError(212, 3, "<stx:$el->{LocalName}>", 'name') 1101 unless exists $el->{Attributes}->{'{}name'}; 1102 $self->doError(217, 3, 'name', 1103 $a->{'{}name'}->{Value}, 'qname') 1104 unless $a->{'{}name'}->{Value} =~ /^($ATT_QNAME)$/; 1105 1106 my $name = $a->{'{}name'}->{Value}; 1107 $name = $self->_expand_qname($name); 1108 1109 my $select; 1110 if (exists $a->{'{}select'}) { 1111 $self->doError(213, 3, 'select', '<stx:assign>') 1112 if $a->{'{}select'}->{Value} =~ /\{|\}/; 1113 $select = $self->tokenize($a->{'{}select'}->{Value}); 1114 } 1115 1116 $self->{_variable_select} = $select; 1117 1118 push @{$self->{c_template}->[-1]->{instructions}}, 1119 [I_ASSIGN_START, $name, $select]; 1120 #print "COMP: >ASSIGN_START\n"; 1121 } 1122 1123 1124 # <stx:buffer> ---------------------------------------- 1125 } elsif ($el->{LocalName} eq 'buffer') { 1126 1127 if ($self->_allowed($el->{LocalName})) { 1128 1129 # --- name --- 1130 $self->doError(212, 3, "<stx:$el->{LocalName}>", 'name') 1131 unless exists $el->{Attributes}->{'{}name'}; 1132 $self->doError(217, 3, 'name', 1133 $a->{'{}name'}->{Value}, 'qname') 1134 unless $a->{'{}name'}->{Value} =~ /^($ATT_QNAME)$/; 1135 1136 my $name = $a->{'{}name'}->{Value}; 1137 $name = $self->_expand_qname($name); 1138 1139 # local buffer ------------------------------ 1140 if ($self->{c_template}->[0]) { 1141 1142 # buffer already declared 1143 $self->doError(211, 3, 'Local buffer', "\'$name\'") 1144 if exists $self->{c_template}->[-1]->{bufs}->[0]->{$name}; 1145 1146 push @{$e_stack_top->{bufs}}, $name; 1147 1148 push @{$self->{c_template}->[-1]->{instructions}}, 1149 [I_BUFFER_START, $name]; 1150 #print "COMP: >BUFFER_START\n"; 1151 1152 # group buffer ------------------------------ 1153 } else { 1154 1155 # buffer already declared 1156 $self->doError(211, 3, 'Group buffer', "\'$name\'") 1157 if $self->{c_group}->{bufs}->[0]->{$name}; 1158 1159 # new buffer 1160 my $b = XML::STX::Buffer->new($name); 1161 $g_stack_top->{bufs}->[0]->{$name} = $b; 1162 1163 #print "COMP: >GROUP_BUFFER\n"; 1164 } 1165 } 1166 1167 # <stx:result-buffer> ---------------------------------------- 1168 } elsif ($el->{LocalName} eq 'result-buffer') { 1169 1170 if ($self->_allowed($el->{LocalName})) { 1171 1172 # --- name --- 1173 $self->doError(212, 3, "<stx:$el->{LocalName}>", 'name') 1174 unless exists $el->{Attributes}->{'{}name'}; 1175 $self->doError(217, 3, 'name', 1176 $a->{'{}name'}->{Value}, 'qname') 1177 unless $a->{'{}name'}->{Value} =~ /^($ATT_QNAME)$/; 1178 1179 my $name = $a->{'{}name'}->{Value}; 1180 $name = $self->_expand_qname($name); 1181 1182 my $clear = 0; 1183 if (exists $a->{'{}clear'}) { 1184 if ($a->{'{}clear'}->{Value} eq 'yes') { 1185 $clear = 1; 1186 } elsif ($a->{'{}clear'}->{Value} ne 'no') { 1187 $self->doError(205, 3, 'clear', $a->{'{}clear'}->{Value}); 1188 } 1189 } 1190 1191 push @{$self->{c_template}->[-1]->{instructions}}, 1192 [I_RES_BUFFER_START, $name, $clear]; 1193 #print "COMP: >RESULT_BUFFER_START\n"; 1194 } 1195 1196 # <stx:process-buffer> ---------------------------------------- 1197 } elsif ($el->{LocalName} eq'process-buffer') { 1198 1199 if ($self->_allowed($el->{LocalName})) { 1200 1201 # --- name --- 1202 $self->doError(212, 3, "<stx:$el->{LocalName}>", 'name') 1203 unless exists $el->{Attributes}->{'{}name'}; 1204 $self->doError(217, 3, 'name', 1205 $a->{'{}name'}->{Value}, 'qname') 1206 unless $a->{'{}name'}->{Value} =~ /^($ATT_QNAME)$/; 1207 1208 my $name = $a->{'{}name'}->{Value}; 1209 $name = $self->_expand_qname($name); 1210 1211 # --- group --- 1212 my $group; 1213 if (exists $a->{'{}group'}) { 1214 $self->doError(214,3,'group','<stx:process-buffer>', 1215 'qname') 1216 unless $a->{'{}group'}->{Value} =~ /^$ATT_QNAME$/; 1217 1218 $group = $self->_expand_qname($a->{'{}group'}->{Value}); 1219 } 1220 1221 push @{$self->{c_template}->[-1]->{instructions}}, 1222 [I_P_BUFFER_START, $name, $group]; 1223 #print "COMP: >PROCESS BUFFER START\n"; 1224 } 1225 1226 # <stx:result-document> ---------------------------------------- 1227 } elsif ($el->{LocalName} eq 'result-document') { 1228 1229 if ($self->_allowed($el->{LocalName})) { 1230 1231 # --- href --- 1232 $self->doError(212, 3, '<stx:result-document>', 'href') 1233 unless exists $a->{'{}href'}; 1234 1235 my $href = $self->tokenize($a->{'{}href'}->{Value}); 1236 1237 # --- encoding --- 1238 my $encoding; 1239 if (exists $a->{'{}encoding'}) { 1240 $self->doError(214,3,'encoding','<stx:result-document>', 1241 'string') 1242 unless $a->{'{}group'}->{Value} =~ /^$ATT_STRING$/; 1243 1244 $encoding = $a->{'{}encoding'}->{Value}; 1245 } 1246 1247 push @{$self->{c_template}->[-1]->{instructions}}, 1248 [I_RES_DOC_START, $href, $encoding]; 1249 #print "COMP: >RESULT_DOCUMENT_START\n"; 1250 } 1251 1252 # <stx:process-document> ---------------------------------------- 1253 } elsif ($el->{LocalName} eq'process-document') { 1254 1255 if ($self->_allowed($el->{LocalName})) { 1256 1257 # --- href --- 1258 $self->doError(212, 3, '<stx:process-document>', 'href') 1259 unless exists $a->{'{}href'}; 1260 1261 my $href = $self->tokenize($a->{'{}href'}->{Value}); 1262 1263 # --- group --- 1264 my $group; 1265 if (exists $a->{'{}group'}) { 1266 $self->doError(214,3,'group','<stx:process-document>', 1267 'qname') 1268 unless $a->{'{}group'}->{Value} =~ /^$ATT_QNAME$/; 1269 1270 $group = $self->_expand_qname($a->{'{}group'}->{Value}); 1271 } 1272 1273 # --- base --- 1274 my $base = exists $a->{'{}base'} 1275 ? $self->_avt($a->{'{}base'}->{Value}) : undef; 1276 1277 push @{$self->{c_template}->[-1]->{instructions}}, 1278 [I_P_DOC_START, $href, $group, $base]; 1279 #print "COMP: >PROCESS_DOCUMENT_START\n"; 1280 } 1281 1282 # <stx:for-each-item> ---------------------------------------- 1283 } elsif ($el->{LocalName} eq'for-each-item') { 1284 1285 if ($self->_allowed($el->{LocalName})) { 1286 1287 # --- name --- 1288 $self->doError(212, 3, '<stx:for-each-item>', 'name') 1289 unless exists $a->{'{}name'}; 1290 1291 $self->doError(214,3,'name','<stx:for-each-item>','qname') 1292 unless $a->{'{}name'}->{Value} =~ /^$ATT_QNAME$/; 1293 1294 my $name = $self->_expand_qname($a->{'{}name'}->{Value}); 1295 1296 # --- select --- 1297 $self->doError(212, 3, '<stx:for-each-item>', 'select') 1298 unless exists $a->{'{}select'}; 1299 1300 $self->doError(213, 3, 'select', '<stx:for-each-item>') 1301 if $a->{'{}select'}->{Value} =~ /\{|\}/; 1302 1303 my $expr = $self->tokenize($a->{'{}select'}->{Value}); 1304 1305 # --- content is template --- 1306 my $t = XML::STX::Template->new($self->{Sheet}->{next_tid}, 1307 $g_stack_top); 1308 1309 push @{$self->{c_template}->[-1]->{instructions}}, 1310 [I_FOR_EACH_ITEM, $name, $expr, $t]; 1311 #print "COMP: >FOR_EACH_ITEM\n"; 1312 1313 push @{$self->{c_template}}, $t; 1314 $self->{Sheet}->{next_tid}++; 1315 } 1316 1317 # <stx:while> ---------------------------------------- 1318 } elsif ($el->{LocalName} eq'while') { 1319 1320 if ($self->_allowed($el->{LocalName})) { 1321 1322 # --- test --- 1323 $self->doError(212, 3, '<stx:while>', 'test') 1324 unless exists $a->{'{}test'}; 1325 1326 $self->doError(213, 3, 'test', '<stx:while>') 1327 if $a->{'{}test'}->{Value} =~ /\{|\}/; 1328 1329 my $expr = $self->tokenize($a->{'{}test'}->{Value}); 1330 1331 unless (grep(index($_,'$') == 0, @$expr)) { 1332 $self->doError(222, 1, $a->{'{}test'}->{Value}); 1333 $self->{Sheet}->{Options}->{LoopLimit} = 1; 1334 } 1335 1336 # --- content is template --- 1337 my $t = XML::STX::Template->new($self->{Sheet}->{next_tid}, 1338 $g_stack_top); 1339 1340 push @{$self->{c_template}->[-1]->{instructions}}, 1341 [I_WHILE, $expr, $t]; 1342 #print "COMP: >WHILE\n"; 1343 1344 push @{$self->{c_template}}, $t; 1345 $self->{Sheet}->{next_tid}++; 1346 } 1347 1348 } else { 1349 $self->doError(209, 3, "<stx:$el->{LocalName}>") 1350 } 1351 1352 # literals ================================================== 1353 } else { 1354 1355 if ($self->_allowed('_literal')) { 1356 1357 if (exists $el->{Attributes}) { 1358 foreach my $ns (keys %{$el->{Attributes}}) { 1359 1360 # tokenize AVT in attributes 1361 $el->{Attributes}->{$ns}->{Value} 1362 = $self->_avt($el->{Attributes}->{$ns}->{Value}); 1363 } 1364 } 1365 1366 my $i = [I_LITERAL_START, $el]; 1367 push @{$self->{c_template}->[-1]->{instructions}}, $i; 1368 #print "COMP: >LITERAL_START $el->{Name}\n"; 1369 1370 } else { #??? 1371 $self->doError(210, 3, $el->{Name}) 1372 unless $el->{NamespaceURI}; 1373 } 1374 } 1375 1376 push @{$self->{e_stack}}, $el; 1377} 1378 1379sub end_element { 1380 my $self = shift; 1381 my $el = shift; 1382 1383 #print "COMP: \/$el->{Name}\n"; 1384 1385 # STX instructions ================================================== 1386 if (defined $el->{NamespaceURI} and $el->{NamespaceURI} eq STX_NS_URI) { 1387 1388 # <stx:transform> ---------------------------------------- 1389 if ($el->{LocalName} eq 'transform') { 1390 1391 if ($self->{include}) { 1392 #$self->_dump_g_stack; 1393 my $g = pop @{$self->{g_stack}}; 1394 $self->_sort_templates($g->{pc1}); 1395 $self->_sort_templates($g->{pc1A}); 1396 $self->_sort_templates($g->{pc2}); 1397 $self->_sort_templates($g->{pc2A}); 1398 1399 } else { 1400 # nothing else is allowed 1401 $self->_sort_templates($self->{Sheet}->{dGroup}->{pc1}); 1402 $self->_sort_templates($self->{Sheet}->{dGroup}->{pc1A}); 1403 $self->_sort_templates($self->{Sheet}->{dGroup}->{pc2}); 1404 $self->_sort_templates($self->{Sheet}->{dGroup}->{pc2A}); 1405 $self->_sort_templates($self->{Sheet}->{dGroup}->{pc3}); 1406 $self->_sort_templates($self->{Sheet}->{dGroup}->{pc3A}); 1407 $self->{end} = 1; 1408 } 1409 1410 # <stx:process-children> ---------------------------------------- 1411 } elsif ($el->{LocalName} eq 'process-children') { 1412 1413 push @{$self->{c_template}->[-1]->{instructions}}, [I_P_CHILDREN_END]; 1414 #print "COMP: >PROCESS CHILDREN END /$el->{Name}\n"; 1415 1416 # <stx:process-siblings> ---------------------------------------- 1417 } elsif ($el->{LocalName} eq 'process-siblings') { 1418 1419 push @{$self->{c_template}->[-1]->{instructions}}, 1420 [I_P_SIBLINGS_END, $self->{_sib}->[0], $self->{_sib}->[1]]; 1421 #print "COMP: >PROCESS SIBLINGS END /$el->{Name}\n"; 1422 1423 # <stx:process-self> ---------------------------------------- 1424 } elsif ($el->{LocalName} eq 'process-self') { 1425 1426 push @{$self->{c_template}->[-1]->{instructions}}, [I_P_SELF_END]; 1427 #print "COMP: >PROCESS SELF END /$el->{Name}\n"; 1428 1429 # <stx:process-attributes> ---------------------------------------- 1430 } elsif ($el->{LocalName} eq 'process-attributes') { 1431 1432 push @{$self->{c_template}->[-1]->{instructions}}, [I_P_ATTRIBUTES_END]; 1433 #print "COMP: >PROCESS ATTRIBUTES END /$el->{Name}\n"; 1434 1435 # <stx:process-buffer> ---------------------------------------- 1436 } elsif ($el->{LocalName} eq 'process-buffer') { 1437 1438 push @{$self->{c_template}->[-1]->{instructions}}, [I_P_BUFFER_END]; 1439 #print "COMP: >PROCESS BUFFER END /$el->{Name}\n"; 1440 1441 # <stx:process-document> ---------------------------------------- 1442 } elsif ($el->{LocalName} eq 'process-document') { 1443 1444 push @{$self->{c_template}->[-1]->{instructions}}, [I_P_DOC_END]; 1445 #print "COMP: >PROCESS DOCUMENT END /$el->{Name}\n"; 1446 1447 # <stx:call-procedure> ---------------------------------------- 1448 } elsif ($el->{LocalName} eq 'call-procedure') { 1449 1450 push @{$self->{c_template}->[-1]->{instructions}}, 1451 [I_CALL_PROCEDURE_END]; 1452 #print "COMP: >CALL PROCEDURE END /$el->{Name}\n"; 1453 1454 # <stx:variable> ---------------------------------------- 1455 } elsif ($el->{LocalName} =~ /^(variable|param)$/) { 1456 1457 # local variable 1458 if ($self->{c_template}->[0]) { 1459 1460 push @{$self->{c_template}->[-1]->{instructions}}, [I_VARIABLE_END]; 1461 #print "COMP: >VARIABLE END\n"; 1462 } else { 1463 # tbd 1464 } 1465 1466 # <stx:assign> ---------------------------------------- 1467 } elsif ($el->{LocalName} eq 'assign') { 1468 1469 push @{$self->{c_template}->[-1]->{instructions}}, [I_ASSIGN_END]; 1470 #print "COMP: >ASSIGN_END\n"; 1471 1472 # <stx:with-param> ---------------------------------------- 1473 } elsif ($el->{LocalName} eq 'with-param') { 1474 1475 push @{$self->{c_template}->[-1]->{instructions}}, [I_WITH_PARAM_END]; 1476 #print "COMP: >WITH_PARAM_END\n"; 1477 1478 # <stx:group> ---------------------------------------- 1479 } elsif ($el->{LocalName} eq 'group') { 1480 #$self->_dump_g_stack; 1481 my $g = pop @{$self->{g_stack}}; 1482 $self->_sort_templates($g->{pc1}); 1483 $self->_sort_templates($g->{pc1A}); 1484 $self->_sort_templates($g->{pc2}); 1485 $self->_sort_templates($g->{pc2A}); 1486 1487 # <stx:template> ---------------------------------------- 1488 } elsif ($el->{LocalName} eq 'template') { 1489 pop @{$self->{c_template}}; 1490 1491 # <stx:procedure> ---------------------------------------- 1492 } elsif ($el->{LocalName} eq 'procedure') { 1493 pop @{$self->{c_template}}; 1494 1495 # <stx:copy> ---------------------------------------- 1496 } elsif ($el->{LocalName} eq 'copy') { 1497 1498 push @{$self->{c_template}->[-1]->{instructions}}, [I_COPY_END]; 1499 #print "COMP: >COPY_END\n"; 1500 1501 # <stx:element> ---------------------------------------- 1502 } elsif ($el->{LocalName} eq 'element') { 1503 1504 push @{$self->{c_template}->[-1]->{instructions}}, [I_ELEMENT_END]; 1505 #print "COMP: >ELEMENT_END /$el->{Name}\n"; 1506 1507 # <stx:attribute> ---------------------------------------- 1508 } elsif ($el->{LocalName} eq 'attribute') { 1509 1510 push @{$self->{c_template}->[-1]->{instructions}}, [I_ATTRIBUTE_END]; 1511 #print "COMP: >ATTRIBUTE_END\n"; 1512 1513 # <stx:cdata> ---------------------------------------- 1514 } elsif ($el->{LocalName} eq 'cdata') { 1515 1516 push @{$self->{c_template}->[-1]->{instructions}}, [I_CDATA_END]; 1517 #print "COMP: >CDATA_END\n"; 1518 1519 # <stx:comment> ---------------------------------------- 1520 } elsif ($el->{LocalName} eq 'comment') { 1521 1522 push @{$self->{c_template}->[-1]->{instructions}}, [I_COMMENT_END]; 1523 #print "COMP: >COMMENT_END\n"; 1524 1525 # <stx:processing-instruction> ----------------------------------- 1526 } elsif ($el->{LocalName} eq 'processing-instruction') { 1527 1528 push @{$self->{c_template}->[-1]->{instructions}}, [I_PI_END]; 1529 #print "COMP: >PI_END\n"; 1530 1531 # <stx:if> ---------------------------------------- 1532 } elsif ($el->{LocalName} eq 'if') { 1533 1534 push @{$self->{c_template}->[-1]->{instructions}}, [I_IF_END]; 1535 #print "COMP: >IF_END\n"; 1536 1537 # <stx:else> ---------------------------------------- 1538 } elsif ($el->{LocalName} eq 'else') { 1539 1540 push @{$self->{c_template}->[-1]->{instructions}}, [I_ELSE_END]; 1541 #print "COMP: >ELSE_END\n"; 1542 1543 # <stx:choose> ---------------------------------------- 1544 } elsif ($el->{LocalName} eq 'choose') { 1545 1546 $self->{_choose} = undef; 1547 #print "COMP: >CHOOSE_END\n"; 1548 1549 # <stx:when> ---------------------------------------- 1550 } elsif ($el->{LocalName} eq 'when') { 1551 1552 push @{$self->{c_template}->[-1]->{instructions}}, [I_ELSIF_END]; 1553 #print "COMP: >WHEN_END\n"; 1554 1555 # <stx:otherwise> ---------------------------------------- 1556 } elsif ($el->{LocalName} eq 'otherwise') { 1557 1558 push @{$self->{c_template}->[-1]->{instructions}}, [I_ELSE_END]; 1559 #print "COMP: >OTHERWISE_END\n"; 1560 1561 # <stx:buffer> ---------------------------------------- 1562 } elsif ($el->{LocalName} eq 'buffer') { 1563 1564 # local buffer 1565 if ($self->{c_template}->[0]) { 1566 push @{$self->{c_template}->[-1]->{instructions}}, [I_BUFFER_END]; 1567 #print "COMP: >BUFFER_END\n"; 1568 1569 } else { 1570 # kontrola pres lookahead 1571 } 1572 1573 # <stx:result-buffer> ---------------------------------------- 1574 } elsif ($el->{LocalName} eq 'result-buffer') { 1575 1576 push @{$self->{c_template}->[-1]->{instructions}}, [I_RES_BUFFER_END]; 1577 #print "COMP: >RESULT_BUFFER_END\n"; 1578 1579 # <stx:result-document> ---------------------------------------- 1580 } elsif ($el->{LocalName} eq 'result-document') { 1581 1582 push @{$self->{c_template}->[-1]->{instructions}}, [I_RES_DOC_END]; 1583 #print "COMP: >RESULT_DOCUMENT_END\n"; 1584 1585 # <stx:for-each-item> ---------------------------------------- 1586 } elsif ($el->{LocalName} eq 'for-each-item') { 1587 pop @{$self->{c_template}}; 1588 1589 # <stx:while> ---------------------------------------- 1590 } elsif ($el->{LocalName} eq 'while') { 1591 pop @{$self->{c_template}}; 1592 1593 } 1594 1595 # end tags for empty elements can be ignored, their emptiness is 1596 # checked elsewhere 1597 1598 # literals 1599 } else { 1600 1601 push @{$self->{c_template}->[-1]->{instructions}}, [I_LITERAL_END, $el]; 1602 #print "COMP: >LITERAL_END /$el->{Name}\n"; 1603 } 1604 1605 my $e = pop @{$self->{e_stack}}; 1606 1607 # end of local variable visibility 1608 if ($self->{c_template}->[0]) { 1609 foreach (@{$e->{vars}}) { 1610 push @{$self->{c_template}->[-1]->{instructions}}, 1611 [I_VARIABLE_SCOPE_END, $_]; 1612 #print "COMP: >VARIABLE_SCOPE_END $_\n"; 1613 } 1614 } 1615 # end of local buffer visibility 1616 if ($self->{c_template}->[0]) { 1617 foreach (@{$e->{bufs}}) { 1618 push @{$self->{c_template}->[-1]->{instructions}}, 1619 [I_BUFFER_SCOPE_END, $_]; 1620 #print "COMP: >BUFFER_SCOPE_END $_\n"; 1621 } 1622 } 1623 1624 $self->{nsc}->popContext; 1625} 1626 1627sub characters { 1628 my $self = shift; 1629 my $char = shift; 1630 1631 # whitespace only 1632 if ($char->{Data} =~ /^\s*$/) { 1633 my $parent = $self->{e_stack}->[-1]; 1634 if ($parent->{NamespaceURI} eq STX_NS_URI 1635 and $parent->{LocalName} =~ /^(text|cdata)$/) { 1636 1637 if ($self->_allowed('_text')) { 1638 push @{$self->{c_template}->[-1]->{instructions}}, 1639 [I_CHARACTERS, $char->{Data}]; 1640 #print "COMP: >CHARACTERS - $char->{Data}\n"; 1641 } 1642 } 1643 1644 # not whitespace only 1645 } else { 1646 if ($self->_allowed('_text')) { 1647 push @{$self->{c_template}->[-1]->{instructions}}, 1648 [I_CHARACTERS, $char->{Data}]; 1649 #print "COMP: >CHARACTERS - $char->{Data}\n"; 1650 } 1651 } 1652} 1653 1654sub processing_instruction { 1655 my $self = shift; 1656 my $pi = shift; 1657} 1658 1659sub ignorable_whitespace { 1660} 1661 1662sub start_prefix_mapping { 1663 my ($self, $ns) = @_; 1664 1665 $self->{nsc}->declare_prefix($ns->{Prefix}, $ns->{NamespaceURI}); 1666} 1667 1668sub end_prefix_mapping { 1669 my ($self, $ns) = @_; 1670 1671 $self->{nsc}->undeclare_prefix($ns->{Prefix}); 1672} 1673 1674sub skipped_entity { 1675} 1676 1677# lexical ---------------------------------------- 1678 1679sub start_cdata { 1680 my $self = shift; 1681} 1682 1683sub end_cdata { 1684 my $self = shift; 1685} 1686 1687sub comment { 1688} 1689 1690sub start_dtd { 1691} 1692 1693sub end_dtd { 1694} 1695 1696sub start_entity { 1697} 1698 1699sub end_entity { 1700} 1701 1702# error ---------------------------------------- 1703 1704sub warning { 1705} 1706 1707sub error { 1708} 1709 1710sub fatal_error { 1711} 1712 1713# static evaluation ---------------------------------------- 1714 1715sub _static_eval { 1716 my ($self, $val) = @_; 1717 1718 my $spath = XML::STX::STXPath->new(); 1719 my $seq = $spath->expr(undef, $val); 1720 1721 return $seq; 1722} 1723 1724# tokenize ---------------------------------------- 1725 1726sub tokenize_match { 1727 my ($self, $pattern) = @_; 1728 my $tokens = []; 1729 1730 foreach my $path (split('\|',$pattern)) { 1731 1732 my $steps = []; 1733 1734 $path =~ s/^\/\///g; 1735 $path =~ s/^\//&R/g; 1736 $path =~ s/\/\//&&&A/g; 1737 $path =~ s/\//&&&P/g; 1738 $path = '&N' . $path unless substr($path,0,2) eq '&R'; 1739 1740 foreach (split('&&', $path)) { 1741 my $left = substr($_,1,1); 1742 my $step = $self->tokenize(substr($_,2)); 1743 push @$steps, { left => $left, step => $step}; 1744 } 1745 push @$tokens, $steps; 1746 } 1747 return $tokens; 1748} 1749 1750sub match_priority { 1751 my ($self, $pattern) = @_; 1752 my $priority = []; 1753 1754 foreach my $path (split('\|',$pattern)) { 1755 1756 my @steps = split('/|//',$path); 1757 my $last = $steps[-1]; 1758 my $p = 0.5; 1759 1760 if ($#steps == 0) { 1761 1762 if ($last =~ /^$QName$/) { 1763 $p = 0; 1764 1765 } elsif ($last =~ /^processing-instruction\(?:$LITERAL\)$/) { 1766 $p = 0; 1767 1768 } elsif ($last =~ /^cdata\(\)$/) { 1769 $p = 0; 1770 1771 } elsif ($last =~ /^(?:$NCWild)$/) { 1772 $p = -0.25; 1773 1774 } elsif ($last =~ /^(?:$QNWild)$/) { 1775 $p = -0.25; 1776 1777 } elsif ($last =~ /^$NODE_TYPE$/) { 1778 $p = -0.5; 1779 } 1780 } 1781 #print "TOK: last step: $last, more steps: $#steps, priority: $p\n"; 1782 push @$priority, $p; 1783 } 1784 return $priority; 1785} 1786 1787sub tokenize { 1788 my ($self, $path) = @_; 1789 study $path; 1790 1791 my @tokens = (); 1792 #print "TOK: tokenizing: $path\n"; 1793 1794 while($path =~ m/\G 1795 \s* # ignore all whitespace 1796 ( $LITERAL| # literal 1797 $DOUBLE_RE| # double numbers 1798 $NUMBER_RE| # digits 1799 \.\.| # parent 1800 \.| # current node 1801 $NODE_TYPE| # node type 1802 processing-instruction| # pi, to allow pi(target) 1803 \$$QName| # variable reference 1804 $QName\(| # function 1805 $NCWild|$QName|$QNWild| # QName 1806 \@($NCWild|$QName|$QNWild)| # attribute 1807 \!=|<=|\-|>=|\/\/|and|or|mod|div| # multi-char seps 1808 [,\+=\|<>\/\(\[\]\)]| # single char seps 1809 (?<!(\@|\(|\[))\*| # multiply operator rules 1810 $ # end of query 1811 ) 1812 \s* # ignore all whitespace 1813 /gcxso) { 1814 1815 my ($token) = ($1); 1816 1817 if (length($token)) { 1818 #print "TOK: token: $token\n"; 1819 1820 # resolving QNames #################### 1821 if ($token =~ /^$QName\($/o) { 1822 $token = $self->_expand_prefixedFce($token); 1823 1824 $token = substr($token, 0, length($token) - 1); 1825 push @tokens, $token, '('; 1826 1827 } elsif ($token =~ /^$NCName$/o 1828 && $token !~ /^(?:and|or|mod|div)$/) { 1829 1830 if ($self->{Sheet}->{Options}-> 1831 {'stxpath-default-namespace'}->[-1]) { 1832 $token = '{' . $self->{Sheet}->{Options}-> 1833 {'stxpath-default-namespace'}->[-1] 1834 . '}' . $token; 1835 } 1836 push @tokens, $token; 1837 1838 } elsif ($token =~ /^([\@\$])?($QName)$/o) { 1839 $token = $1 . $self->_expand_prefixedQN($2); 1840 push @tokens, $token; 1841 1842 } elsif ($token =~ /^(\@)?($NCName):\*$/o) { 1843 $token = $1 . $self->_expand_prefixedQN("$2:lname"); 1844 $token =~ s/lname$/*/; 1845 push @tokens, $token; 1846 1847 } elsif ($token =~ /^(\@)?\*:($NCName|\*)$/o) { 1848 $token = $1 . "{*}$2"; 1849 push @tokens, $token; 1850 1851 } else { 1852 push @tokens, $token; 1853 } 1854 #print "TOK: exp. token: $token\n"; 1855 } 1856 } 1857 1858 if (pos($path) < length($path)) { 1859 my $marker = ("." x (pos($path)-1)); 1860 $path = substr($path, 0, pos($path) + 8) . "..."; 1861 $path =~ s/\n/ /g; 1862 $path =~ s/\t/ /g; 1863 $self->doError(1, 3, $path, $marker); 1864 } 1865 1866 return \@tokens; 1867} 1868 1869# structure ---------------------------------------- 1870 1871my $s_group = ['variable','buffer','template','procedure','include','group']; 1872 1873my $s_top_level = [@$s_group, 'param', 'namespace-alias']; 1874 1875my $s_text_constr = ['text','cdata','value-of','if','else','choose','_text']; 1876 1877my $s_content_constr = [@$s_text_constr ,'call-procedure', 'copy', 1878 'process-attributes', 'process-self', 'element', 1879 'start-element', 'end-element', 'comment', 1880 'processing-instruction', 'variable', 'param', 1881 'assign', 'buffer', 'result-buffer', 'process-buffer', 1882 'result-document', 'process-document', 'for-each-item', 1883 'while', '_literal', 'attribute']; 1884 1885my $s_template = [@$s_content_constr, 'process-children', 'process-siblings']; 1886 1887my $sch = { 1888 transform => $s_top_level, 1889 group => $s_group, 1890 template => $s_template, 1891 procedure => $s_template, 1892 'process-children' => ['with-param'], 1893 'process-attributes' => ['with-param'], 1894 'process-self' => ['with-param'], 1895 'process-siblings' => ['with-param'], 1896 'process-document' => ['with-param'], 1897 'process-buffer' => ['with-param'], 1898 'call-procedure' => ['with-param'], 1899 'with-param' => $s_text_constr, 1900 param => $s_text_constr, 1901 copy => $s_template, 1902 element => $s_template, 1903 attribute => $s_text_constr, 1904 'processing-instruction' => $s_text_constr, 1905 comment => $s_text_constr, 1906 'if' => $s_template, 1907 'else' => $s_template, 1908 choose => ['when','otherwise'], 1909 when => $s_template, 1910 otherwise => $s_template, 1911 'for-each-item' => $s_template, 1912 while => $s_template, 1913 variable => $s_text_constr, 1914 assign => $s_text_constr, 1915 text => ['_text'], 1916 cdata => ['_text'], 1917 buffer => $s_template, 1918 'result-buffer' => $s_template, 1919 'result-document' => $s_template, 1920 _literal => $s_template, 1921 }; 1922 1923sub _allowed { 1924 my ($self, $lname) = @_; 1925 1926 if ($#{$self->{e_stack}} == -1) { 1927 1928 $self->doError(202, 3, $lname) 1929 unless $lname eq 'transform'; 1930 1931 } else { 1932 my $parent = $self->{e_stack}->[-1]; 1933 1934 my $s_key = (defined $parent->{NamespaceURI} 1935 and $parent->{NamespaceURI} eq STX_NS_URI) 1936 ? $parent->{LocalName} : '_literal'; 1937 1938 $self->doError(215, 3, $lname, $parent->{Name}) 1939 unless grep($_ eq $lname ,@{$sch->{$s_key}}); 1940 } 1941 return 1; 1942} 1943 1944# utils ---------------------------------------- 1945 1946sub _avt { 1947 my ($self, $val) = @_; 1948 1949 if ($val =~ /^\{([^\}\{]*)\}$/) { 1950 return $self->tokenize($1); 1951 1952 } elsif ($val =~ /^.*\{([^\}\{]*)\}.*$/) { 1953 $val =~ s/^(.*)$/concat('$1')/; 1954 $val =~ s/\{/',/g; 1955 $val =~ s/\}/,'/g; 1956 $val =~ s/'',|,''//g; 1957 return $self->tokenize($val); 1958 1959 } else { 1960 return $val; 1961 } 1962} 1963 1964sub _sort_templates { 1965 my ($self, $t) = @_; 1966 my $sorted = 1; 1967 1968 while ($sorted) { 1969 $sorted = 0; 1970 for (my $i=0; $i < $#$t; $i++) { 1971 if ($t->[$i+1]->{eff_p} > $t->[$i]->{eff_p}) { 1972 my $tmp = $t->[$i]; 1973 $t->[$i] = $t->[$i+1]; 1974 $t->[$i+1] = $tmp; 1975 $sorted = 1; 1976 } 1977 } 1978 } 1979} 1980 1981sub _expand_qname { 1982 my ($self, $qname) = @_; 1983 1984 my @n = $self->{nsc}->process_element_name($qname); 1985 return $n[0] ? "{$n[0]}$n[2]" : $qname; 1986} 1987 1988# default NS is ignored 1989sub _expand_prefixedQN { 1990 my ($self, $qname) = @_; 1991 1992 my @n = $self->{nsc}->process_attribute_name($qname); 1993 return $n[0] ? "{$n[0]}$n[2]" : $qname; 1994} 1995 1996# default function NS is used 1997sub _expand_prefixedFce { 1998 my ($self, $qname) = @_; 1999 2000 my @n = $self->{nsc}->process_attribute_name($qname); 2001 return $n[0] ? "{$n[0]}$n[2]" : '{' . STX_FNS_URI . "}$n[2]"; 2002} 2003 2004sub _process_templates { 2005 my ($self, $g) = @_; 2006 2007 foreach my $t (keys %{$g->{templates}}) { 2008 2009 # namespace-alias 2010 foreach my $i (@{$g->{templates}->{$t}->{instructions}}) { 2011 if ($i->[0] == I_LITERAL_START or $i->[0] == I_LITERAL_END) { 2012 2013 foreach (@{$self->{Sheet}->{alias}}) { 2014 if ($i->[1]->{NamespaceURI} eq $_->[0]->[0]) { 2015 $i->[1]->{NamespaceURI} = $_->[1]->[0]; 2016 $i->[1]->{Prefix} = $_->[1]->[1]; 2017 $i->[1]->{Name} = $i->[1]->{Prefix} 2018 ? "$i->[1]->{Prefix}:$i->[1]->{LocalName}" 2019 : $i->[1]->{LocalName}; 2020 last; 2021 } 2022 } 2023 2024 if (exists $i->[1]->{Attributes}) { 2025 foreach my $ns (keys %{$i->[1]->{Attributes}}) { 2026 2027 foreach (@{$self->{Sheet}->{alias}}) { 2028 if ($i->[1]->{Attributes}->{$ns}->{NamespaceURI} 2029 eq $_->[0]->[0]) { 2030 my $key = "{$_->[1]->[0]}" 2031 . $i->[1]->{Attributes}->{$ns}->{LocalName}; 2032 2033 $i->[1]->{Attributes}->{$key} 2034 = $i->[1]->{Attributes}->{$ns}; 2035 delete $i->[1]->{Attributes}->{$ns}; 2036 2037 $i->[1]->{Attributes}->{$key}->{NamespaceURI} 2038 = $_->[1]->[0]; 2039 $i->[1]->{Attributes}->{$key}->{Prefix} 2040 = $_->[1]->[1]; 2041 $i->[1]->{Attributes}->{$key}->{Name} 2042 = $i->[1]->{Attributes}->{$key}->{Prefix} 2043 ? "$i->[1]->{Attributes}->{$key}->{Prefix}:" 2044 . $i->[1]->{Attributes}->{$key}->{LocalName} 2045 : $i->[1]->{Attributes}->{$key}->{LocalName}; 2046 last; 2047 } 2048 } 2049 } 2050 } 2051 } 2052 } 2053 } 2054 2055 foreach (keys %{$g->{groups}}) { 2056 $self->_process_templates($g->{groups}->{$_}) 2057 } 2058} 2059 2060# debug ---------------------------------------- 2061 2062sub _dump_g_stack { 2063 my $self = shift; 2064 2065 print "G-stack:", 2066 join('|',map("$_->{gid}",@{$self->{g_stack}})), "\n"; 2067} 2068 20691; 2070__END__ 2071 2072=head1 NAME 2073 2074XML::STX::Parser - XML::STX stylesheet parser 2075 2076=head1 SYNOPSIS 2077 2078no public API, used from XML::STX 2079 2080=head1 AUTHOR 2081 2082Petr Cimprich (Ginger Alliance), petr@gingerall.cz 2083 2084=head1 SEE ALSO 2085 2086XML::STX, perl(1). 2087 2088no public API 2089 2090 2091=cut 2092