XML-STX
view release on metacpan or search on metacpan
STX/Parser.pm view on Meta::CPAN
if ($self->_allowed($el->{LocalName})) {
# included module
if ($self->{include}) {
#print "COMP: >include\n";
$el->{LocalName} = 'transform';
my $g = XML::STX::Group->new($self->{Sheet}->{next_gid},
$g_stack_top);
#print "COMP: >new group $self->{Sheet}->{next_gid} $g\n";
# the group is linked from the previous group
$g_stack_top->{groups}->{$self->{Sheet}->{next_gid}} = $g;
push @{$self->{g_stack}}, $g;
$self->{Sheet}->{next_gid}++;
# principal module
} else {
$self->{Sheet} = XML::STX::Stylesheet->new();
push @{$self->{g_stack}}, $self->{Sheet}->{dGroup};
#print "COMP: >new stylesheet $self->{Sheet}\n";
#print "COMP: >default group $self->{Sheet}->{dGroup}->{gid}\n";
$self->doError(212, 3, '<stx:transform>', 'version')
unless exists $el->{Attributes}->{'{}version'};
$self->doError(214, 3, 'version', '<stx:transform>', '1.0')
unless $el->{Attributes}->{'{}version'}->{Value} eq STX_VERSION;
}
# options: stxpath-default-namespace
if (exists $a->{'{}stxpath-default-namespace'}) {
if ($a->{'{}stxpath-default-namespace'}->{Value}
=~ /^$ATT_URIREF$/) {
push @{$self->{Sheet}->{Options}->
{'stxpath-default-namespace'}},
$a->{'{}stxpath-default-namespace'}->{Value};
} else {
$self->doError(217, 3, 'stxpath-default-namespace',
$a->{'{}stxpath-default-namespace'}->{Value},
'uri-reference', );
}
}
# options: output-encoding
unless ($self->{include}) {
if (exists $a->{'{}output-encoding'}) {
if ($a->{'{}output-encoding'}->{Value}
=~ /^$ATT_STRING$/) {
$self->{Sheet}->{Options}->{'output-encoding'}
= $a->{'{}output-encoding'}->{Value};
} else {
$self->doError(217, 3, 'output-encoding',
$a->{'{}output-encoding'}->{Value},
'string');
}
}
}
# options: recognize-cdata
if (exists $a->{'{}recognize-cdata'}) {
if ($a->{'{}recognize-cdata'}->{Value} eq 'no') {
$self->{g_stack}->[-1]->{Options}->{'recognize-cdata'} = 0
} elsif ($a->{'{}recognize-cdata'}->{Value} ne 'yes') {
$self->doError(205, 3, 'recognize-data',
$a->{'{}recognize-cdata'}->{Value});
}
}
# options: pass-through
if (exists $a->{'{}pass-through'}) {
if ($a->{'{}pass-through'}->{Value} eq 'all') {
$self->{g_stack}->[-1]->{Options}->{'pass-through'} = 1
} elsif ($a->{'{}pass-through'}->{Value} eq 'text') {
$self->{g_stack}->[-1]->{Options}->{'pass-through'} = 2
} elsif ($a->{'{}pass-through'}->{Value} ne 'none') {
$self->doError(206, 3,
$a->{'{}pass-through'}->{Value});
}
}
# options: strip-space
if (exists $a->{'{}strip-space'}) {
if ($a->{'{}strip-space'}->{Value} eq 'yes') {
$self->{g_stack}->[-1]->{Options}->{'strip-space'} = 1
} elsif ($a->{'{}strip-space'}->{Value} ne 'no') {
$self->doError(205, 3, 'strip-space',
$a->{'{}strip-space'}->{Value});
}
}
}
# <stx:include> ----------------------------------------
} elsif ($el->{LocalName} eq 'include') {
if ($self->_allowed($el->{LocalName})) {
$self->doError(212, 3, '<stx:include>', 'href')
unless exists $a->{'{}href'};
$self->doError(214,3,'href','<stx:include>', 'URI reference')
unless $a->{'{}href'}->{Value} =~ /^$ATT_URIREF$/;
my $source = $self->{URIResolver}->resolve($a->{'{}href'}->{Value},
$self->{URI});
# nested compiler inherits properties from the current one
my $iP = XML::STX::Parser->new({include => 1});
$iP->{Sheet} = $self->{Sheet};
$iP->{e_stack} = $self->{e_stack};
$iP->{g_stack} = $self->{g_stack};
$iP->{nsc} = $self->{nsc};
$iP->{DBG} = $self->{DBG};
$iP->{URIResolver} = $self->{URIResolver};
$iP->{ErrorListener} = $self->{ErrorListener};
$iP->{URI} = $self->{URI};
$source->{XMLReader}->{Handler} = $iP;
$source->{XMLReader}->parse_uri($source->{SystemId});
}
# <stx:namespace-alias> ----------------------------------------
} elsif ($el->{LocalName} eq 'namespace-alias') {
STX/Parser.pm view on Meta::CPAN
$self->doError(221, 3, $a->{'{}stylesheet-prefix'}->{Value},
'stx:namespace-alias') unless $ns1;
# --- result-prefix ---
$self->doError(212, 3, '<stx:namespace-alias>', 'result-prefix')
unless exists $a->{'{}result-prefix'};
$self->doError(214, 3, 'result-prefix',
'<stx:namespace-alias>', 'NCName')
unless $a->{'{}result-prefix'}->{Value} =~ /^$ATT_NCNAME$/
or $a->{'{}result-prefix'}->{Value} eq '#default';
my $pre2 = $a->{'{}result-prefix'}->{Value} eq '#default'
? '' : $a->{'{}result-prefix'}->{Value};
my $ns2 = $self->{nsc}->get_uri($pre2);
#print "COMP: ns-alias> $pre2:$ns2\n";
$self->doError(221, 3, $a->{'{}result-prefix'}->{Value},
'stx:namespace-alias') unless $ns2;
unshift @{$self->{Sheet}->{alias}}, [[$ns1, $pre1], [$ns2, $pre2]];
}
# <stx:group> ----------------------------------------
} elsif ($el->{LocalName} eq 'group') {
if ($self->_allowed($el->{LocalName})) {
my $g = XML::STX::Group->new($self->{Sheet}->{next_gid},
$g_stack_top);
#print "COMP: >new group $self->{Sheet}->{next_gid} $g\n";
# the group is linked from the previous group
$g_stack_top->{groups}->{$self->{Sheet}->{next_gid}} = $g;
# the group inherits pc2 templates from all ancestors
foreach (@{$self->{g_stack}}) {
push @{$g->{pc2}}, @{$_->{vGroup}};
push @{$g->{pc2A}}, @{$_->{vGroupA}};
foreach my $p (@{$_->{vGroupP}}) {
$self->doError(220, 3, $p->{name}, 2)
if $g->{pc2P}->{$p->{name}};
$g->{pc2P}->{$p->{name}} = $p;
}
}
if (exists $a->{'{}name'}) {
$self->doError(214,3,'name','<stx:group>', 'qname')
unless $a->{'{}name'}->{Value} =~ /^$ATT_QNAME$/;
$g->{name} = $a->{'{}name'}->{Value};
$g->{name} = $self->_expand_qname($g->{name});
$self->doError(219, 3, 'group', $g->{name})
if exists $self->{Sheet}->{named_groups}->{$g->{name}};
$self->{Sheet}->{named_groups}->{$g->{name}} = $g;
}
# options: recognize-cdata
if (exists $a->{'{}recognize-cdata'}) {
if ($a->{'{}recognize-cdata'}->{Value} eq 'no') {
$g->{Options}->{'recognize-cdata'} = 0
} elsif ($a->{'{}recognize-cdata'}->{Value} eq 'yes') {
$g->{Options}->{'recognize-cdata'} = 1
} elsif ($a->{'{}recognize-cdata'}->{Value} eq 'inherit') {
$g->{Options}->{'recognize-cdata'}
= $g->{group}->{Options}->{'recognize-cdata'}
} else {
$self->doError(205, 3, 'recognize-data',
$a->{'{}recognize-cdata'}->{Value});
}
} else {
$g->{Options}->{'recognize-cdata'}
= $g->{group}->{Options}->{'recognize-cdata'}
}
# options: pass-through
if (exists $a->{'{}pass-through'}) {
if ($a->{'{}pass-through'}->{Value} eq 'all') {
$g->{Options}->{'pass-through'} = 1
} elsif ($a->{'{}pass-through'}->{Value} eq 'text') {
$g->{Options}->{'pass-through'} = 2
} elsif ($a->{'{}pass-through'}->{Value} eq 'none') {
$g->{Options}->{'pass-through'} = 0
} elsif ($a->{'{}pass-through'}->{Value} eq 'inherit') {
$g->{Options}->{'pass-through'}
= $g->{group}->{Options}->{'pass-through'}
} else {
$self->doError(206, 3,
$a->{'{}pass-through'}->{Value});
}
} else {
$g->{Options}->{'pass-through'}
= $g->{group}->{Options}->{'pass-through'}
}
# options: strip-space
if (exists $a->{'{}strip-space'}) {
if ($a->{'{}strip-space'}->{Value} eq 'yes') {
$g->{Options}->{'strip-space'} = 1
} elsif ($a->{'{}strip-space'}->{Value} eq 'no') {
$g->{Options}->{'strip-space'} = 0
} elsif ($a->{'{}strip-space'}->{Value} eq 'inherit') {
$g->{Options}->{'strip-space'}
= $g->{group}->{Options}->{'strip-space'}
} else {
$self->doError(205, 3, 'strip-space',
$a->{'{}strip-space'}->{Value});
}
} else {
$g->{Options}->{'strip-space'}
= $g->{group}->{Options}->{'strip-space'}
}
push @{$self->{g_stack}}, $g;
$self->{Sheet}->{next_gid}++;
}
# <stx:template> ----------------------------------------
} elsif ($el->{LocalName} eq'template') {
if ($self->_allowed($el->{LocalName})) {
my $t = XML::STX::Template->new($self->{Sheet}->{next_tid},
$g_stack_top);
# --- match ---
STX/Parser.pm view on Meta::CPAN
}
# <stx:end-element> ----------------------------------------
} elsif ($el->{LocalName} eq'end-element') {
if ($self->_allowed($el->{LocalName})) {
$self->doError(212, 3, '<stx:end-element>', 'name')
unless exists $el->{Attributes}->{'{}name'};
my $qn = $self->_avt($a->{'{}name'}->{Value});
my $ns = exists $a->{'{}namespace'}
? $self->_avt($a->{'{}namespace'}->{Value}) : undef;
push @{$self->{c_template}->[-1]->{instructions}},
[I_ELEMENT_END, $qn, $ns, clone($self->{nsc})];
#print "COMP: >ELEMENT_END\n";
}
# <stx:attribute> ----------------------------------------
} elsif ($el->{LocalName} eq'attribute') {
if ($self->_allowed($el->{LocalName})) {
my $ok;
my $insts = $self->{c_template}->[-1]->{instructions};
for (my $i = 0; $i < @$insts; $i++) {
last if $insts->[$#$insts - $i]->[0] == I_ATTRIBUTE_END
or $insts->[$#$insts - $i]->[0] == I_ELEMENT_START
or $insts->[$#$insts - $i]->[0] == I_LITERAL_START
or $insts->[$#$insts - $i]->[0] == I_COPY_START;
# these instructions don't output anything
$self->doError(207, 3, $insts->[$#$insts - $i]->[0])
unless $insts->[$#$insts - $i]->[0] > 100;
}
$self->doError(212, 3, "<stx:$el->{LocalName}>", 'name')
unless exists $el->{Attributes}->{'{}name'};
my $qn = $self->_avt($a->{'{}name'}->{Value});
my $ns = exists $a->{'{}namespace'}
? $self->_avt($a->{'{}namespace'}->{Value}) : undef;
my $sel = exists $a->{'{}select'} ?
$self->tokenize($a->{'{}select'}->{Value}) : undef;
$self->{_attribute_select} = $sel;
push @{$self->{c_template}->[-1]->{instructions}},
[I_ATTRIBUTE_START, $qn, $ns, clone($self->{nsc}), $sel];
#print "COMP: >ATTRIBUTE_START\n";
}
# <stx:text> ----------------------------------------
} elsif ($el->{LocalName} eq 'text') {
$self->_allowed($el->{LocalName});
# <stx:cdata> ----------------------------------------
} elsif ($el->{LocalName} eq 'cdata') {
if ($self->_allowed($el->{LocalName})) {
push @{$self->{c_template}->[-1]->{instructions}},
[I_CDATA_START];
#print "COMP: >CDATA_START\n";
}
# <stx:comment> ----------------------------------------
} elsif ($el->{LocalName} eq'comment') {
if ($self->_allowed($el->{LocalName})) {
push @{$self->{c_template}->[-1]->{instructions}},
[I_COMMENT_START];
#print "COMP: >COMMENT_START\n";
}
# <stx:processing-instruction> -----------------------------------
} elsif ($el->{LocalName} eq'processing-instruction') {
if ($self->_allowed($el->{LocalName})) {
$self->doError(212, 3, "<stx:$el->{LocalName}>", 'name')
unless exists $el->{Attributes}->{'{}name'};
my $target = $self->_avt($el->{Attributes}->{'{}name'}->{Value});
push @{$self->{c_template}->[-1]->{instructions}},
[I_PI_START, $target];
#print "COMP: >PI_START\n";
}
# <stx:variable> ----------------------------------------
} elsif ($el->{LocalName} eq 'variable') {
if ($self->_allowed($el->{LocalName})) {
$self->doError(212, 3, "<stx:$el->{LocalName}>", 'name')
unless exists $el->{Attributes}->{'{}name'};
$self->doError(217, 3, 'name',
$a->{'{}name'}->{Value}, 'qname')
unless $a->{'{}name'}->{Value} =~ /^($ATT_QNAME)$/;
my $name = $a->{'{}name'}->{Value};
$name = $self->_expand_qname($name);
my $select;
my $default_select;
if (exists $a->{'{}select'}) {
$self->doError(213, 3, 'select', '<stx:variable>')
if $a->{'{}select'}->{Value} =~ /^\{|\}/;
$select = $self->tokenize($a->{'{}select'}->{Value});
$default_select = 0;
} else {
$select = ['""']; # the empty string
$default_select = 1;
}
$self->{_variable_select} = $select;
STX/Parser.pm view on Meta::CPAN
# <stx:variable> ----------------------------------------
} elsif ($el->{LocalName} =~ /^(variable|param)$/) {
# local variable
if ($self->{c_template}->[0]) {
push @{$self->{c_template}->[-1]->{instructions}}, [I_VARIABLE_END];
#print "COMP: >VARIABLE END\n";
} else {
# tbd
}
# <stx:assign> ----------------------------------------
} elsif ($el->{LocalName} eq 'assign') {
push @{$self->{c_template}->[-1]->{instructions}}, [I_ASSIGN_END];
#print "COMP: >ASSIGN_END\n";
# <stx:with-param> ----------------------------------------
} elsif ($el->{LocalName} eq 'with-param') {
push @{$self->{c_template}->[-1]->{instructions}}, [I_WITH_PARAM_END];
#print "COMP: >WITH_PARAM_END\n";
# <stx:group> ----------------------------------------
} elsif ($el->{LocalName} eq 'group') {
#$self->_dump_g_stack;
my $g = pop @{$self->{g_stack}};
$self->_sort_templates($g->{pc1});
$self->_sort_templates($g->{pc1A});
$self->_sort_templates($g->{pc2});
$self->_sort_templates($g->{pc2A});
# <stx:template> ----------------------------------------
} elsif ($el->{LocalName} eq 'template') {
pop @{$self->{c_template}};
# <stx:procedure> ----------------------------------------
} elsif ($el->{LocalName} eq 'procedure') {
pop @{$self->{c_template}};
# <stx:copy> ----------------------------------------
} elsif ($el->{LocalName} eq 'copy') {
push @{$self->{c_template}->[-1]->{instructions}}, [I_COPY_END];
#print "COMP: >COPY_END\n";
# <stx:element> ----------------------------------------
} elsif ($el->{LocalName} eq 'element') {
push @{$self->{c_template}->[-1]->{instructions}}, [I_ELEMENT_END];
#print "COMP: >ELEMENT_END /$el->{Name}\n";
# <stx:attribute> ----------------------------------------
} elsif ($el->{LocalName} eq 'attribute') {
push @{$self->{c_template}->[-1]->{instructions}}, [I_ATTRIBUTE_END];
#print "COMP: >ATTRIBUTE_END\n";
# <stx:cdata> ----------------------------------------
} elsif ($el->{LocalName} eq 'cdata') {
push @{$self->{c_template}->[-1]->{instructions}}, [I_CDATA_END];
#print "COMP: >CDATA_END\n";
# <stx:comment> ----------------------------------------
} elsif ($el->{LocalName} eq 'comment') {
push @{$self->{c_template}->[-1]->{instructions}}, [I_COMMENT_END];
#print "COMP: >COMMENT_END\n";
# <stx:processing-instruction> -----------------------------------
} elsif ($el->{LocalName} eq 'processing-instruction') {
push @{$self->{c_template}->[-1]->{instructions}}, [I_PI_END];
#print "COMP: >PI_END\n";
# <stx:if> ----------------------------------------
} elsif ($el->{LocalName} eq 'if') {
push @{$self->{c_template}->[-1]->{instructions}}, [I_IF_END];
#print "COMP: >IF_END\n";
# <stx:else> ----------------------------------------
} elsif ($el->{LocalName} eq 'else') {
push @{$self->{c_template}->[-1]->{instructions}}, [I_ELSE_END];
#print "COMP: >ELSE_END\n";
# <stx:choose> ----------------------------------------
} elsif ($el->{LocalName} eq 'choose') {
$self->{_choose} = undef;
#print "COMP: >CHOOSE_END\n";
# <stx:when> ----------------------------------------
} elsif ($el->{LocalName} eq 'when') {
push @{$self->{c_template}->[-1]->{instructions}}, [I_ELSIF_END];
#print "COMP: >WHEN_END\n";
# <stx:otherwise> ----------------------------------------
} elsif ($el->{LocalName} eq 'otherwise') {
push @{$self->{c_template}->[-1]->{instructions}}, [I_ELSE_END];
#print "COMP: >OTHERWISE_END\n";
# <stx:buffer> ----------------------------------------
} elsif ($el->{LocalName} eq 'buffer') {
# local buffer
if ($self->{c_template}->[0]) {
push @{$self->{c_template}->[-1]->{instructions}}, [I_BUFFER_END];
#print "COMP: >BUFFER_END\n";
} else {
# kontrola pres lookahead
}
# <stx:result-buffer> ----------------------------------------
} elsif ($el->{LocalName} eq 'result-buffer') {
push @{$self->{c_template}->[-1]->{instructions}}, [I_RES_BUFFER_END];
#print "COMP: >RESULT_BUFFER_END\n";
# <stx:result-document> ----------------------------------------
} elsif ($el->{LocalName} eq 'result-document') {
push @{$self->{c_template}->[-1]->{instructions}}, [I_RES_DOC_END];
#print "COMP: >RESULT_DOCUMENT_END\n";
# <stx:for-each-item> ----------------------------------------
} elsif ($el->{LocalName} eq 'for-each-item') {
pop @{$self->{c_template}};
# <stx:while> ----------------------------------------
} elsif ($el->{LocalName} eq 'while') {
pop @{$self->{c_template}};
}
# end tags for empty elements can be ignored, their emptiness is
# checked elsewhere
# literals
} else {
push @{$self->{c_template}->[-1]->{instructions}}, [I_LITERAL_END, $el];
#print "COMP: >LITERAL_END /$el->{Name}\n";
}
my $e = pop @{$self->{e_stack}};
# end of local variable visibility
if ($self->{c_template}->[0]) {
foreach (@{$e->{vars}}) {
push @{$self->{c_template}->[-1]->{instructions}},
[I_VARIABLE_SCOPE_END, $_];
#print "COMP: >VARIABLE_SCOPE_END $_\n";
}
}
# end of local buffer visibility
if ($self->{c_template}->[0]) {
foreach (@{$e->{bufs}}) {
push @{$self->{c_template}->[-1]->{instructions}},
[I_BUFFER_SCOPE_END, $_];
#print "COMP: >BUFFER_SCOPE_END $_\n";
}
}
$self->{nsc}->popContext;
}
sub characters {
my $self = shift;
my $char = shift;
# whitespace only
if ($char->{Data} =~ /^\s*$/) {
my $parent = $self->{e_stack}->[-1];
if ($parent->{NamespaceURI} eq STX_NS_URI
and $parent->{LocalName} =~ /^(text|cdata)$/) {
if ($self->_allowed('_text')) {
push @{$self->{c_template}->[-1]->{instructions}},
[I_CHARACTERS, $char->{Data}];
#print "COMP: >CHARACTERS - $char->{Data}\n";
}
}
# not whitespace only
} else {
if ($self->_allowed('_text')) {
push @{$self->{c_template}->[-1]->{instructions}},
[I_CHARACTERS, $char->{Data}];
#print "COMP: >CHARACTERS - $char->{Data}\n";
}
}
}
sub processing_instruction {
my $self = shift;
my $pi = shift;
}
sub ignorable_whitespace {
}
sub start_prefix_mapping {
my ($self, $ns) = @_;
$self->{nsc}->declare_prefix($ns->{Prefix}, $ns->{NamespaceURI});
}
sub end_prefix_mapping {
my ($self, $ns) = @_;
$self->{nsc}->undeclare_prefix($ns->{Prefix});
}
sub skipped_entity {
}
# lexical ----------------------------------------
sub start_cdata {
my $self = shift;
}
sub end_cdata {
my $self = shift;
}
sub comment {
}
sub start_dtd {
}
sub end_dtd {
}
sub start_entity {
}
sub end_entity {
}
# error ----------------------------------------
sub warning {
}
sub error {
}
sub fatal_error {
}
# static evaluation ----------------------------------------
sub _static_eval {
my ($self, $val) = @_;
my $spath = XML::STX::STXPath->new();
my $seq = $spath->expr(undef, $val);
return $seq;
}
# tokenize ----------------------------------------
sub tokenize_match {
my ($self, $pattern) = @_;
my $tokens = [];
foreach my $path (split('\|',$pattern)) {
my $steps = [];
$path =~ s/^\/\///g;
$path =~ s/^\//&R/g;
$path =~ s/\/\//&&&A/g;
$path =~ s/\//&&&P/g;
$path = '&N' . $path unless substr($path,0,2) eq '&R';
foreach (split('&&', $path)) {
my $left = substr($_,1,1);
my $step = $self->tokenize(substr($_,2));
push @$steps, { left => $left, step => $step};
}
push @$tokens, $steps;
}
return $tokens;
}
sub match_priority {
my ($self, $pattern) = @_;
my $priority = [];
foreach my $path (split('\|',$pattern)) {
my @steps = split('/|//',$path);
my $last = $steps[-1];
my $p = 0.5;
if ($#steps == 0) {
if ($last =~ /^$QName$/) {
$p = 0;
} elsif ($last =~ /^processing-instruction\(?:$LITERAL\)$/) {
$p = 0;
} elsif ($last =~ /^cdata\(\)$/) {
$p = 0;
} elsif ($last =~ /^(?:$NCWild)$/) {
$p = -0.25;
} elsif ($last =~ /^(?:$QNWild)$/) {
$p = -0.25;
} elsif ($last =~ /^$NODE_TYPE$/) {
$p = -0.5;
}
}
#print "TOK: last step: $last, more steps: $#steps, priority: $p\n";
push @$priority, $p;
}
return $priority;
}
sub tokenize {
my ($self, $path) = @_;
study $path;
my @tokens = ();
#print "TOK: tokenizing: $path\n";
while($path =~ m/\G
\s* # ignore all whitespace
( $LITERAL| # literal
$DOUBLE_RE| # double numbers
$NUMBER_RE| # digits
\.\.| # parent
\.| # current node
$NODE_TYPE| # node type
processing-instruction| # pi, to allow pi(target)
\$$QName| # variable reference
$QName\(| # function
$NCWild|$QName|$QNWild| # QName
\@($NCWild|$QName|$QNWild)| # attribute
\!=|<=|\-|>=|\/\/|and|or|mod|div| # multi-char seps
[,\+=\|<>\/\(\[\]\)]| # single char seps
(?<!(\@|\(|\[))\*| # multiply operator rules
$ # end of query
)
\s* # ignore all whitespace
/gcxso) {
my ($token) = ($1);
if (length($token)) {
#print "TOK: token: $token\n";
# resolving QNames ####################
if ($token =~ /^$QName\($/o) {
$token = $self->_expand_prefixedFce($token);
$token = substr($token, 0, length($token) - 1);
push @tokens, $token, '(';
} elsif ($token =~ /^$NCName$/o
&& $token !~ /^(?:and|or|mod|div)$/) {
if ($self->{Sheet}->{Options}->
{'stxpath-default-namespace'}->[-1]) {
$token = '{' . $self->{Sheet}->{Options}->
{'stxpath-default-namespace'}->[-1]
. '}' . $token;
}
push @tokens, $token;
} elsif ($token =~ /^([\@\$])?($QName)$/o) {
$token = $1 . $self->_expand_prefixedQN($2);
push @tokens, $token;
} elsif ($token =~ /^(\@)?($NCName):\*$/o) {
$token = $1 . $self->_expand_prefixedQN("$2:lname");
$token =~ s/lname$/*/;
push @tokens, $token;
} elsif ($token =~ /^(\@)?\*:($NCName|\*)$/o) {
$token = $1 . "{*}$2";
push @tokens, $token;
} else {
push @tokens, $token;
}
#print "TOK: exp. token: $token\n";
}
}
if (pos($path) < length($path)) {
my $marker = ("." x (pos($path)-1));
$path = substr($path, 0, pos($path) + 8) . "...";
$path =~ s/\n/ /g;
$path =~ s/\t/ /g;
$self->doError(1, 3, $path, $marker);
}
return \@tokens;
}
# structure ----------------------------------------
my $s_group = ['variable','buffer','template','procedure','include','group'];
my $s_top_level = [@$s_group, 'param', 'namespace-alias'];
my $s_text_constr = ['text','cdata','value-of','if','else','choose','_text'];
my $s_content_constr = [@$s_text_constr ,'call-procedure', 'copy',
'process-attributes', 'process-self', 'element',
'start-element', 'end-element', 'comment',
'processing-instruction', 'variable', 'param',
'assign', 'buffer', 'result-buffer', 'process-buffer',
'result-document', 'process-document', 'for-each-item',
'while', '_literal', 'attribute'];
my $s_template = [@$s_content_constr, 'process-children', 'process-siblings'];
my $sch = {
transform => $s_top_level,
group => $s_group,
template => $s_template,
procedure => $s_template,
'process-children' => ['with-param'],
'process-attributes' => ['with-param'],
'process-self' => ['with-param'],
'process-siblings' => ['with-param'],
'process-document' => ['with-param'],
'process-buffer' => ['with-param'],
'call-procedure' => ['with-param'],
'with-param' => $s_text_constr,
param => $s_text_constr,
copy => $s_template,
element => $s_template,
attribute => $s_text_constr,
'processing-instruction' => $s_text_constr,
comment => $s_text_constr,
'if' => $s_template,
'else' => $s_template,
choose => ['when','otherwise'],
when => $s_template,
otherwise => $s_template,
'for-each-item' => $s_template,
while => $s_template,
variable => $s_text_constr,
assign => $s_text_constr,
text => ['_text'],
cdata => ['_text'],
buffer => $s_template,
'result-buffer' => $s_template,
'result-document' => $s_template,
_literal => $s_template,
};
sub _allowed {
my ($self, $lname) = @_;
if ($#{$self->{e_stack}} == -1) {
$self->doError(202, 3, $lname)
unless $lname eq 'transform';
} else {
my $parent = $self->{e_stack}->[-1];
my $s_key = (defined $parent->{NamespaceURI}
and $parent->{NamespaceURI} eq STX_NS_URI)
? $parent->{LocalName} : '_literal';
$self->doError(215, 3, $lname, $parent->{Name})
unless grep($_ eq $lname ,@{$sch->{$s_key}});
}
return 1;
}
# utils ----------------------------------------
sub _avt {
my ($self, $val) = @_;
if ($val =~ /^\{([^\}\{]*)\}$/) {
return $self->tokenize($1);
} elsif ($val =~ /^.*\{([^\}\{]*)\}.*$/) {
$val =~ s/^(.*)$/concat('$1')/;
$val =~ s/\{/',/g;
$val =~ s/\}/,'/g;
$val =~ s/'',|,''//g;
return $self->tokenize($val);
} else {
return $val;
}
}
sub _sort_templates {
my ($self, $t) = @_;
my $sorted = 1;
while ($sorted) {
$sorted = 0;
for (my $i=0; $i < $#$t; $i++) {
if ($t->[$i+1]->{eff_p} > $t->[$i]->{eff_p}) {
my $tmp = $t->[$i];
$t->[$i] = $t->[$i+1];
$t->[$i+1] = $tmp;
$sorted = 1;
}
( run in 0.814 second using v1.01-cache-2.11-cpan-39bf76dae61 )