You are viewing a plain text version of this content. The canonical link for it is here.
Posted to commits@xerces.apache.org by ja...@apache.org on 2001/07/09 19:34:59 UTC
cvs commit: xml-xerces/perl postModule.pl
jasons 01/07/09 10:34:58
Modified: perl postModule.pl
Log:
* postModule.pl (Repository):
Added $CURR_CLASS state variable
Added IDOM support
remove all the enums inherited through DOM_Node and IDOM_Node
Added overload support for DOMParse::parse and
DOMParse::parseFirst
Revision Changes Path
1.14 +405 -57 xml-xerces/perl/postModule.pl
Index: postModule.pl
===================================================================
RCS file: /home/cvs/xml-xerces/perl/postModule.pl,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -r1.13 -r1.14
--- postModule.pl 2001/06/14 05:35:13 1.13
+++ postModule.pl 2001/07/09 17:34:54 1.14
@@ -45,8 +45,12 @@
open TEMP, ">$progname.$num.tmp";
+ my $CURR_CLASS = '';
while(<FILE>) {
- # for some reason I don't want to figure out SWIG puts a bunch of
+ if (/^package/) {
+ ($CURR_CLASS) = m/package\s+XML::Xerces::([\w_]+);/;
+ }
+ # for some reason (I don't want to figure out) SWIG puts a bunch of
# methods directly in the XML::Xerces namespace that don't belong there
# and are duplicated within their proper classes, so we delete them
if (/FUNCTION WRAPPERS/) {
@@ -63,6 +67,9 @@
}
}
+ # we remove all the enums inherited through DOM_Node and IDOM_Node
+ next if /^*[_A-Z]+_NODE =/ && !/DOM_Node/;
+
# now we set these aliases correctly
s/\*XML::Xerces::/*XML::Xercesc::/;
@@ -117,22 +124,22 @@
# this is for SWIG 1.1, because -package is broken
s/([^:])\bXerces/$ {1}XML::Xerces/g;
s/package\s+(?!XML::Xerces)([^\s;])/package XML::Xerces::$1/;
-#
+
# split on multiple lines to be readable, using s<><>x
s<\@ISA\s*=\s*qw\s*\(\s*XML::Xerces\s*(?!XML::Xerces::)(\S+)\s*\)>
<\@ISA = qw( XML::Xerces XML::Xerces::$1 )>x;
-#
+
s/\$(?!XML::Xerces)(\w+)::OWNER/\$XML::Xerces::$1::OWNER/;
s/bless(.*?)"(?!XML::Xerces)(.*?)"/bless$1"XML::Xerces::$2"/;
s/tie(.*?)"(?!XML::Xerces)(.*?)"/tie$1"XML::Xerces::$2"/;
-# #######################################################################
-# #
-# # Perl API specific changes
-# #
-# # DOM_NodeList: automatically convert to perl list
-# # if called in a list context
- if (/^(\s*)\$(XML::Xerces::)?DOM_NodeList::OWNER/) {
+ #######################################################################
+ #
+ # Perl API specific changes
+ #
+ # DOM_NodeList: automatically convert to perl list
+ # if called in a list context
+ if (/^(\s*)\$(XML::Xerces::)?I?DOM_NodeList::OWNER/) {
print TEMP <<'EOT';
# automatically convert to perl list if called in a list context
return $result->to_list() if wantarray;
@@ -141,7 +148,7 @@
# DOM_NamedNodeMap: automatically convert to perl hash
# if called in a list context
- if (/^(\s*)\$(XML::Xerces::)?DOM_NamedNodeMap::OWNER/) {
+ if (/^(\s*)\$(XML::Xerces::)?I?DOM_NamedNodeMap::OWNER/) {
print TEMP <<'EOT';
# automatically convert to perl hash if called in a list context
return $result->to_hash() if wantarray;
@@ -149,7 +156,7 @@
}
# DOM_Node: automatically convert to base class
- if (/^(\s*)\$(XML::Xerces::)?DOM_Node::OWNER/) {
+ if (/^(\s*)\$(XML::Xerces::)?I?DOM_Node::OWNER/) {
print TEMP <<'EOT';
# automatically convert to base class
$result = $result->actual_cast();
@@ -160,9 +167,56 @@
#
# Method Overloads
- # don't print out SWIG's default overloaded methods, we'll make our own
- next if /XML::Xerces.*__overload__/;
+ if ($CURR_CLASS eq 'DOMParser') {
+ next if /__overload__/;
+ if (/XML::Xercesc::DOMParser_parse;/) {
+ print TEMP <<'EOT';
+sub parse {
+ my @args = @_;
+ if (ref $args[1]) {
+ XML::Xercesc::DOMParser_parse(@args);
+ } else {
+ XML::Xercesc::DOMParser_parse__overload__1(@args);
+ }
+}
+EOT
+ next;
+ } elsif (/XML::Xercesc::DOMParser_parseFirst/) {
+ print TEMP <<'EOT';
+sub parseFirst {
+ my @args = @_;
+ if (ref $args[1]) {
+ XML::Xercesc::DOMParser_parseFirst(@args);
+ } else {
+ XML::Xercesc::DOMParser_parseFirst__overload__1(@args);
+ }
+}
+EOT
+ next;
+ }
+ }
+
+ if ($CURR_CLASS eq 'DOM_Attr') {
+ if (/^sub.*__constructor__/) {
+ remove_method(\*FILE,\*TEMP);
+ next;
+ } elsif (/^sub\s+new/) {
+ my $new = <<'EOT';
+ if (scalar @args == 0) {
+ $self = XML::Xercesc::new_DOM_Attr();
+ } else {
+ $self = XML::Xercesc::DOM_Attr_DOM_Attr__constructor__1(@args);
+ }
+EOT
+ fix_method(\*FILE,
+ \*TEMP,
+ qr/\$self = XML::Xercesc::new_DOM_Attr/,
+ $new);
+ next;
+ }
+ }
+
if (/XML::Xerces::XMLReaderFactory_createXMLReader/) {
print TEMP <<'EOT';
sub createXMLReader {
@@ -178,6 +232,9 @@
next;
}
+ # don't print out SWIG's default overloaded methods, we'll make our own
+ next if /XML::Xerces.*__overload__/;
+
######################################################################
#
# Callback registration
@@ -201,7 +258,7 @@
}
EOT
- if ($class eq 'DOMParser') {
+ if ($class =~ /I?DOMParser/) {
print TEMP <<'EOT';
# SWIG gets horribly upset if we don't decrement these refcounts
sub DESTROY {
@@ -381,6 +438,17 @@
return @list;
}
+package XML::Xerces::IDOM_NodeList;
+# convert the NodeList to a perl list
+sub to_list {
+ my $self = shift;
+ my @list;
+ for (my $i=0;$i<$self->getLength();$i++) {
+ push(@list,$self->item($i));
+ }
+ return @list;
+}
+
package XML::Xerces::DOM_Entity;
sub to_hash {
my $self = shift;
@@ -392,6 +460,17 @@
}
}
+package XML::Xerces::IDOM_Entity;
+sub to_hash {
+ my $self = shift;
+ if ($self->hasChildNodes) {
+ return ($self->getNodeName(),
+ $self->getFirstChild->getNodeValue());
+ } else {
+ return ($self->getNodeName(), '');
+ }
+}
+
package XML::Xerces::AttributeList;
sub to_hash {
my $self = shift;
@@ -419,64 +498,290 @@
return @list;
}
-package XML::Xerces;
+package XML::Xerces::IDOM_NamedNodeMap;
+# convert the NamedNodeMap to a perl hash
+sub to_hash {
+ my $self = shift;
+ my @list;
+ for (my $i=0;$i<$self->getLength();$i++) {
+ my $node = $self->item($i);
+ if ($node->getNodeType == $XML::Xerces::IDOM_Node::ENTITY_NODE) {
+ push(@list, $node->to_hash());
+ } else {
+ push(@list, $node->getNodeName());
+ push(@list,$node->getNodeValue());
+ }
+ }
+ return @list;
+}
+
+package XML::Xerces::IDOM_Node;
+sub _isa {
+ return 0 unless defined $_[0];
+
+ my %package_hash = ($_[0] => 1);
+ my @package_array = ($_[0]);
+ my $base = $_[1];
+
+ while(my $class = shift @package_array) {
+ return 1 if "$class" eq "$base";
+ foreach my $inherit (eval "\@$class\::ISA;") {
+ unless ($package_hash{$inherit}) {
+ $package_hash{$inherit} = 1;
+ push @package_array, $inherit;
+ }
+ }
+ }
+ return 0;
+};
+
+
+sub _reinterpret_cast {
+ return undef unless ref $_[1];
+
+ bless $_[1], $_[0];
+
+ my($raw_ref, $tied) = ($_[1] =~ m[=(.*)\(]);
+
+ if ($raw_ref eq 'SCALAR') { $tied = tied ${$_[1]}; }
+ elsif ($raw_ref eq 'ARRAY') { $tied = tied @{$_[1]}; }
+ elsif ($raw_ref eq 'HASH') { $tied = tied %{$_[1]}; }
+
+ return $_[1] unless $tied;
+
+ bless $tied, $_[0];
+ return $_[1];
+};
+
+sub actual_cast {
+ return undef unless _isa( ref($_[0]), 'XML::Xerces::IDOM_Node' );
+ return $_[0] unless defined $_[0];
+
+ my $node_type = $_[0]->getNodeType;
+ return _reinterpret_cast('XML::Xerces::IDOM_Text', $_[0])
+ if $node_type == $XML::Xerces::IDOM_Node::TEXT_NODE;
+ return _reinterpret_cast('XML::Xerces::IDOM_ProcessingInstruction', $_[0])
+ if $node_type == $XML::Xerces::IDOM_Node::PROCESSING_INSTRUCTION_NODE;
+ return _reinterpret_cast('XML::Xerces::IDOM_Document', $_[0])
+ if $node_type == $XML::Xerces::IDOM_Node::DOCUMENT_NODE;
+ return _reinterpret_cast('XML::Xerces::IDOM_Element', $_[0])
+ if $node_type == $XML::Xerces::IDOM_Node::ELEMENT_NODE;
+ return _reinterpret_cast('XML::Xerces::IDOM_EntityReference', $_[0])
+ if $node_type == $XML::Xerces::IDOM_Node::ENTITY_REFERENCE_NODE;
+ return _reinterpret_cast('XML::Xerces::IDOM_CDATASection', $_[0])
+ if $node_type == $XML::Xerces::IDOM_Node::CDATA_SECTION_NODE;
+ return _reinterpret_cast('XML::Xerces::IDOM_Comment', $_[0])
+ if $node_type == $XML::Xerces::IDOM_Node::COMMENT_NODE;
+ return _reinterpret_cast('XML::Xerces::IDOM_DocumentType', $_[0])
+ if $node_type == $XML::Xerces::IDOM_Node::DOCUMENT_TYPE_NODE;
+ return _reinterpret_cast('XML::Xerces::IDOM_Entity', $_[0])
+ if $node_type == $XML::Xerces::IDOM_Node::ENTITY_NODE;
+ return _reinterpret_cast('XML::Xerces::IDOM_XMLDecl', $_[0])
+ if $node_type == $XML::Xerces::IDOM_Node::XML_DECL_NODE;
+
+ return $_[0];
+}
+
+
+sub quote_content {
+ my $node_value = $_[0];
+
+ $node_value =~ s/&/&/g;
+ $node_value =~ s/</</g;
+ $node_value =~ s/>/>/g;
+ $node_value =~ s/\"/"/g;
+ $node_value =~ s/\'/'/g;
+
+ return $node_value;
+}
+
{
- my $isa = sub {
- return 0 unless defined $_[0];
+ my $in_element = 0;
+ my $output;
+ my @output_array;
+
+ $output_array[$XML::Xerces::IDOM_Node::TEXT_NODE] = sub {
+ $output .= quote_content $_[0]->getNodeValue;
+ };
+
+ $output_array[$XML::Xerces::IDOM_Node::PROCESSING_INSTRUCTION_NODE] = sub {
+ $output .= '<?' . $_[0]->getNodeName;
+ if ( length(my $str = $_[0]->getNodeValue) ) { $output .= " $str"; }
+ $output .= '?>';
+ };
- my %package_hash = ($_[0] => 1);
- my @package_array = ($_[0]);
- my $base = $_[1];
+ $output_array[$XML::Xerces::IDOM_Node::DOCUMENT_NODE] = sub {
+ for(my $child = $_[0]->getFirstChild() ;
+ defined $child ;
+ $child = $child->getNextSibling())
+ {
+ $child = $child->actual_cast();
+ $output_array[$child->getNodeType]->($child);
+ }
+ };
- while(my $class = shift @package_array) {
- return 1 if "$class" eq "$base";
- foreach my $inherit (eval "\@$class\::ISA;") {
- unless ($package_hash{$inherit}) {
- $package_hash{$inherit} = 1;
- push @package_array, $inherit;
- }
+ $output_array[$XML::Xerces::IDOM_Node::ELEMENT_NODE] = sub {
+ ++$in_element;
+ ELEMENT: {
+ my $node_name = $_[0]->getNodeName;
+ $output .= "<$node_name";
+
+ my $attributes = $_[0]->getAttributes;
+ my $attribute_count = $attributes->getLength;
+
+ for(my $ix = 0 ; $ix < $attribute_count ; ++$ix) {
+ $attribute = $attributes->item($ix);
+ $output .= ' ' . $attribute->getNodeName . '="' . quote_content($attribute->getNodeValue) . '"';
}
+
+ my $child = $_[0]->getFirstChild();
+ if (!defined $child) {
+ $output .= '/>';
+ last ELEMENT;
+ }
+
+ $output .= '>';
+ while (defined $child) {
+ $child = $child->actual_cast();
+ $output_array[$child->getNodeType]->($child);
+ $child = $child->getNextSibling();
+ }
+ $output .= "</$node_name>";
}
- return 0;
+ --$in_element;
+ $output .= "\n" unless $in_element;
+ };
+
+ $output_array[$XML::Xerces::IDOM_Node::ENTITY_REFERENCE_NODE] = sub {
+ for(my $child = $_[0]->getFirstChild() ;
+ defined $child;
+ $child = $child->getNextSibling())
+ {
+ $child = $child->actual_cast();
+ $output_array[$child->getNodeType]->($child);
+ }
+ };
+
+ $output_array[$XML::Xerces::IDOM_Node::CDATA_SECTION_NODE] = sub {
+ $output .= '<![CDATA[' . $_[0]->getNodeValue . ']]>';
+ };
+
+ $output_array[$XML::Xerces::IDOM_Node::COMMENT_NODE] = sub {
+ $output .= '<!--' . $_[0]->getNodeValue . '-->';
+ $output .= "\n" unless $in_element;
};
+ $output_array[$XML::Xerces::IDOM_Node::DOCUMENT_TYPE_NODE] = sub {
+ $output .= '<!DOCTYPE ' . $_[0]->getNodeName;
+
+ my $id;
+ if ($id = $_[0]->getPublicId) {
+ $output .= qq[ PUBLIC "$id"];
+ if ($id = $_[0]->getSystemId) {
+ $output .= qq[ "$id"];
+ }
+ } elsif ($id = $_[0]->getSystemId) {
+ $output .= qq[ SYSTEM "$id"];
+ }
- my $reinterpret_cast = sub {
- return undef unless ref $_[1];
+ if ($id = $_[0]->getInternalSubset) {
+ $output .= " [$id]";
+ }
- bless $_[1], $_[0];
+ $output .= ">\n"
+ };
- my($raw_ref, $tied) = ($_[1] =~ m[=(.*)\(]);
+ $output_array[$XML::Xerces::IDOM_Node::ENTITY_NODE] = sub {
+ $output .= '<!ENTITY ' . $_[0]->getNodeName;
- if ($raw_ref eq 'SCALAR') { $tied = tied ${$_[1]}; }
- elsif ($raw_ref eq 'ARRAY') { $tied = tied @{$_[1]}; }
- elsif ($raw_ref eq 'HASH') { $tied = tied %{$_[1]}; }
+ my $id;
+ if ($id = $_[0]->getPublicId) { $output .= qq[ PUBLIC "$id"]; }
+ if ($id = $_[0]->getSystemId) { $output .= qq[ SYSTEM "$id"]; }
+ if ($id = $_[0]->getNotationName) { $output .= qq[ NDATA "$id"]; }
- return $_[1] unless $tied;
+ $output .= '>';
+ };
- bless $tied, $_[0];
- return $_[1];
+ $output_array[$XML::Xerces::IDOM_Node::XML_DECL_NODE] = sub {
+ $output .= '<?xml version="' . $_[0]->getVersion . '" encoding="' . $_[0]->getEncoding;
+ if (my $id = $_[0]->getStandalone) { $output .= qq[" standalone="$id]; }
+ $output .= "\"?>\n\n";
};
- sub actual_cast {
- return undef unless &$isa( ref($_[0]), 'XML::Xerces::DOM_Node' );
- return $_[0] if $_[0]->isNull;
+ sub serialize {
+ $output = '';
+ $output_array[ $_[0]->getNodeType ]->($_[0]);
+ $output;
+ }
+}
- my $node_type = $_[0]->getNodeType;
- return &$reinterpret_cast('XML::Xerces::DOM_Text', $_[0]) if $node_type == $XML::Xerces::DOM_Node::TEXT_NODE;
- return &$reinterpret_cast('XML::Xerces::DOM_ProcessingInstruction', $_[0]) if $node_type == $XML::Xerces::DOM_Node::PROCESSING_INSTRUCTION_NODE;
- return &$reinterpret_cast('XML::Xerces::DOM_Document', $_[0]) if $node_type == $XML::Xerces::DOM_Node::DOCUMENT_NODE;
- return &$reinterpret_cast('XML::Xerces::DOM_Element', $_[0]) if $node_type == $XML::Xerces::DOM_Node::ELEMENT_NODE;
- return &$reinterpret_cast('XML::Xerces::DOM_EntityReference', $_[0]) if $node_type == $XML::Xerces::DOM_Node::ENTITY_REFERENCE_NODE;
- return &$reinterpret_cast('XML::Xerces::DOM_CDATASection', $_[0]) if $node_type == $XML::Xerces::DOM_Node::CDATA_SECTION_NODE;
- return &$reinterpret_cast('XML::Xerces::DOM_Comment', $_[0]) if $node_type == $XML::Xerces::DOM_Node::COMMENT_NODE;
- return &$reinterpret_cast('XML::Xerces::DOM_DocumentType', $_[0]) if $node_type == $XML::Xerces::DOM_Node::DOCUMENT_TYPE_NODE;
- return &$reinterpret_cast('XML::Xerces::DOM_Entity', $_[0]) if $node_type == $XML::Xerces::DOM_Node::ENTITY_NODE;
- return &$reinterpret_cast('XML::Xerces::DOM_XMLDecl', $_[0]) if $node_type == $XML::Xerces::DOM_Node::XML_DECL_NODE;
+package XML::Xerces::DOM_Node;
- return $_[0];
+sub _isa {
+ return 0 unless defined $_[0];
+
+ my %package_hash = ($_[0] => 1);
+ my @package_array = ($_[0]);
+ my $base = $_[1];
+
+ while(my $class = shift @package_array) {
+ return 1 if "$class" eq "$base";
+ foreach my $inherit (eval "\@$class\::ISA;") {
+ unless ($package_hash{$inherit}) {
+ $package_hash{$inherit} = 1;
+ push @package_array, $inherit;
+ }
+ }
}
+ return 0;
+};
+
+
+sub _reinterpret_cast {
+ return undef unless ref $_[1];
+
+ bless $_[1], $_[0];
+
+ my($raw_ref, $tied) = ($_[1] =~ m[=(.*)\(]);
+
+ if ($raw_ref eq 'SCALAR') { $tied = tied ${$_[1]}; }
+ elsif ($raw_ref eq 'ARRAY') { $tied = tied @{$_[1]}; }
+ elsif ($raw_ref eq 'HASH') { $tied = tied %{$_[1]}; }
+
+ return $_[1] unless $tied;
+
+ bless $tied, $_[0];
+ return $_[1];
+};
+
+sub actual_cast {
+ return undef unless _isa( ref($_[0]), 'XML::Xerces::DOM_Node' );
+ return $_[0] if $_[0]->isNull;
+
+ my $node_type = $_[0]->getNodeType;
+ return _reinterpret_cast('XML::Xerces::DOM_Text', $_[0])
+ if $node_type == $XML::Xerces::DOM_Node::TEXT_NODE;
+ return _reinterpret_cast('XML::Xerces::DOM_ProcessingInstruction', $_[0])
+ if $node_type == $XML::Xerces::DOM_Node::PROCESSING_INSTRUCTION_NODE;
+ return _reinterpret_cast('XML::Xerces::DOM_Document', $_[0])
+ if $node_type == $XML::Xerces::DOM_Node::DOCUMENT_NODE;
+ return _reinterpret_cast('XML::Xerces::DOM_Element', $_[0])
+ if $node_type == $XML::Xerces::DOM_Node::ELEMENT_NODE;
+ return _reinterpret_cast('XML::Xerces::DOM_EntityReference', $_[0])
+ if $node_type == $XML::Xerces::DOM_Node::ENTITY_REFERENCE_NODE;
+ return _reinterpret_cast('XML::Xerces::DOM_CDATASection', $_[0])
+ if $node_type == $XML::Xerces::DOM_Node::CDATA_SECTION_NODE;
+ return _reinterpret_cast('XML::Xerces::DOM_Comment', $_[0])
+ if $node_type == $XML::Xerces::DOM_Node::COMMENT_NODE;
+ return _reinterpret_cast('XML::Xerces::DOM_DocumentType', $_[0])
+ if $node_type == $XML::Xerces::DOM_Node::DOCUMENT_TYPE_NODE;
+ return _reinterpret_cast('XML::Xerces::DOM_Entity', $_[0])
+ if $node_type == $XML::Xerces::DOM_Node::ENTITY_NODE;
+ return _reinterpret_cast('XML::Xerces::DOM_XMLDecl', $_[0])
+ if $node_type == $XML::Xerces::DOM_Node::XML_DECL_NODE;
+
+ return $_[0];
}
@@ -486,8 +791,8 @@
$node_value =~ s/&/&/g;
$node_value =~ s/</</g;
$node_value =~ s/>/>/g;
- $node_value =~ s/"/"/g;
- $node_value =~ s/'/'/g;
+ $node_value =~ s/\"/"/g;
+ $node_value =~ s/\'/'/g;
return $node_value;
}
@@ -599,7 +904,7 @@
sub serialize {
$output = '';
- &{$output_array[ $_[0]->getNodeType ]}($_[0]);
+ $output_array[ $_[0]->getNodeType ]->($_[0]);
$output;
}
}
@@ -618,5 +923,48 @@
rename "$progname.$num.tmp", $file;
}
+
+sub remove_method {
+ my ($in_fh,$out_fh) = @_;
+ skip_to_closing_brace(@_,0);
+}
+
+sub skip_to_closing_brace {
+ my ($in_fh,$out_fh,$print) = @_;
+ $print = 0 unless defined $print;
+ my $braces = 1;
+ while ($braces && ! eof($in_fh)) {
+ $_ = <$in_fh>;
+ $braces-- if /\}/;
+ $braces++ if /\{/;
+ if ($print) {
+ substitute_line($_);
+ print TEMP;
+ }
+ }
+ if ($braces) {
+ print STDERR "skip_to_closing_brace exited with positive brace count";
+ }
+}
+
+sub fix_method {
+ my ($in_fh,$out_fh,$match,$subst) = @_;
+ my $braces = 1;
+ print TEMP;
+ while ($braces && ! eof($in_fh)) {
+ $_ = <$in_fh>;
+ $braces-- if /\}/;
+ $braces++ if /\{/;
+# substitute_line($_);
+ if (/$match/) {
+ s/^.*\n/$subst\n/;
+ }
+ print TEMP;
+ }
+ if ($braces) {
+ print STDERR "fix_method exited with positive brace count";
+ }
+}
+
---------------------------------------------------------------------
To unsubscribe, e-mail: xerces-cvs-unsubscribe@xml.apache.org
For additional commands, e-mail: xerces-cvs-help@xml.apache.org