| ############################################################################## |
| # the processor # |
| ############################################################################## |
| |
| # This code is a mess and has numerous subtle bugs in its namespace |
| # handling. Do not expect it to pass any tests of its own. |
| |
| package utils::parser; |
| use utils::helpers; |
| use strict; |
| |
| my $NAMESPACE = 'http://www.example.org/css3tests'; |
| my %months = ( |
| 'january' => 1, |
| 'february' => 2, |
| 'march' => 3, |
| 'april' => 4, |
| 'may' => 5, |
| 'june' => 6, |
| 'july' => 7, |
| 'august' => 8, |
| 'september' => 9, |
| 'october' => 10, |
| 'november' => 11, |
| 'december' => 12, |
| ); |
| |
| sub Init { |
| my $parser = shift; |
| $parser->{'Walker Data'} = {}; |
| } |
| |
| # This is the big workhorse -- it gets called for each start tag. |
| sub Start { |
| my $parser = shift; |
| my($tagName, @attrs) = @_; |
| my @context = $parser->context; |
| my($qualifiedTagName, @qualifiedAttrs) = &utils::helpers::qualifyStartTag($parser, $tagName, @attrs); |
| my %qualifiedAttrs = (@qualifiedAttrs); |
| |
| # The root element |
| if ((scalar(@context) == 0) and ($qualifiedTagName eq "{$NAMESPACE}csstest")) { |
| foreach my $name (qw(def module modulename number rev)) { |
| if (defined($qualifiedAttrs{$name})) { |
| $parser->{'Walker Data'}->{$name} = $qualifiedAttrs{$name}; |
| } |
| } |
| if (defined($qualifiedAttrs{date})) { |
| my $date = $qualifiedAttrs{date}; |
| $date =~ s/(.+)-(.+)-(.+)/sprintf('%02d-%02d-%02d', $3, $months{$2}, $1)/gose; |
| $parser->{'Walker Data'}->{date} = $date; |
| } |
| } elsif (&utils::helpers::matchContext($parser, [[$NAMESPACE, 'csstest']]) and |
| ($qualifiedTagName eq "{$NAMESPACE}author")) { |
| if (defined($parser->{'Walker Data'}->{'author'})) { |
| push(@{$parser->{'Walker Data'}->{'author'}}, ''); |
| } else { |
| $parser->{'Walker Data'}->{'author'} = ['']; |
| } |
| } elsif (&utils::helpers::matchContext($parser, [[$NAMESPACE, 'csstest']]) and |
| ($qualifiedTagName eq "{$NAMESPACE}cssrules")) { |
| # ok |
| } elsif (&utils::helpers::matchContext($parser, [[$NAMESPACE, 'csstest']]) and |
| ($qualifiedTagName eq "{$NAMESPACE}userinteraction")) { |
| $parser->{'Walker Data'}->{'interactive'} = 1; |
| } elsif (&utils::helpers::matchContext($parser, [[$NAMESPACE, 'csstest']]) and |
| ($qualifiedTagName eq "{$NAMESPACE}dynamic")) { |
| $parser->{'Walker Data'}->{'dynamic'} = 1; |
| } elsif (&utils::helpers::matchContext($parser, [[$NAMESPACE, 'csstest']]) and |
| ($qualifiedTagName eq "{$NAMESPACE}historyneeded")) { |
| $parser->{'Walker Data'}->{'historyneeded'} = 1; |
| } elsif (&utils::helpers::matchContext($parser, [[$NAMESPACE, 'csstest']]) and |
| ($qualifiedTagName eq "{$NAMESPACE}code") and |
| (not defined($parser->{'Walker Data'}->{'prefixes'}))) { |
| # here we must begin to take stuff into account |
| $parser->{'Walker Data'}->{'code-xml'} = ''; |
| $parser->{'Walker Data'}->{'code-xhtml'} = ''; |
| $parser->{'Walker Data'}->{'code-html'} = ''; |
| # first, all the namespace prefixes in scope |
| $parser->{'Walker Data'}->{'prefixes'} = {}; |
| $parser->{'Walker Data'}->{'prefixesUsed'} = {}; |
| foreach my $prefix ($parser->current_ns_prefixes) { |
| if ($prefix ne '#default') { |
| $parser->{'Walker Data'}->{'prefixes'}->{$prefix} = $parser->expand_ns_prefix($prefix); |
| $parser->{'Walker Data'}->{'prefixesUsed'}->{$prefix} = 0; |
| } |
| } |
| } elsif (&utils::helpers::matchContext($parser, [[$NAMESPACE, 'csstest'], |
| [$NAMESPACE, 'code']])) { # child of code element |
| $parser->xpcroak('restrict cannot be a child of code') if $qualifiedTagName eq "{$NAMESPACE}restrict"; |
| &processElement($parser, $tagName, 1, @attrs); |
| } elsif (&utils::helpers::matchContext($parser, [[$NAMESPACE, 'csstest'], |
| [$NAMESPACE, 'code']], 1) and |
| ($qualifiedTagName eq "{$NAMESPACE}restrict")) { # <restrict>, descendant of code element (must not be child) |
| if (defined($parser->{'Walker Data'}->{'restrict'})) { |
| $parser->xpcroak('<restrict> may not be nested'); |
| } |
| if (defined($qualifiedAttrs{'for'})) { |
| $parser->{'Walker Data'}->{'restrict'} = $qualifiedAttrs{'for'}; |
| } else { |
| $parser->xpcroak('required attribute \'for\' missing'); |
| } |
| } elsif (&utils::helpers::matchContext($parser, [[$NAMESPACE, 'csstest'], |
| [$NAMESPACE, 'code']], 1)) { # descendant of code element |
| &processElement($parser, $tagName, 0, @attrs); |
| } else { |
| $parser->xpcroak("unexpected element $tagName in namespace ".$parser->namespace($tagName)); |
| } |
| } |
| |
| sub CdataStart { |
| my $parser = shift; |
| if (&utils::helpers::matchContext($parser, [ |
| [$NAMESPACE, 'csstest'], [$NAMESPACE, 'code']], 1)) { |
| $parser->{'Walker Data'}->{'code-xml'} .= '<![CDATA[' if applicable($parser, 'xml'); |
| $parser->{'Walker Data'}->{'code-xhtml'} .= '<![CDATA[' if applicable($parser, 'xhtml'); |
| # $parser->{'Walker Data'}->{'code-html'} .= '' if applicable($parser, 'html'); # HTML has no CDATA blocks |
| $parser->{'Walker Data'}->{'cdata'} = 1; |
| } else { |
| # not technically invalid... |
| } |
| } |
| |
| sub CdataEnd { |
| my $parser = shift; |
| if (&utils::helpers::matchContext($parser, [ |
| [$NAMESPACE, 'csstest'], [$NAMESPACE, 'code']], 1)) { |
| $parser->{'Walker Data'}->{'code-xml'} .= ']]>' if applicable($parser, 'xml'); |
| $parser->{'Walker Data'}->{'code-xhtml'} .= ']]>' if applicable($parser, 'xhtml'); |
| # $parser->{'Walker Data'}->{'code-html'} .= '' if applicable($parser, 'html'); # HTML has no CDATA blocks |
| $parser->{'Walker Data'}->{'cdata'} = 0; |
| } else { |
| # not technically invalid... |
| } |
| } |
| |
| sub Comment { |
| my $parser = shift; |
| my($comment) = @_; |
| if (&utils::helpers::matchContext($parser, [ |
| [$NAMESPACE, 'csstest'], [$NAMESPACE, 'code']], 1)) { |
| $parser->{'Walker Data'}->{'code-xml'} .= "<!--$comment-->" if applicable($parser, 'xml'); |
| $parser->{'Walker Data'}->{'code-xhtml'} .= "<!--$comment-->" if applicable($parser, 'xhtml'); |
| $parser->{'Walker Data'}->{'code-html'} .= "<!--$comment-->" if applicable($parser, 'html'); |
| } else { |
| # not technically invalid... |
| } |
| } |
| |
| sub Proc { |
| my $parser = shift; |
| my($target, $data) = @_; |
| if (&utils::helpers::matchContext($parser, [ |
| [$NAMESPACE, 'csstest'], [$NAMESPACE, 'code']], 1)) { |
| $parser->{'Walker Data'}->{'code-xml'} .= "<?$target $data?>" if applicable($parser, 'xml'); |
| $parser->{'Walker Data'}->{'code-xhtml'} .= "<?$target $data?>" if applicable($parser, 'xhtml'); |
| $parser->{'Walker Data'}->{'code-html'} .= "<?$target $data>" if applicable($parser, 'html'); |
| } else { |
| # not technically invalid... |
| } |
| } |
| |
| # This is called for each line of a string of text (as well as the contents of any CDATA blocks, etc) |
| sub Char { |
| my $parser = shift; |
| my($text) = @_; |
| if (&utils::helpers::matchContext($parser, [ |
| [$NAMESPACE, 'csstest'], [$NAMESPACE, 'author']])) { |
| $parser->{'Walker Data'}->{'author'}->[$#{$parser->{'Walker Data'}->{'author'}}] .= $text; |
| } elsif (&utils::helpers::matchContext($parser, [ |
| [$NAMESPACE, 'csstest'], [$NAMESPACE, 'cssrules']])) { |
| $parser->{'Walker Data'}->{'cssrules'} .= $text; |
| } elsif (&utils::helpers::matchContext($parser, [ |
| [$NAMESPACE, 'csstest']]) and ($text =~ /^\s+$/os)) { |
| # ok |
| } elsif (&utils::helpers::matchContext($parser, [ |
| [$NAMESPACE, 'csstest'], [$NAMESPACE, 'code']], 1)) { |
| if (not $parser->{'Walker Data'}->{'cdata'}) { |
| $text = &utils::helpers::escape($text); |
| } |
| $parser->{'Walker Data'}->{'code-xml'} .= $text if applicable($parser, 'xml'); |
| $parser->{'Walker Data'}->{'code-xhtml'} .= $text if applicable($parser, 'xhtml'); |
| $parser->{'Walker Data'}->{'code-html'} .= $text if applicable($parser, 'html'); |
| } else { |
| $parser->xpcroak("found unexpected text"); |
| } |
| } |
| |
| sub End { |
| my $parser = shift; |
| my($tagName) = @_; |
| if (&utils::helpers::matchContext($parser, [[$NAMESPACE, 'csstest'], |
| [$NAMESPACE, 'code']], 1) and |
| (($tagName eq 'restrict') and ($parser->namespace($tagName) eq $NAMESPACE))) { # <restrict>, descendant of code element |
| delete($parser->{'Walker Data'}->{'restrict'}); |
| } elsif (&utils::helpers::matchContext($parser, [[$NAMESPACE, 'csstest'], |
| [$NAMESPACE, 'code']], 1)) { |
| if ($parser->recognized_string ne '') { |
| $parser->{'Walker Data'}->{'endTag'} = $parser->recognized_string; |
| } else { |
| # This was an empty tag with the short form <foo/>. This |
| # guarentees that the element can have no children, so we |
| # don't need to ensure the endTag bit is propagated |
| # correctly across children. |
| } |
| # XML output |
| $parser->{'Walker Data'}->{'code-xml'} .= $parser->{'Walker Data'}->{'endTag'} if applicable($parser, 'xml'); |
| # XHTML output |
| $parser->{'Walker Data'}->{'code-xhtml'} .= $parser->{'Walker Data'}->{'endTag'} if applicable($parser, 'xhtml'); |
| # HTML output |
| if (($parser->{'Walker Data'}->{'endTag'} ne '</input>') and |
| ($parser->{'Walker Data'}->{'endTag'} ne '</br>')) { |
| $parser->{'Walker Data'}->{'code-html'} .= $parser->{'Walker Data'}->{'endTag'} if applicable($parser, 'html'); |
| } # else HTML doesn't allow end tags for those |
| } else { |
| # ok |
| } |
| } |
| |
| sub Final { |
| my $parser = shift; |
| my $data = $parser->{'Walker Data'}; |
| $data->{'escapedcode-xml'} = &utils::helpers::escape($data->{'code-xml'}); |
| $data->{'escapedcode-xhtml'} = &utils::helpers::escape($data->{'code-xhtml'}); |
| $data->{'escapedcode-html'} = &utils::helpers::escape($data->{'code-html'}); |
| $data->{'escapedcode-css'} = &utils::helpers::escape($data->{'cssrules'}); |
| $data->{'namespaces'} = ''; |
| foreach my $prefix (keys %{$data->{'prefixes'}}) { |
| if ($data->{'prefixesUsed'}->{$prefix}) { |
| $data->{'namespaces'} .= " xmlns:${prefix}=\"$data->{'prefixes'}->{$prefix}\""; |
| } |
| } |
| delete($parser->{'Walker Data'}); |
| return $data; |
| } |
| |
| sub processElement { |
| my $parser = shift; |
| my($tagName, $child, @attrs) = @_; |
| # $child is true if the element should declare its own default namespace if needed |
| # (i.e. if element is a direct child of the <code> element) |
| my @prefixes = $parser->current_ns_prefixes; |
| # get the element stuff |
| my $prefix = ''; |
| if ($parser->recognized_string =~ m/<([^\s:]+):/o) { |
| $prefix = $1; |
| } |
| $parser->{'Walker Data'}->{'prefixesUsed'}->{$prefix} += 1 if exists $parser->{'Walker Data'}->{'prefixesUsed'}->{$prefix}; |
| my $default = $parser->expand_ns_prefix('#default'); |
| my $defaultXML = ''; |
| my $defaultXHTML = ''; |
| if ($child) { |
| if (defined($default)) { |
| if ($default ne 'http://www.w3.org/1999/xhtml') { |
| $defaultXHTML = ' xmlns="'.&utils::helpers::escape($default).'"'; |
| } |
| $defaultXML = ' xmlns="'.&utils::helpers::escape($default).'"'; |
| } else { |
| $defaultXHTML = ' xmlns=""'; |
| } |
| } # else handled as part of the new_ns_prefix fixup |
| my $newNamespaces = ''; |
| my $newNamespacePrefixes = {}; |
| foreach my $newPrefix ($parser->new_ns_prefixes) { |
| my $namespace = $parser->expand_ns_prefix($newPrefix); |
| if (not defined($namespace)) { |
| $namespace = ''; |
| } |
| if ($newPrefix ne '#default') { |
| $newNamespaces .= " xmlns:$newPrefix=\"".&utils::helpers::escape($namespace).'"'; |
| $newNamespacePrefixes->{$newPrefix} = $namespace; |
| } elsif (not $child) { |
| $newNamespaces .= ' xmlns="'.&utils::helpers::escape($namespace).'"'; |
| } |
| } |
| my %prefixLookup = map { if ($_ ne '#default') { $parser->expand_ns_prefix($_) => $_ } else { (); } } @prefixes; |
| my $attributes = ''; |
| my $isName = 1; |
| foreach my $attribute (@attrs) { |
| if ($isName) { |
| # we currently lose the actual prefix used and look it back up... this can be wrong if |
| # there are multiple prefixes defined for the same namespace. |
| my $attrNamespace; |
| if ($attribute =~ s/^\|//o) { |
| # this handles a bug in XML::Parser::Expat with attributes of the form: |
| # <element xmlns="" xmlns:none="" none:this="will be called '|this' and not 'this' in $attribute" /> |
| # XXX actually the bug is that that doesn't throw a well-formedness exception XXX |
| $attrNamespace = ''; |
| } else { |
| $attrNamespace = $parser->namespace($attribute); |
| } |
| my $attrPrefix; |
| if (defined($attrNamespace)) { |
| $parser->{'Walker Data'}->{'namespaced'} = 1; |
| $parser->{'Walker Data'}->{'only-xml'} = 1 if applicable($parser, 'html'); |
| if ($attrNamespace eq 'http://www.w3.org/XML/1998/namespace') { |
| $attrPrefix = 'xml'; |
| } else { |
| $attrPrefix = $prefixLookup{$attrNamespace}; |
| $parser->{'Walker Data'}->{'prefixesUsed'}->{$attrPrefix} += 1 if exists $parser->{'Walker Data'}->{'prefixesUsed'}->{$attrPrefix}; |
| } |
| $attrPrefix .= ':'; |
| } else { |
| $attrPrefix = ''; |
| } |
| $attributes .= " $attrPrefix$attribute=\""; |
| } else { |
| $attributes .= &utils::helpers::escape($attribute).'"'; |
| } |
| $isName = not($isName); |
| } |
| $prefix .= ':' if $prefix ne ''; |
| # XML output: |
| $parser->{'Walker Data'}->{'code-xml'} .= "<$prefix$tagName$defaultXML$newNamespaces$attributes>" if applicable($parser, 'xml'); |
| # XHTML output |
| $parser->{'Walker Data'}->{'code-xhtml'} .= "<$prefix$tagName$defaultXHTML$newNamespaces$attributes>" if applicable($parser, 'xhtml'); |
| # HTML output is same as XHTML output except for namespaces - flag if there are any |
| $parser->{'Walker Data'}->{'code-html'} .= "<$tagName$attributes>" if applicable($parser, 'html'); |
| |
| if ($prefix ne '' or $defaultXHTML ne '' or $newNamespaces ne '') { |
| $parser->{'Walker Data'}->{'namespaced'} = 1; |
| $parser->{'Walker Data'}->{'only-xml'} = 1 if applicable($parser, 'html'); |
| } |
| $parser->{'Walker Data'}->{'endTag'} = "</$prefix$tagName>"; # used to regenerate the end tag if required (i.e. if this was originally an empty start tag) |
| } |
| |
| sub applicable { |
| my($parser, $for) = @_; |
| return ((not defined($parser->{'Walker Data'}->{'restrict'})) or |
| ($parser->{'Walker Data'}->{'restrict'} =~ m/\b # word boundary |
| \Q$for\E # quote $for string (so that $for is not treated as regexp) |
| \b # word boundary |
| /x)); |
| } |
