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 2005/12/03 16:43:15 UTC
svn commit: r351959 - in /xerces/xerces-p/trunk: postModule.pl postSource.pl
Author: jasons
Date: Sat Dec 3 07:43:06 2005
New Revision: 351959
URL: http://svn.apache.org/viewcvs?rev=351959&view=rev
Log:
these now only add the license at the top of the files
Modified:
xerces/xerces-p/trunk/postModule.pl
xerces/xerces-p/trunk/postSource.pl
Modified: xerces/xerces-p/trunk/postModule.pl
URL: http://svn.apache.org/viewcvs/xerces/xerces-p/trunk/postModule.pl?rev=351959&r1=351958&r2=351959&view=diff
==============================================================================
--- xerces/xerces-p/trunk/postModule.pl (original)
+++ xerces/xerces-p/trunk/postModule.pl Sat Dec 3 07:43:06 2005
@@ -1,460 +1,101 @@
-#!/usr/bin/perl
+#!/usr/bin/perl -w
+
use lib '.';
use strict;
use SWIG qw(remove_method skip_to_closing_brace fix_method);
+use File::Temp qw/tempfile/;
+use File::Copy;
-my($progname) = $0 =~ m"\/([^/]*)";
-
-my @domnode_list_methods = qw(DOMDocument::getElementsByTagName
- DOMDocument::getElementsByTagNameNS
- DOMElement::getElementsByTagName
- DOMElement::getElementsByTagNameNS
- DOMNode::getChildNodes
- );
-
-my @domnode_map_methods = qw(DOMDocumentType::getEntities
- DOMDocumentType::getNotations
- DOMNode::getAttributes
- );
-
-my @domcopy_methods = qw(DOMXMLDecl
- DOMAttr
- );
-
-my %VARS;
-
-my $num = 0;
-++$num while -e "$progname.$num.tmp";
-
-for my $file (@ARGV) {
- next unless open FILE, $file;
-
- open TEMP, ">$progname.$num.tmp";
-
- my $CURR_CLASS = '';
- while(<FILE>) {
-
- if (/^package/) {
- ($CURR_CLASS) = m/package\s+XML::Xerces::([\w_]+);/;
- print TEMP;
- next;
- }
-
- # 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/) {
- while (<FILE>) {
- next unless /\#\#\#\#\#\#\#\#\#\#\#\#\#/;
- last;
- }
- }
-
- # we're only keeping DESTROY for the parsers until we know better
- # we get core dumps if it's defined on some classes
- if (/sub DESTROY/) {
- unless (grep {$_ eq $CURR_CLASS} qw(XercesDOMParser
- SAXParser
- SAX2XMLReader))
- {
- remove_method(\*FILE);
- } else {
- fix_method(\*FILE,
- \*TEMP,
- qr/my \$self = tied\(\%\{\$_\[0\]\}\);/,
- " return unless defined \$self;\n",
- 1);
- }
- if ($CURR_CLASS eq 'DOMDocument') {
- print TEMP <<'EOT';
-sub DESTROY {
- my $self = shift;
- # we remove an reference to the Parser that created us
- if (exists $OWNER{$self}->{__PARSER}) {
- undef $OWNER{$self}->{__PARSER};
- }
-}
-EOT
- }
- next;
- }
-
- # we remove all the enums inherited through DOMNode
- next if /^*[_A-Z]+_NODE =/ && !/DOMNode/;
-
- # now we set these aliases correctly
- s/\*XML::Xerces::/*XML::Xercesc::/;
-
- #######################################################################
- #
- # MUNG MODULE for XMLCh support
- #
- # CHANGE "$args[0] = tied(%{$args[0]})"
- # TO "$args[0] = tied(%{$args[0]}) || $args[0]"
- # then we wrap it in a defined $args[0] to remove the irritating warning
- if (m{\$args\[0\]\s+=\s+tied\(\%\{\$args\[0\]\}\)}) {
- print TEMP <<'EOT';
- if (defined $args[0]) {
- $args[0] = tied(%{$args[0]}) || $args[0];
- }
-EOT
- next;
- }
-
-
- # CHANGE "return undef if (!defined($result))"
- # TO "return $result unless ref($result) =~ m[XML::Xerces]"
- # split on multiple lines to be readable, using s{}{}x
- s{
- return\s*undef\s*if\s*\(\!defined\(\$result\)\)
- }{return \$result unless UNIVERSAL::isa(\$result,'XML::Xerces')}x;
-
- #######################################################################
- #
- # Perl API specific changes
- #
-
- # DOMNodeList: automatically convert to perl list
- # if called in a list context
- if (grep {/$CURR_CLASS/} @domnode_list_methods) {
- my $CLASS = "XML::Xercesc::$CURR_CLASS";
- if (my ($sub) = /^*(\w+)/) {
- my $full_sub = "$ {CURR_CLASS}::$sub";
- if (grep {/$full_sub$/} @domnode_list_methods) {
- print TEMP <<"EOT";
-sub $sub {
- my \$result = $ {CLASS}_$sub(\@_);
- unless (defined \$result) {
- return () if wantarray;
- return undef; # if *not* wantarray
- }
- return \$result->to_list() if wantarray;
- return \$result; # if *not* wantarray
-}
-EOT
- next;
- }
- }
- }
-
- # DOMNamedNodeMap: automatically convert to perl hash
- # if called in a list context
- if (grep {/$CURR_CLASS/} @domnode_map_methods) {
- my $CLASS = "XML::Xercesc::$CURR_CLASS";
- if (my ($sub) = /^*(\w+)/) {
- my $full_sub = "$ {CURR_CLASS}::$sub";
- if (grep {/$full_sub$/} @domnode_map_methods) {
- print TEMP <<"EOT";
-sub $sub {
- my \$result = $ {CLASS}_$sub(\@_);
- unless (defined \$result) {
- return () if wantarray;
- return undef; # if *not* wantarray
- }
- return \$result->to_hash() if wantarray;
- return \$result; # if *not* wantarray
-}
-EOT
- next;
- }
- }
- }
-
- # MemBufInputSource: new has *optional* SYSTEM ID
- if ($CURR_CLASS eq 'MemBufInputSource') {
- if (/^sub\s+new/) {
- my $fix = <<'EOT';
- # SYSTEM ID is *optional*
- if (scalar @_ == 1) {
- push(@_,'FAKE_SYSTEM_ID');
- }
-EOT
- fix_method(\*FILE,
- \*TEMP,
- qr/my \$pkg/,
- $fix,
- 1);
- next;
- }
- }
-
-
- # handle SWIG bug
- if ($CURR_CLASS eq 'DOMNode') {
- if (/^\*([a-z]\w+)/) {
- print TEMP <<"EOT";
-sub $1 {
- my \@args = \@_;
- if (\$args[0]->isa('XML::Xerces::DOMDocument')) {
- \$args[0] = \$args[0]->toDOMNode();
- }
- return XML::Xercesc::DOMNode_$1(\@args);
-}
-EOT
- next;
- }
- if (/^sub\s+[a-z]/) {
- my $fix = <<'EOT';
- if ($args[0]->isa('XML::Xerces::DOMDocument')) {
- $args[0] = $args[0]->toDOMNode();
- }
-EOT
- fix_method(\*FILE,
- \*TEMP,
- qr/my \@args/,
- $fix,
- 1);
- next;
- }
- }
-
- if ($CURR_CLASS eq 'DOMWriter') {
- if (/^\*writeNode/) {
- print TEMP <<'EOT';
-sub writeNode {
- my @args = @_;
- if ($args[2]->isa('XML::Xerces::DOMDocument')) {
- $args[2] = $args[2]->toDOMNode();
- }
- return XML::Xercesc::DOMWriter_writeNode(@args);
-}
-EOT
- next;
- }
- if (/^\*writeToString/) {
- print TEMP <<'EOT';
-sub writeToString {
- my @args = @_;
- if ($args[1]->isa('XML::Xerces::DOMDocument')) {
- $args[1] = $args[1]->toDOMNode();
- }
- return XML::Xercesc::DOMWriter_writeToString(@args);
-}
-EOT
- next;
- }
- }
+my $INFILE = "Xerces-tmp.pm";
+my $OUTFILE = "Xerces.pm";
- # we need to fix setAttribute() so that undefined values don't
- # cause a core dump
- if ($CURR_CLASS =~ /DOMElement/) {
- if (/XML::Xercesc::DOMElement_setAttribute;/) {
- print TEMP <<"EOT";
-sub setAttribute {
- my (\$self,\$attr,\$val) = \@_;
- return unless defined \$attr and defined \$val;
- my \$result = XML::Xercesc::DOMElement_setAttribute(\@_);
- return \$result unless ref(\$result) =~ m[XML::Xerces];
- \$XML::Xerces::DOMAttr::OWNER{\$result} = 1;
- return \$result;
-}
-EOT
- next;
- }
- }
+open(FILE, $INFILE)
+ or die "Couldn't open $INFILE for reading";
- if ($CURR_CLASS =~ /DOMDOMException/) {
- if (/^sub\s+new/) {
- # add the reverse name lookup for the error codes
- print TEMP <<'EOT';
-use vars qw(@CODES $INDEX_SIZE_ERR
- $DOMSTRING_SIZE_ERR
- $HIERARCHY_REQUEST_ERR
- $WRONG_DOCUMENT_ERR
- $INVALID_CHARACTER_ERR
- $NO_DATA_ALLOWED_ERR
- $NO_MODIFICATION_ALLOWED_ERR
- $NOT_FOUND_ERR
- $NOT_SUPPORTED_ERR
- $INUSE_ATTRIBUTE_ERR
- $INVALID_STATE_ERR
- $SYNTAX_ERR
- $INVALID_MODIFICATION_ERR
- $NAMESPACE_ERR
- $INVALID_ACCESS_ERR);
-
-$CODES[$INDEX_SIZE_ERR] = 'INDEX_SIZE_ERR';
-$CODES[$DOMSTRING_SIZE_ERR] = 'DOMSTRING_SIZE_ERR';
-$CODES[$HIERARCHY_REQUEST_ERR] = 'HIERARCHY_REQUEST_ERR';
-$CODES[$WRONG_DOCUMENT_ERR] = 'WRONG_DOCUMENT_ERR';
-$CODES[$INVALID_CHARACTER_ERR] = 'INVALID_CHARACTER_ERR';
-$CODES[$NO_DATA_ALLOWED_ERR] = 'NO_DATA_ALLOWED_ERR';
-$CODES[$NO_MODIFICATION_ALLOWED_ERR] = 'NO_MODIFICATION_ALLOWED_ERR';
-$CODES[$NOT_FOUND_ERR] = 'NOT_FOUND_ERR';
-$CODES[$NOT_SUPPORTED_ERR] = 'NOT_SUPPORTED_ERR';
-$CODES[$INUSE_ATTRIBUTE_ERR] = 'INUSE_ATTRIBUTE_ERR';
-$CODES[$INVALID_STATE_ERR] = 'INVALID_STATE_ERR';
-$CODES[$SYNTAX_ERR] = 'SYNTAX_ERR';
-$CODES[$INVALID_MODIFICATION_ERR] = 'INVALID_MODIFICATION_ERR';
-$CODES[$NAMESPACE_ERR] = 'NAMESPACE_ERR';
-$CODES[$INVALID_ACCESS_ERR] = 'INVALID_ACCESS_ERR';
-EOT
- }
+my ($temp_fh, $temp_filename) = tempfile();
+
+#
+# Put the apache license in the output file
+#
+
+my $LICENSE = <<LICENSE;
+ #
+ # Copyright 2002,2004 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.
+ #
+
+LICENSE
+
+print $temp_fh $LICENSE;
+
+my $CURR_CLASS = '';
+while ($_ = <FILE>) {
+
+ if (/^package/) {
+ if (m/package\s+XML::Xerces::(\w+);/) {
+ ($CURR_CLASS) = $1;
}
-
- ######################################################################
- #
- # Callback registration
-
- # fix a scoping bug for setErrorHandler. If we don't maintain an
- # internal reference to the error handler perl object it will
- # get destroyed if it goes out of scope. Then if an error occurs
- # perl will dump core
-
- # look for: *setErrorHandler = *XML::Xercesc::*_setErrorHandler;
- if (/\*XML::Xercesc::(\w+)_setErrorHandler/) {
- my $class = $1;
- print TEMP <<"EOT";
-sub setErrorHandler {
- my (\$self,\$handler) = \@_;
- my \$retval;
- my \$callback = \$XML::Xerces::$ {class}::OWNER{\$self}->{__ERROR_HANDLER};
-# if (defined \$callback) {
- if (0) {
- \$retval = \$callback->set_callback_obj(\$handler);
- } else {
- \$callback = XML::Xerces::PerlErrorCallbackHandler->new(\$handler);
- \$XML::Xerces::$ {class}::OWNER{\$self}->{__ERROR_HANDLER} = \$callback;
+ print $temp_fh $_;
+ next;
}
- XML::Xercesc::$ {class}_setErrorHandler(\$self,\$callback);
- return \$retval;
-}
-EOT
- # we don't print out the function
- next;
- }
- # this same bug is likely to affect setEntityResolver() as well
- # look for: *setEntityResolver = *XML::Xercesc::*_setEntityResolver;
- if (/\*XML::Xercesc::(\w+)_setEntityResolver/) {
- my $class = $1;
- print TEMP <<"EOT";
-sub setEntityResolver {
- my (\$self,\$handler) = \@_;
- my \$callback = \$XML::Xerces::$ {class}::OWNER{\$self}->{__ENTITY_RESOLVER};
-# if (defined \$callback) {
- if (0) {
- \$callback->set_callback_obj(\$handler);
- } else {
- \$callback = XML::Xerces::PerlEntityResolverHandler->new(\$handler);
- \$XML::Xerces::$ {class}::OWNER{\$self}->{__ENTITY_RESOLVER} = \$callback;
- }
- return XML::Xercesc::$ {class}_setEntityResolver(\$self,\$callback);
+# # 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/) {
+# while ($_ = <FILE>) {
+# next unless /\#\#\#\#\#\#\#\#\#\#\#\#\#/;
+# last;
+# }
+# }
+#
+# # we remove all the enums inherited through DOMNode
+# next if /^\*[_A-Z]+_NODE =/ && !/DOMNode/;
+#
+# # now we set these aliases correctly
+# s/\*XML::Xerces::/*XML::Xercesc::/;
+
+ #######################################################################
+ #
+ # MUNGE MODULE for XMLCh support
+ #
+ # CHANGE "$args[0] = tied(%{$args[0]})"
+ # TO "$args[0] = tied(%{$args[0]}) || $args[0]"
+ # then we wrap it in a defined $args[0] to remove the irritating warning
+# if (m{\$args\[0\]\s+=\s+tied\(\%\{\$args\[0\]\}\)}) {
+# print $temp_fh <<'EOT';
+# if (defined $args[0]) {
+# $args[0] = tied(%{$args[0]}) || $args[0];
+# }
+# EOT
+# next;
+# }
+
+
+ # CHANGE "return undef if (!defined($result))"
+ # TO "return $result unless ref($result) =~ m[XML::Xerces]"
+ # split on multiple lines to be readable, using s{}{}x
+# s{
+# return\s*undef\s*if\s*\(\!defined\(\$result\)\)
+# }{return \$result unless UNIVERSAL::isa(\$result,'XML::Xerces')}x;
+
+ print $temp_fh $_;
}
-EOT
- # we don't print out the function
- next;
- }
- # look for: *setDocumentHandler = *XML::Xercesc::SAXParser_setDocumentHandler;
- if (/SAXParser_setDocumentHandler/) {
- print TEMP <<'EOT';
-sub setDocumentHandler {
- my ($self,$handler) = @_;
- my $callback = $XML::Xerces::SAXParser::OWNER{$self}->{__DOCUMENT_HANDLER};
-# if (defined \$callback) {
- if (0) {
- $callback->set_callback_obj($handler);
- } else {
- $callback = XML::Xerces::PerlDocumentCallbackHandler->new($handler);
- $XML::Xerces::SAXParser::OWNER{$self}->{__DOCUMENT_HANDLER} = $callback;
- }
- return XML::Xercesc::SAXParser_setDocumentHandler($self,$callback);
-}
-EOT
- # we don't print out the function
- next;
- }
- # this same bug is likely to affect setContentHandler() as well
- # look for: *setContentHandler = *XML::Xercesc::SAX2XMLReader_setContentHandler;
- if (/SAX2XMLReader_setContentHandler/) {
- print TEMP <<'EOT';
-sub setContentHandler {
- my ($self,$handler) = @_;
- my $callback = $XML::Xerces::SAX2XMLReader::OWNER{$self}->{__CONTENT_HANDLER};
-# if (defined \$callback) {
- if (0) {
- $callback->set_callback_obj($handler);
- } else {
- $callback = XML::Xerces::PerlContentCallbackHandler->new($handler);
- $XML::Xerces::SAX2XMLReader::OWNER{$self}->{__CONTENT_HANDLER} = $callback;
- }
- return XML::Xercesc::SAX2XMLReader_setContentHandler($self,$callback);
-}
-EOT
- # we don't print out the function
- next;
- }
-
- if ($CURR_CLASS eq 'DOMDocumentTraversal') {
- if (/^*createTreeWalker/) {
- print TEMP <<'EOT';
-sub createTreeWalker {
- my ($self,$root,$what,$filter,$expand) = @_;
- my $callback = $XML::Xerces::DOMTreeWalker::OWNER{$self}->{__NODE_FILTER};
-# if (defined \$callback) {
- if (0) {
- $callback->set_callback_obj($filter);
- } else {
- $callback = XML::Xerces::PerlNodeFilterCallbackHandler->new($filter);
- $XML::Xerces::DOMTreeWalker::OWNER{$self}->{__NODE_FILTER} = $callback;
- }
- my @args = ($self,$root,$what,$callback,$expand);
- if ($args[0]->isa('XML::Xerces::DOMDocument')) {
- $args[0] = $args[0]->toDOMDocumentTraversal();
- }
- return XML::Xercesc::DOMDocumentTraversal_createTreeWalker(@args);
-}
-EOT
- next;
- }
- }
-
- if ($CURR_CLASS eq 'DOMDocumentTraversal') {
- if (/^*createNodeIterator/) {
- print TEMP <<'EOT';
-sub createNodeIterator {
- my ($self,$root,$what,$filter,$expand) = @_;
- my $callback = $XML::Xerces::DOMNodeIterator::OWNER{$self}->{__NODE_FILTER};
-# if (defined \$callback) {
- if (0) {
- $callback->set_callback_obj($filter);
- } else {
- $callback = XML::Xerces::PerlNodeFilterCallbackHandler->new($filter);
- $XML::Xerces::DOMNodeIterator::OWNER{$self}->{__NODE_FILTER} = $callback;
- }
- my @args = ($self,$root,$what,$callback,$expand);
- if ($args[0]->isa('XML::Xerces::DOMDocument')) {
- $args[0] = $args[0]->toDOMDocumentTraversal();
- }
- return XML::Xercesc::DOMDocumentTraversal_createNodeIterator(@args);
-}
-EOT
- next;
- }
- }
+close(FILE);
+close($temp_fh);
- # fix the issue that deleting a parser deletes the document
- if (/\*XML::Xercesc::AbstractDOMParser_getDocument/) {
- print TEMP <<'EOT';
-# hold a reference to the parser internally, so that the
-# document can exist after the parser has gone out of scope
-sub getDocument {
- my ($self) = @_;
- my $result = XML::Xercesc::AbstractDOMParser_getDocument($self);
- $XML::Xerces::DOMDocument::OWNER{$result}->{__PARSER} = $self;
- return $result;
-}
-EOT
- # we don't print out the function
- next;
- }
-
- print TEMP;
- }
- close(FILE);
- close(TEMP);
-
- rename "$progname.$num.tmp", $file;
-}
+copy($temp_filename, $OUTFILE);
+END {unlink($temp_filename)}
Modified: xerces/xerces-p/trunk/postSource.pl
URL: http://svn.apache.org/viewcvs/xerces/xerces-p/trunk/postSource.pl?rev=351959&r1=351958&r2=351959&view=diff
==============================================================================
--- xerces/xerces-p/trunk/postSource.pl (original)
+++ xerces/xerces-p/trunk/postSource.pl Sat Dec 3 07:43:06 2005
@@ -1,44 +1,58 @@
#!/usr/bin/perl
use lib '.';
use SWIG qw(remove_method skip_to_closing_brace fix_method);
+use File::Temp qw/tempfile/;
+use File::Copy;
use strict;
+###
+### SWIG has now improved to the point that this file only installs the license
+###
+
+my $INFILE = "Xerces-tmp.cpp";
+my $OUTFILE = "Xerces.cpp";
+
+open(FILE, $INFILE)
+ or die "Couldn't open $INFILE for reading";
+
+my ($temp_fh, $temp_filename) = tempfile();
+
#
-# SWIG has now improved to the point that this file is not needed!!!
+# Put the apache license in the output file
#
-exit(0);
-
-my $file = shift @ARGV;
-my $PRINTED = 0;
-my $temp_file = "$file.$$";
-
-open(FILE, $file)
- or die "Couldn't open $file for reading";
-open(TEMP, ">$temp_file")
- or die "Couldn't open $temp_file for writing";
+my $LICENSE = <<LICENSE;
+/*
+ * Copyright 2002,2004 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.
+ */
-FILE: while(<FILE>) {
+LICENSE
- substitute_line($_);
+print $temp_fh $LICENSE;
- print TEMP;
+FILE: while(<FILE>) {
+ print $temp_fh $_;
}
close FILE;
-close TEMP;
-
-rename $temp_file, $file;
-
-sub substitute_line {
+close $temp_fh;
- # we remove the RCS keyword from perl5.swg
- # $_[0] = '' if $_[0] =~ /\$Header:/;
+copy($temp_filename, $OUTFILE)
+ or die "Couldn't move $temp_filename to $OUTFILE: $!";
-}
+END {unlink($temp_filename)}
-# we always want to substitute every line so we default the argument
-sub fix_method_source {
- fix_method(@_,\&substitute_line);
-}
+exit(0);
---------------------------------------------------------------------
To unsubscribe, e-mail: commits-unsubscribe@xerces.apache.org
For additional commands, e-mail: commits-help@xerces.apache.org