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/09/06 06:45:53 UTC
cvs commit: xml-xerces/perl postModule.pl
jasons 01/09/05 21:45:53
Modified: perl postModule.pl
Log:
* postModule.pl (Repository):
SWIG tried to be very terse, but in 5.6.0 the following invokes
auto-vivification on $args[0]:
$args[0] = tied(%{$args[0]}) || $args[0];
made DOM_Element::setAttribute() check for null attributes and
values
Added IDOMParser overloads on parse(), parseFirst()
Added back DESTROY for Parser subclasses
changed set*Handler() methods to use a per object cache of the
handler objects instead of the ridiculous class variable
approach I was using.
added Attributes::to_hash()
Revision Changes Path
1.17 +112 -49 xml-xerces/perl/postModule.pl
Index: postModule.pl
===================================================================
RCS file: /home/cvs/xml-xerces/perl/postModule.pl,v
retrieving revision 1.16
retrieving revision 1.17
diff -u -r1.16 -r1.17
--- postModule.pl 2001/08/02 02:46:42 1.16
+++ postModule.pl 2001/09/06 04:45:53 1.17
@@ -158,7 +158,7 @@
# CHANGE "$args[0] = tied(%{$args[0]})"
# TO "$args[0] = tied(%{$args[0]}) || $args[0]"
# split on multiple lines to be readable, using s{}{}x
- s{
+ s{
(\$args\[(\d+)\])\s*=\s*tied\(\%\{\$args\[\2\]\}\)
}{$& || $1}x;
@@ -174,16 +174,27 @@
# MUNG NAMESPACE to XML::Xerces
#
# 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/;
+ 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"/;
- # 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"/;
+ # bad SWIG
+
+ if (m/\$args\[0\]\s+=\s+tied\(\%\{\$args\[0\]\}\)\s+\|\|\s+\$args\[0\];/){
+ print TEMP <<'EOT';
+ if (defined $args[0]) {
+ $args[0] = tied(%{$args[0]}) || $args[0];
+ }
+EOT
+ next;
+ }
#######################################################################
#
@@ -279,28 +290,47 @@
# Method Overloads
- if ($CURR_CLASS eq 'DOMParser') {
- next if /__overload__/;
- if (/XML::Xercesc::DOMParser_parse;/) {
+ if ($CURR_CLASS eq 'DOM_Element') {
+ if (/XML::Xercesc::DOM_Element_setAttribute;/) {
print TEMP <<'EOT';
+sub setAttribute {
+ my ($self,$attr,$val) = @_;
+ return unless defined $attr and defined $val;
+ my $result = XML::Xercesc::DOM_Element_setAttribute(@_);
+ return $result unless ref($result) =~ m[XML::Xerces];
+ $XML::Xerces::DOM_Attr::OWNER{$result} = 1;
+ my %resulthash;
+ tie %resulthash, ref($result), $result;
+ return bless \%resulthash, ref($result);
+}
+EOT
+ next;
+ }
+ }
+
+ if ($CURR_CLASS =~ /(I?DOM)Parser/) {
+ my $dom = $1;
+ next if /__overload__/;
+ if (/XML::Xercesc::${dom}Parser_parse;/) {
+ print TEMP <<"EOT";
sub parse {
- my @args = @_;
- if (ref $args[1]) {
- XML::Xercesc::DOMParser_parse(@args);
+ my \@args = \@_;
+ if (ref \$args[1]) {
+ XML::Xercesc::${dom}Parser_parse(\@args);
} else {
- XML::Xercesc::DOMParser_parse__overload__1(@args);
+ XML::Xercesc::${dom}Parser_parse__overload__1(\@args);
}
}
EOT
next;
- } elsif (/XML::Xercesc::DOMParser_parseFirst/) {
- print TEMP <<'EOT';
+ } elsif (/XML::Xercesc::${dom}Parser_parseFirst/) {
+ print TEMP <<"EOT";
sub parseFirst {
- my @args = @_;
- if (ref $args[1]) {
- XML::Xercesc::DOMParser_parseFirst(@args);
+ my \@args = \@_;
+ if (ref \$args[1]) {
+ XML::Xercesc::${dom}Parser_parseFirst(\@args);
} else {
- XML::Xercesc::DOMParser_parseFirst__overload__1(@args);
+ XML::Xercesc::${dom}Parser_parseFirst__overload__1(\@args);
}
}
EOT
@@ -359,40 +389,61 @@
if (/\*XML::Xercesc::(\w+)_setErrorHandler/) {
my $class = $1;
print TEMP <<"EOT";
-use vars qw(\$__ERROR_HANDLER);
sub setErrorHandler {
my (\$self,\$handler) = \@_;
my \$callback = XML::Xerces::PerlErrorCallbackHandler->new();
\$callback->set_callback_obj(\$handler);
XML::Xercesc::$ {class}_setErrorHandler(\$self,\$callback);
- \$__ERROR_HANDLER = \$callback;
+ \$self{__ERROR_HANDLER} = \$callback;
}
EOT
- if ($class =~ /I?DOMParser/) {
+ if ($class =~ /IDOMParser/) {
print TEMP <<'EOT';
-# SWIG gets horribly upset if we don't decrement these refcounts
sub DESTROY {
- undef $__ERROR_HANDLER;
- undef $__ENTITY_RESOLVER;
+ return unless $_[0]->isa('HASH');
+ my $self = tied(%{$_[0]});
+ delete $ITERATORS{$self};
+ if (exists $OWNER{$self}) {
+ XML::Xercesc::delete_IDOMParser($self);
+ delete $OWNER{$self};
+ }
}
EOT
+ } elsif ($class eq 'DOMParser') {
+ print TEMP <<'EOT';
+sub DESTROY {
+ return unless $_[0]->isa('HASH');
+ my $self = tied(%{$_[0]});
+ delete $ITERATORS{$self};
+ if (exists $OWNER{$self}) {
+ XML::Xercesc::delete_DOMParser($self);
+ delete $OWNER{$self};
+ }
+}
+EOT
} elsif ($class eq 'SAXParser') {
print TEMP <<'EOT';
-# SWIG gets horribly upset if we don't decrement these refcounts
sub DESTROY {
- undef $__DOCUMENT_HANDLER;
- undef $__ERROR_HANDLER;
- undef $__ENTITY_RESOLVER;
+ return unless $_[0]->isa('HASH');
+ my $self = tied(%{$_[0]});
+ delete $ITERATORS{$self};
+ if (exists $OWNER{$self}) {
+ XML::Xercesc::delete_SAXParser($self);
+ delete $OWNER{$self};
+ }
}
EOT
} elsif ($class eq 'SAX2XMLReader') {
print TEMP <<'EOT';
-# SWIG gets horribly upset if we don't decrement these refcounts
sub DESTROY {
- undef $__CONTENT_HANDLER;
- undef $__ERROR_HANDLER;
- undef $__ENTITY_RESOLVER;
+ return unless $_[0]->isa('HASH');
+ my $self = tied(%{$_[0]});
+ delete $ITERATORS{$self};
+ if (exists $OWNER{$self}) {
+ XML::Xercesc::delete_SAX2XMLReader($self);
+ delete $OWNER{$self};
+ }
}
EOT
} else {
@@ -407,13 +458,12 @@
if (/\*XML::Xercesc::(\w+)_setEntityResolver/) {
my $class = $1;
print TEMP <<"EOT";
-use vars qw(\$__ENTITY_RESOLVER);
sub setEntityResolver {
my (\$self,\$handler) = \@_;
my \$callback = XML::Xerces::PerlEntityResolverHandler->new();
\$callback->set_callback_obj(\$handler);
XML::Xercesc::$ {class}_setEntityResolver(\$self,\$callback);
- \$__ENTITY_RESOLVER = \$callback;
+ \$self{__ENTITY_RESOLVER} = \$callback;
}
EOT
# we don't print out the function
@@ -422,13 +472,12 @@
# look for: *setDocumentHandler = *XML::Xercesc::SAXParser_setDocumentHandler;
if (/SAXParser_setDocumentHandler/) {
print TEMP <<'EOT';
-use vars qw($__DOCUMENT_HANDLER);
sub setDocumentHandler {
my ($self,$handler) = @_;
my $callback = XML::Xerces::PerlDocumentCallbackHandler->new();
$callback->set_callback_obj($handler);
XML::Xercesc::SAXParser_setDocumentHandler($self,$callback);
- $__DOCUMENT_HANDLER = $callback;
+ $self{__DOCUMENT_HANDLER} = $callback;
}
EOT
# we don't print out the function
@@ -438,14 +487,13 @@
# look for: *setContentHandler = *XML::Xercesc::SAX2XMLReader_setContentHandler;
if (/SAX2XMLReader_setContentHandler/) {
print TEMP <<'EOT';
-use vars qw($__CONTENT_HANDLER);
sub setContentHandler {
my ($self,$handler) = @_;
my $callback = XML::Xerces::PerlContentCallbackHandler->new();
$callback->set_callback_obj($handler);
XML::Xercesc::SAX2XMLReader_setContentHandler($self,$callback);
# maintain an internal reference
- $__CONTENT_HANDLER = $callback;
+ $self{__CONTENT_HANDLER} = $callback;
}
EOT
# we don't print out the function
@@ -454,10 +502,8 @@
print TEMP;
}
-
- close FILE;
- print TEMP <<\TERMINUS;
+my $extra = <<'EOT';
############# Class : XML::Xerces::PerlContentHandler ##############
package XML::Xerces::PerlContentHandler;
@ISA = qw();
@@ -584,6 +630,21 @@
}
}
+package XML::Xerces::Attributes;
+sub to_hash {
+ my $self = shift;
+ my %hash;
+ for (my $i; $i < $self->getLength(); $i++) {
+ my $qname = $self->getQName($i);
+ $hash{$qname}->{localName} = $self->getLocalName($i);
+# getURI is broken
+# $hash{$qname}->{URI} = $self->getURI($i);
+ $hash{$qname}->{value} = $self->getValue($i);
+ $hash{$qname}->{type} = $self->getType($i);
+ }
+ return %hash;
+}
+
package XML::Xerces::IDOM_Entity;
sub to_hash {
my $self = shift;
@@ -1033,6 +1094,7 @@
}
}
+package XML::Xerces;
#
# NOTICE: We are automatically calling XMLPlatformUtils::Initialize()
# when the module is loaded. Do not call it on your own.
@@ -1041,9 +1103,10 @@
XML::Xerces::XMLPlatformUtils::Initialize();
1;
-TERMINUS
-
- close TEMP;
+EOT
+ close(FILE);
+ print TEMP $extra;
+ close(TEMP);
rename "$progname.$num.tmp", $file;
}
---------------------------------------------------------------------
To unsubscribe, e-mail: xerces-cvs-unsubscribe@xml.apache.org
For additional commands, e-mail: xerces-cvs-help@xml.apache.org