You are viewing a plain text version of this content. The canonical link for it is here.
Posted to axkit-dev@xml.apache.org by ma...@sergeant.org on 2006/08/24 02:07:23 UTC
[SVN] [119] Oopsie - forgot to check these into SVN
Revision: 119
Author: matt
Date: 2006-08-24 00:06:56 +0000 (Thu, 24 Aug 2006)
Log Message:
-----------
Oopsie - forgot to check these into SVN
Added Paths:
-----------
trunk/lib/AxKit2/XSP/
trunk/lib/AxKit2/XSP/SimpleTaglib.pm
trunk/lib/AxKit2/XSP/TaglibHelper.pm
Added: trunk/lib/AxKit2/XSP/SimpleTaglib.pm
===================================================================
--- trunk/lib/AxKit2/XSP/SimpleTaglib.pm 2006-08-24 00:05:52 UTC (rev 118)
+++ trunk/lib/AxKit2/XSP/SimpleTaglib.pm 2006-08-24 00:06:56 UTC (rev 119)
@@ -0,0 +1,1342 @@
+# Copyright 2001-2006 The Apache Software Foundation
+#
+# Licensed under the Apache License, Version 2.0 (the "License");
+# you may not use this file except in compliance with the License.
+# You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+#
+
+# Apache::AxKit::XSP::Language::SimpleTaglib - alternate taglib helper code
+package AxKit2::XSP::SimpleTaglib;
+require 5.006;
+use strict;
+use base 'AxKit2::Transformer::XSP';
+use Data::Dumper;
+eval { require WeakRef; };
+eval { require XML::Smart; };
+use attributes;
+our $VERSION = 0.3;
+
+# utility functions
+
+sub makeSingleQuoted($) { $_ = shift; s/([\\%])/\\$1/g; 'q%'.$_.'%'; }
+sub _makeAttributeQuoted(@) { $_ = join(',',@_); s/([\\()])/\\$1/g; '('.$_.')'; }
+sub makeVariableName($) { $_ = shift; s/[^a-zA-Z0-9]/_/g; $_; }
+
+my $dumper = new Data::Dumper([]);
+$dumper->Quotekeys(0);
+$dumper->Terse(1);
+$dumper->Indent(0);
+
+# perl attribute handlers
+
+my %handlerAttributes;
+
+use constant PLAIN => 0;
+use constant EXPR => 1;
+use constant EXPRORNODE => 2;
+use constant NODE => 3;
+use constant EXPRORNODELIST => 4;
+use constant NODELIST => 5;
+use constant STRUCT => 6;
+
+# Memory leak ahead! The '&' construct may create circular references, which perl
+# can't clean up. But this has only an effect if a taglib is reloaded, which shouldn't
+# happen on production machines. Moreover, '&' is rather unusual.
+# If you have the WeakRef module installed, this warning does not apply.
+sub parseChildStructSpec {
+ my ($specs, $refs) = @_;
+ for my $spec ($_[0]) {
+ my $result = {};
+ while (length($spec)) {
+ $spec = substr($spec,1), return $result if (substr($spec,0,1) eq '}');
+ (my ($type, $token, $next) = ($spec =~ m/^([!\&\@\*\$]?)([^ {}]+)(.|$)/))
+ || die("childStruct specification invalid. Parse error at: '$spec'");
+ substr($spec,0,length($token)+1+($type?1:0)) = '';
+ #warn("type: $type, token: $token, next: $next, spec: $spec");
+ my ($realtoken, $params);
+ if ((($realtoken,$params) = ($token =~ m/^([^\(]+)((?:\([^ \)]+\))+)$/))) {
+ my $i = 0;
+ $token = $realtoken;
+ $$result{$token}{'param'} = { map { $_ => $i++ } ($params =~ m/\(([^ )]+)\)/g) };
+ }
+ if ($type eq '&') {
+ ($$result{$token} = $$refs{$token})
+ || die("childStruct specification invalid. '&' reference not found.");
+ die("childStruct specification invalid. '&' cannot be used on '*' nodes.")
+ if ($$result{$token}{'type'} eq '*');
+ die("childStruct specification invalid. '&' may only take a reference.")
+ if $$result{'param'};
+ eval { WeakRef::weaken($$result{$token}) };
+ return $result if (!$next || $next eq '}');
+ next;
+ }
+ $$result{$token}{'type'} = $type || '$';
+ die("childStruct specification invalid. '${type}' cannot be used with '{'.")
+ if ($next eq '{' and ($type eq '*' || $type eq '!'));
+ die("childStruct specification invalid. '${type}' cannot be used with '(,,,)'.")
+ if ($$result{$token}{'param'} and ($type eq '*' || $type eq '!'));
+ die("childStruct specification invalid. '**' is not supported.")
+ if ($token eq '*' and $type eq '*');
+ $$result{''}{'name'} = $token if ($type eq '*');
+ $$result{$token}{'name'} = $token;
+ return $result if (!$next || $next eq '}');
+ ($$result{$token}{'sub'} = parseChildStructSpec($spec, { %$refs, $token => $$result{$token} })) || return undef if $next eq '{';
+ }
+ return $result;
+ }
+}
+
+sub serializeChildStructSpec {
+ my ($struct, $refs) = @_;
+ my $result = '';
+ my $first = 1;
+ foreach my $token (keys %$struct) {
+ next unless length($token);
+ $result .= ' ' unless $first;
+ undef $first;
+ if (exists $$refs{$$struct{$token}}) {
+ $result .= '&'.$token;
+ next;
+ }
+ $result .= $$struct{$token}{'type'};
+ $result .= $token;
+ if (exists $$struct{$token}{'param'}) {
+ my %keys = reverse %{$$struct{$token}{'param'}};
+ $result .= '('.join(')(',@keys{0..(scalar(%keys)-1)}).')'
+ }
+ $result .= '{'.serializeChildStructSpec($$struct{$token}{'sub'},{ %$refs, $$struct{$token} => undef }).'}'
+ if exists $$struct{$token}{'sub'};
+ }
+ return $result;
+}
+
+sub MODIFY_CODE_ATTRIBUTES {
+ my ($pkg,$sub,@attr) = @_;
+ return unless defined $sub;
+ my @rest;
+ $handlerAttributes{$sub} ||= {};
+ my $handlerAttributes = $handlerAttributes{$sub};
+ foreach my $a (@attr) {
+ #warn("attr: $a");
+ my ($attr,$param) = ($a =~ m/([^(]*)(?:\((.*)\))?$/);
+ my $warn = 0;
+ $attr =~ s/^XSP_// || $warn++;
+ $param = (defined $param?eval "q($param)":"");
+ my @param = split(/,/,$param);
+
+ if ($attr eq 'expr') {
+ $$handlerAttributes{'result'} = EXPR;
+ } elsif ($attr eq 'node') {
+ $$handlerAttributes{'result'} = NODE;
+ $$handlerAttributes{'nodename'} = $param[0] || 'value';
+ } elsif ($attr eq 'exprOrNode') {
+ $$handlerAttributes{'result'} = EXPRORNODE;
+ $$handlerAttributes{'nodename'} = $param[0] || 'value';
+ $$handlerAttributes{'resultparam'} = $param[1] || 'as';
+ $$handlerAttributes{'resultnode'} = $param[2] || 'node';
+ } elsif ($attr eq 'nodelist') {
+ $$handlerAttributes{'result'} = NODELIST;
+ $$handlerAttributes{'nodename'} = $param[0] || 'value';
+ } elsif ($attr eq 'exprOrNodelist') {
+ $$handlerAttributes{'result'} = EXPRORNODELIST;
+ $$handlerAttributes{'nodename'} = $param[0] || 'value';
+ $$handlerAttributes{'resultparam'} = $param[1] || 'as';
+ $$handlerAttributes{'resultnode'} = $param[2] || 'node';
+ } elsif ($attr eq 'struct') {
+ $$handlerAttributes{'result'} = STRUCT;
+ $$handlerAttributes{'namespace'} = $param[0];
+ } elsif ($attr eq 'stack') {
+ $$handlerAttributes{'stack'} = $param[0];
+ } elsif ($attr eq 'smart') {
+ $$handlerAttributes{'smart'} = 1;
+ $$handlerAttributes{'capture'} = 1;
+ } elsif ($attr eq 'nodeAttr') {
+ my %namespace;
+ while (@param > 1) {
+ my ($ns, $prefix, $name) = parse_namespace($param[0]);
+ $namespace{$prefix} = $ns if $ns and $prefix;
+ $param[0] = "{$namespace{$prefix}}$prefix:$name" if $prefix;
+ $$handlerAttributes{'resultattr'}{$param[0]} = $param[1];
+ shift @param; shift @param;
+ }
+ } elsif ($attr eq 'attrib') {
+ foreach my $param (@param) {
+ $$handlerAttributes{'attribs'}{$param} = undef;
+ }
+ } elsif ($attr eq 'child') {
+ foreach my $param (@param) {
+ $$handlerAttributes{'children'}{$param} = undef;
+ }
+ } elsif ($attr eq 'attribOrChild') {
+ foreach my $param (@param) {
+ $$handlerAttributes{'attribs'}{$param} = undef;
+ $$handlerAttributes{'children'}{$param} = undef;
+ }
+ } elsif ($attr eq 'childStruct') {
+ my $spec = $param[0];
+ #warn("parsing $spec");
+ $spec =~ s/\s+/ /g;
+ $spec =~ s/ ?{ ?/{/g;
+ $spec =~ s/ ?} ?/}/g;
+ $$handlerAttributes{'struct'} = parseChildStructSpec($spec,{});
+ #warn("parsed $param[0], got ".serializeChildStructSpec($$handlerAttributes{'struct'}));
+ die("childStruct parse error") unless $$handlerAttributes{'struct'};
+ } elsif ($attr eq 'keepWhitespace') {
+ $$handlerAttributes{'keepWS'} = 1;
+ } elsif ($attr eq 'captureContent') {
+ $$handlerAttributes{'capture'} = 1;
+ } elsif ($attr eq 'compile') {
+ $$handlerAttributes{'compile'} = 1;
+ } elsif ($attr eq 'XSP' && $warn) {
+ $warn = 0;
+ $$handlerAttributes{'xsp'} = 1;
+ } else {
+ push @rest, $a;
+ $warn = 0;
+ }
+ warn("Please prefix your XSP attributes with 'XSP_' (${pkg}::${sub} : $attr)") if $warn;
+ }
+ delete $handlerAttributes{$sub} if not keys %$handlerAttributes;
+ return @rest;
+}
+
+sub FETCH_CODE_ATTRIBUTES {
+ my ($pkg,$sub) = @_;
+ my @attr;
+ my $handlerAttributes = $handlerAttributes{$sub};
+ return () if !defined $handlerAttributes;
+ if (exists $$handlerAttributes{'result'}) {
+ if ($$handlerAttributes{'result'} == NODELIST) {
+ push @attr, 'XSP_nodelist'._makeAttributeQuoted($$handlerAttributes{'nodename'});
+ } elsif ($$handlerAttributes{'result'} == EXPRORNODELIST) {
+ push @attr, 'XSP_exprOrNodelist'._makeAttributeQuoted($$handlerAttributes{'nodename'},$$handlerAttributes{'resultparam'},$$handlerAttributes{'resultnode'});
+ } elsif ($$handlerAttributes{'result'} == NODE) {
+ push @attr, 'XSP_node'._makeAttributeQuoted($$handlerAttributes{'nodename'});
+ } elsif ($$handlerAttributes{'result'} == EXPRORNODE) {
+ push @attr, 'XSP_exprOrNode'._makeAttributeQuoted($$handlerAttributes{'nodename'},$$handlerAttributes{'resultparam'},$$handlerAttributes{'resultnode'});
+ } elsif ($$handlerAttributes{'result'} == EXPR) {
+ push @attr, 'XSP_expr';
+ } elsif ($$handlerAttributes{'result'} == STRUCT) {
+ push @attr, 'XSP_struct';
+ $attr[-1] .= _makeAttributeQuoted($$handlerAttributes{'namespace'})
+ if defined $$handlerAttributes{'namespace'};
+ }
+ }
+ push @attr, 'XSP_nodeAttr'._makeAttributeQuoted(%{$$handlerAttributes{'resultattr'}}) if $$handlerAttributes{'resultattr'};
+ push @attr, 'XSP_stack'._makeAttributeQuoted($$handlerAttributes{'stack'}) if $$handlerAttributes{'stack'};
+ push @attr, 'XSP_smart' if $$handlerAttributes{'smart'};
+ push @attr, 'XSP_keepWhitespace' if $$handlerAttributes{'keepWS'};
+ push @attr, 'XSP_captureContent' if $$handlerAttributes{'capture'};
+ push @attr, 'XSP_compile' if $$handlerAttributes{'compile'};
+
+ push @attr, 'XSP_childStruct'._makeAttributeQuoted(serializeChildStructSpec($$handlerAttributes{'struct'},{}))
+ if ($$handlerAttributes{'struct'});
+
+ my (@attribs, @children, @both);
+ foreach my $param (keys %{$$handlerAttributes{'attribs'}}) {
+ if (exists $$handlerAttributes{'children'}{$param}) {
+ push @both, $param;
+ } else {
+ push @attribs, $param;
+ }
+ }
+ foreach my $param (keys %{$$handlerAttributes{'children'}}) {
+ if (!exists $$handlerAttributes{'attribs'}{$param}) {
+ push @children, $param;
+ }
+ }
+ push @attr, 'XSP_attrib'._makeAttributeQuoted(@attribs) if @attribs;
+ push @attr, 'XSP_child'._makeAttributeQuoted(@children) if @children;
+ push @attr, 'XSP_attribOrChild'._makeAttributeQuoted(@both) if @both;
+ push @attr, 'XSP' if !@attr;
+ return @attr;
+}
+
+sub import {
+ my $pkg = caller;
+ #warn("making $pkg a SimpleTaglib");
+ {
+ no strict 'refs';
+ *{$pkg.'::Handlers::MODIFY_CODE_ATTRIBUTES'} = \&MODIFY_CODE_ATTRIBUTES;
+ *{$pkg.'::Handlers::FETCH_CODE_ATTRIBUTES'} = \&FETCH_CODE_ATTRIBUTES;
+ push @{$pkg.'::ISA'}, 'AxKit2::XSP::SimpleTaglib';
+
+ }
+ return undef;
+}
+
+# companions to start_expr
+
+sub start_expr {
+ my $e = shift;
+ my $cur = $e->{Current_Element};
+ my $rc = $e->start_expr(@_);
+ $e->{Current_Element} = $cur;
+ return $rc;
+}
+
+sub start_elem {
+ my ($e, $nodename, $attribs, $default_prefix, $default_ns) = @_;
+ my($ns, $prefix, $name) = parse_namespace($nodename);
+ #$prefix = $e->generate_nsprefix($ns) if $ns and not $prefix;
+ if (not defined $ns and not defined $prefix) {
+ $ns = $default_ns; $prefix = $default_prefix;
+ }
+ $name = $prefix.':'.$name if $prefix;
+ if ($ns) {
+ $e->append_to_script('{ my $elem = $document->createElementNS('.makeSingleQuoted($ns).','.makeSingleQuoted($name).');');
+ }
+ else {
+ $e->append_to_script('{ my $elem = $document->createElement('.makeSingleQuoted($name).');');
+ }
+ $e->append_to_script('$parent->appendChild($elem); $parent = $elem; }' . "\n");
+ if ($attribs) {
+ while (my ($key, $value) = each %$attribs) {
+ start_attr($e, $key); $e->append_to_script('.'.$value); end_attr($e);
+ }
+ }
+ $e->manage_text(0);
+}
+
+sub end_elem {
+ my ($e) = @_;
+ $e->append_to_script('$parent = $parent->getParentNode;'."\n");
+}
+
+sub start_attr {
+ my ($e, $attrname, $default_prefix, $default_ns) = @_;
+ my($ns, $prefix, $name) = parse_namespace($attrname);
+ #$prefix = $e->generate_nsprefix($ns) if $ns and not $prefix;
+ if (not defined $ns and not defined $prefix) {
+ $ns = $default_ns; $prefix = $default_prefix;
+ }
+ $name = $prefix.':'.$name if $prefix;
+
+ if ($ns and defined $prefix) {
+ $e->append_to_script('$parent->setAttributeNS('.makeSingleQuoted($ns).','.makeSingleQuoted($name).', ""');
+ }
+ else {
+ $e->append_to_script('$parent->setAttribute('.makeSingleQuoted($name).', ""');
+ }
+ $e->manage_text(0);
+}
+
+sub end_attr {
+ my ($e) = @_;
+ $e->append_to_script(');'."\n");
+}
+
+# global variables
+# FIXME - put into $e (are we allowed to?)
+
+my %structStack = ();
+my %frame = ();
+my @globalframe = ();
+my $structStack;
+my %stacklevel = ();
+my %stackcur = ();
+
+# generic tag handler subs
+
+sub set_attribOrChild_value__open {
+ my ($e, $tag) = @_;
+ $globalframe[0]{'capture'} = 1;
+ return '$attr_'.makeVariableName($tag).' = ""';
+}
+
+sub set_attribOrChild_value : XSP_keepWhitespace {
+ return '; ';
+}
+
+my @ignore;
+sub set_childStruct_value__open {
+ my ($e, $tag, %attribs) = @_;
+ my $var = '$_{'.makeSingleQuoted($tag).'}';
+ if ($$structStack[0][0]{'param'} && exists $$structStack[0][0]{'param'}{$tag}) {
+ $e->append_to_script('.do { $param_'.$$structStack[0][0]{'param'}{$tag}.' = ""');
+ $globalframe[0]{'capture'} = 1;
+ return '';
+ }
+ my $desc = $$structStack[0][0]{'sub'}{$tag};
+ if (!$desc) {
+ $desc = $$structStack[0][0]{'sub'}{'*'};
+ #warn("$tag desc: ".Data::Dumper::Dumper($desc));
+ }
+ die("Tag $tag not found in childStruct specification.") if (!$desc);
+ push(@ignore, 1), return '' if ($$desc{'type'} eq '!');
+ push @ignore, 0;
+ unshift @{$$structStack[0]},$desc;
+ if ($$desc{'param'}) {
+ $e->append_to_script("{ \n");
+ foreach my $key (keys %{$$desc{'param'}}) {
+ $_ = $$desc{'param'}{$key};
+ $e->append_to_script("my \$param_$_; ");
+ $e->append_to_script("\$param_$_ = ".makeSingleQuoted($attribs{$key}).'; ')
+ if exists $attribs{$key};
+ }
+ $e->append_to_script('local ($_) = ""; ');
+ $var = '$_';
+ }
+ if ($$desc{'type'} eq '@') {
+ $e->append_to_script("$var ||= []; push \@{$var}, ");
+ } else {
+ $e->append_to_script("$var = ");
+ }
+ if ($$desc{'sub'}) {
+ $e->append_to_script('do {');
+ $e->append_to_script('local (%_) = (); ');
+ foreach my $attrib (keys %attribs) {
+ next if $$desc{'sub'}{$attrib}{'type'} eq '%';
+ $e->append_to_script('$_{'.makeSingleQuoted($attrib).'} = ');
+ $e->append_to_script('[ ') if $$desc{'sub'}{$attrib}{'type'} eq '@';
+ $e->append_to_script(makeSingleQuoted($attribs{$attrib}));
+ $e->append_to_script(' ]') if $$desc{'sub'}{$attrib}{'type'} eq '@';
+ $e->append_to_script('; ');
+ }
+ my $textname = $$desc{'sub'}{''}{'name'};
+ if ($textname) {
+ $e->append_to_script(' $_{'.makeSingleQuoted($textname).'} = ""');
+ $globalframe[0]{'capture'} = 1;
+ }
+ } else {
+ $e->append_to_script('""');
+ $globalframe[0]{'capture'} = 1;
+ }
+ return '';
+}
+
+sub set_childStruct_value {
+ my ($e, $tag) = @_;
+ if ($$structStack[0][0]{'param'} && exists $$structStack[0][0]{'param'}{$tag}) {
+ $e->append_to_script('; }');
+ return '';
+ }
+ my $desc = $$structStack[0][0];
+ my $ignore = pop @ignore;
+ return '' if ($ignore);
+ shift @{$$structStack[0]};
+ if ($$desc{'sub'}) {
+ $e->append_to_script(' \%_; }; ');
+ }
+ if ($$desc{'param'}) {
+ my $var = '$_{'.makeSingleQuoted($tag).'}';
+ for (0..(scalar(%{$$desc{'param'}})-1)) {
+ $var .= "{\$param_$_}";
+ }
+ if ($$desc{'type'} eq '@') {
+ $e->append_to_script("$var ||= []; push \@{$var}, \@{\$_};");
+ } else {
+ $e->append_to_script("$var = \$_;");
+ }
+ $e->append_to_script(" }\n");
+ }
+ return '';
+}
+
+sub set_XmlSmart_value__open {
+ my ($e, $tag, %attribs) = @_;
+ $dumper->Values([\%attribs]);
+ return 'XML::Smart::Tree::_Start($xml_subtree_parser,'.makeSingleQuoted($tag).','.$dumper->Dumpxs().');'."\n";
+}
+
+sub set_XmlSmart_value : XSP_captureContent {
+ my ($e, $tag) = @_;
+ return 'XML::Smart::Tree::_Char($xml_subtree_parser,$_) if (length($_));'."\n".
+ 'XML::Smart::Tree::_End($xml_subtree_parser,'.makeSingleQuoted($tag).');"";'."\n";
+}
+
+
+# code called from compiled XSP scripts
+sub parse_namespace {
+ local( $_ ) = shift;
+
+ # These forms will return ns and prefix as follows:
+ # *1. {ns}prefix:name => ns specified, prefix specified (fully specified)
+ # *2a. {ns}name => ns specified, prefix undefined (generate prefix)
+ # 2b. {ns}:name => ns specified, prefix undefined (generate prefix)
+ # *3a. prefix:name => ns undefined, prefix specified (lookup ns)
+ # 3b. {}prefix:name => ns undefined, prefix specified (lookup ns)
+ # *4a. {}name => ns is '', prefix is '' (no ns)
+ # 4b. {}:name => ns is '', prefix is '' (no ns)
+ # 4c. :name => ns is '', prefix is '' (no ns)
+ # *5. name => ns undefined, prefix undefined (default ns)
+ # The canonical forms are starred.
+ # (Note that neither a ns of '0' nor a prefix of '0' is allowed;
+ # they will be treated as empty strings.)
+
+ # The following tests can be used:
+ # if $ns and $prefix => fully specified
+ # if $ns and not $prefix => generate prefix
+ # if not $ns and $prefix => lookup ns
+ # if not $ns and defined $ns => no ns
+ # if not defined $ns and not defined $prefix => default ns
+
+ # This pattern match will almost give the desired results:
+ my ($ns, $prefix, $name) = m/^(?:{(.*)})? (?:([^:]*):)? (.*)$/x;
+
+ # These cases are fine with the pattern match:
+ # 1. {ns}prefix:name => ns specified, prefix specified
+ # 2a. {ns}name => ns specified, prefix undefined
+ # 3a. prefix:name => ns undefined, prefix specified
+ # 4b. {}:name => ns is '', prefix is ''
+ # 5. name => ns undefined, prefix undefined
+
+ # These cases need to be adjusted:
+
+ # 2b. {ns}:name => ns specified, prefix '' <= actual result
+ # 2b. {ns}:name => ns specified, prefix undefined <= desired result
+ $prefix = undef if $ns and not $prefix;
+
+ # 3b. {}prefix:name => ns '', prefix specified <= actual result
+ # 3b. {}prefix:name => ns undefined, prefix specified <= desired result
+ $ns = undef if not $ns and $prefix;
+
+ # 4a. {}name, => ns is '', prefix undefined <= actual result
+ # 4a. {}name, => ns is '', prefix is '' <= desired result
+ $prefix = '' if not $prefix and defined $ns and $ns eq '';
+
+ # 4c. :name => ns undefined, prefix is '' <= actual result
+ # 4c. :name => ns is '', prefix is '' <= desired result
+ $ns = '' if not $ns and defined $prefix and $prefix eq '';
+
+ ($ns, $prefix, $name);
+}
+
+sub _lookup_prefix {
+ my ($ns, $namespaces) = @_;
+ my $i = 0;
+ foreach my $namespace (@$namespaces) {
+ my ($nsprefix, $nsuri) = @$namespace;
+ ++$i;
+ next unless $nsuri eq $ns;
+ #$nsprefix = "stlns$i" if $nsprefix eq '' and $nsuri ne '';
+ return $nsprefix;
+ }
+ #return "stlns$i";
+ return "";
+}
+
+sub _lookup_ns {
+ my ($prefix, $namespaces) = @_;
+ $prefix ||= '';
+ my $i = 0;
+ foreach my $namespace (@$namespaces) {
+ my ($nsprefix, $nsuri) = @$namespace;
+ #++$i;
+ next unless $nsprefix eq $prefix;
+ #$nsprefix = "stlns$i" if $nsprefix eq '' and $nsuri ne '';
+ return wantarray ? ($nsuri, $nsprefix) : $nsuri;
+ }
+ my ($nsprefix, $nsuri) = @{$namespaces->[-1]}; # default namespace
+ return wantarray ? ($nsuri, $nsprefix) : $nsuri;
+}
+
+
+sub xmlize {
+ my ($document, $parent, $namespaces, @data) = @_;
+ foreach my $data (@data) {
+ if (UNIVERSAL::isa($data,'XML::LibXML::Document')) {
+ $data = $data->getDocumentElement();
+ }
+ if (UNIVERSAL::isa($data,'XML::LibXML::Node')) {
+ $document->importNode($data);
+ $parent->appendChild($data);
+ next;
+ }
+ die 'data is not a hash ref or DOM fragment!' unless ref($data) eq 'HASH';
+ while (my ($key, $val) = each %$data) {
+ my $outer_namespaces_added = 0;
+ if (substr($key,0,1) eq '@') {
+ $key = substr($key,1);
+ die 'attribute value is not a simple scalar!' if ref($val);
+ next if $key =~ m/^xmlns(?::|$)/; # already processed these
+ my ($ns, $prefix, $name) = parse_namespace($key);
+ #$prefix = _lookup_prefix($ns, $namespaces) if $ns and not $prefix;
+ $ns = _lookup_ns($prefix, $namespaces) if not $ns and $prefix;
+ $name = $prefix.':'.$name if $prefix;
+ if ($ns and $prefix) {
+ $parent->setAttributeNS($ns,$name,$val);
+ } else {
+ $parent->setAttribute($name,$val);
+ }
+ next;
+ }
+
+ my ($ns, $prefix, $name) = parse_namespace($key);
+ $prefix = _lookup_prefix($ns, $namespaces) if $ns and not $prefix;
+ if (defined $ns) {
+ unshift @$namespaces, [ $prefix => $ns ];
+ $outer_namespaces_added++;
+ }
+ my @data = ref($val) eq 'ARRAY'? @$val:$val;
+ foreach my $data (@data) {
+ my $namespaces_added = 0;
+ if (ref($data) and ref($data) eq 'HASH') {
+ # search for namespace declarations in attributes
+ while (my ($key, $val) = each %$data) {
+ if ($key =~ m/^\@xmlns(?::|$)(.*)/) {
+ unshift @$namespaces, [ $1 => $val ];
+ $namespaces_added++;
+ }
+ }
+ }
+
+ my $elem;
+ if (length($key)) {
+ my($nsuri, $nsprefix, $local) = ($ns, $prefix, $name);
+ ($nsuri, $nsprefix) = _lookup_ns($nsprefix, $namespaces) if not defined $nsuri;
+ $local = $nsprefix.':'.$local if $nsprefix;
+ if ($nsuri) {
+ $elem = $document->createElementNS($nsuri,$local);
+ } else {
+ $elem = $document->createElement($local);
+ }
+ $parent->appendChild($elem);
+ } else {
+ $elem = $parent;
+ }
+
+ if (ref($data)) {
+ xmlize($document, $elem, $namespaces, $data);
+ } else {
+ my $tn = $document->createTextNode($data);
+ $elem->appendChild($tn);
+ }
+ splice(@$namespaces, 0, $namespaces_added) if $namespaces_added; # remove added namespaces
+ }
+ splice(@$namespaces, 0, $outer_namespaces_added) if $outer_namespaces_added; # remove added namespaces
+ }
+ }
+}
+
+# event handlers
+
+sub characters {
+ my ($e, $node) = @_;
+ my $text = $node->{'Data'};
+ if ($globalframe[0]{'ignoreWS'}) {
+ $text =~ s/^\s*//;
+ $text =~ s/\s*$//;
+ }
+ return '' if $text eq '';
+ return '.'.makeSingleQuoted($text);
+}
+
+sub start_element
+{
+ my ($e, $element) = @_;
+ my %attribs = map { $_->{'Name'} => $_->{'Value'} } @{$element->{'Attributes'}};
+ my $tag = $element->{'Name'};
+ #warn("Element: ".join(",",map { "$_ => ".$$element{$_} } keys %$element));
+ my $ns = $element->{'NamespaceURI'};
+ my $frame = ($frame{$ns} ||= []);
+ $structStack = ($structStack{$ns} ||= []);
+ my $rtpkg = $AxKit2::Transformer::XSP::tag_lib{$ns};
+ my $pkg = $rtpkg."::Handlers";
+ my ($sub, $subOpen, $rtsub, $rtsubOpen);
+ my $attribs = {};
+ my $longtag;
+ #warn("full struct: ".serializeChildStructSpec($$structStack[0][$#{$$structStack[0]}]{'sub'})) if $$structStack[0];
+ #warn("current node: ".$$structStack[0][0]{'name'}) if $$structStack[0];
+ #warn("rest struct: ".serializeChildStructSpec($$structStack[0][0]{'sub'})) if $$structStack[0];
+ if ($$structStack[0][0]{'param'} && exists $$structStack[0][0]{'param'}{$tag}) {
+ $sub = \&set_childStruct_value;
+ $subOpen = \&set_childStruct_value__open;
+ } elsif ($$structStack[0][0]{'sub'} && (exists $$structStack[0][0]{'sub'}{$tag} || exists $$structStack[0][0]{'sub'}{'*'})) {
+ my $tkey = $tag;
+ $tkey = '*' if (!exists $$structStack[0][0]{'sub'}{$tag});
+ if ($$structStack[0][0]{'sub'}{$tkey}{'sub'}) {
+ foreach my $key (keys %{$$structStack[0][0]{'sub'}{$tkey}{'sub'}}) {
+ $$attribs{$key} = $attribs{$key} if exists $attribs{$key};
+ }
+ }
+ if ($$structStack[0][0]{'sub'}{$tkey}{'param'}) {
+ foreach my $key (keys %{$$structStack[0][0]{'sub'}{$tkey}{'param'}}) {
+ $$attribs{$key} = $attribs{$key} if exists $attribs{$key};
+ }
+ }
+ $sub = \&set_childStruct_value;
+ $subOpen = \&set_childStruct_value__open;
+ } else {
+ for my $i (0..$#{$frame}) {
+ if (exists $$frame[$i]{'vars'}{$tag}) {
+ #warn("variable: $tag");
+ $sub = \&set_attribOrChild_value;
+ $subOpen = \&set_attribOrChild_value__open;
+ last;
+ }
+ }
+ if (!$sub) {
+ my @backframes = (reverse(map{ ${$_}{'name'} } @{$frame}),$tag);
+ #warn("frames: ".@$frame.", backframes: ".join(",",@backframes));
+ my $i = @backframes+1;
+ while ($i) {
+ $longtag = join('___', @backframes) || '_default';
+ shift @backframes;
+ $i--;
+ #warn("checking for $longtag");
+ if ($sub = $pkg->can(makeVariableName($longtag))) {
+ $subOpen = $pkg->can(makeVariableName($longtag)."__open");
+ }
+ if ($handlerAttributes{$rtsub} and $rtsub = $rtpkg->can(makeVariableName($longtag))) {
+ $rtsubOpen = $rtpkg->can(makeVariableName($longtag)."__open");
+ }
+ die("Simultaneous run-time and compile-time handlers for one tag not supported") if $sub and $rtsub;
+ last if $sub or $rtsub;
+ }
+ }
+ }
+ if (((!$sub && !$rtsub) || $longtag eq '_default') && $frame{smart}) {
+ $sub = &set_XmlSmart_value;
+ $subOpen = &set_XmlSmart_value__open;
+ }
+ die "invalid tag: $tag (namespace: $ns, package $pkg, parents ".join(", ",map{ ${$_}{'name'} } @{$frame}).")" unless $sub or $rtsub;
+
+ my $handlerAttributes = $handlerAttributes{$sub || $rtsub};
+ if ($$handlerAttributes{'compile'}) {
+ $sub = $rtsub;
+ undef $rtsub;
+ $subOpen = $rtsubOpen;
+ undef $rtsubOpen;
+ }
+
+ if ($$handlerAttributes{'result'} == STRUCT || !$$handlerAttributes{'result'} ||
+ $$handlerAttributes{'result'} == NODELIST ||
+ ($$handlerAttributes{'result'} == EXPRORNODELIST &&
+ $attribs{$$handlerAttributes{'resultparam'}} eq
+ $$handlerAttributes{'resultnode'})) {
+
+ # FIXME: this can give problems with non-SimpleTaglib-taglib interaction
+ # it must autodetect whether to use '.do' or not like xsp:expr, but as
+ # that one doesn't work reliably neither, it probably doesn't make any
+ # difference
+ $e->append_to_script('.') if ($globalframe[0]{'capture'});
+ $e->append_to_script('do { ') if ($element->{Parent});
+
+ } elsif ($$handlerAttributes{'result'} == NODE ||
+ ($$handlerAttributes{'result'} == EXPRORNODE
+ && $attribs{$$handlerAttributes{'resultparam'}} eq
+ $$handlerAttributes{'resultnode'})) {
+
+ $e->append_to_script('.') if ($globalframe[0]{'capture'});
+ $e->append_to_script('do { ');
+ start_elem($e,$$handlerAttributes{'nodename'},$$handlerAttributes{'resultattr'},$element->{'Prefix'},$ns);
+ start_expr($e,$tag);
+ } else {
@@ Diff output truncated at 30000 characters. @@
Re: [SVN] [119] Oopsie - forgot to check these into SVN
Posted by Matt Sergeant <ma...@sergeant.org>.
Were or weren't? Either way, yes it will at some point go into
apache.org svn. Right now I'm holding off because we're pending
migrating to perl.apache.org, plus only me and Jörg are hacking on it,
so giving us both svn access is rather easy.
On 29 Aug 2006, at 01:16, S. Woodside wrote:
> Matt, didn't you say at some point that you weren't going to put
> axkit2 into Apache?
>
> --simon
>
> On Aug 23, 2006, at 8:07 PM, matt@sergeant.org wrote:
>
>> +++ trunk/lib/AxKit2/XSP/SimpleTaglib.pm 2006-08-24 00:06:56 UTC (rev
>> 119)
>> @@ -0,0 +1,1342 @@
>> +# Copyright 2001-2006 The Apache Software Foundation
>
> --
> http://simonwoodside.com
>
>
Re: [SVN] [119] Oopsie - forgot to check these into SVN
Posted by "S. Woodside" <sb...@yahoo.com>.
Matt, didn't you say at some point that you weren't going to put
axkit2 into Apache?
--simon
On Aug 23, 2006, at 8:07 PM, matt@sergeant.org wrote:
> +++ trunk/lib/AxKit2/XSP/SimpleTaglib.pm 2006-08-24 00:06:56 UTC
> (rev 119)
> @@ -0,0 +1,1342 @@
> +# Copyright 2001-2006 The Apache Software Foundation
--
http://simonwoodside.com