se/SE/stuff/ant/dtd2xsd.pl

#! perl
#
# by Dan Connolly http://www.w3.org/People/Connolly/ connolly@w3.org
#    Bert Bos http://www.w3.org/People/Bos/ <bert@w3.org>
#    Yuichi Koike
#    Mary Holstege (holstege@mathling.com)
# initial hack by DC Apr 2000, based on dtd2bnf by BB Mar 1998;
# major revision to Apr 2000 make it actually usable by YK;
# tweaks by DC; major update Jan 2001 by MH
#
# see Log since then at end.
# $Id: dtd2xsd.pl,v 1.17 2001/01/19 05:59:12 connolly Exp $

use strict;

# Handling command line argument
my $targetNS = "http://www.w3.org/namespace/";
my $prefix = "t";
my $alias = 0;
my $file = "";
my %SimpleTypes;
my @AttrGroupPatterns;
my @ModelGroupPatterns;
my @SubstitutionGroupPatterns;
my %SubstitutionGroup;

my %Mixed;
my %ModelGroup;
my $mapping_file;
my $pcdata_flag = 0;
my $pcdata_simpletype = "string";
my $debug = 0;

while ($#ARGV >= 0) {
	 my $para = shift(@ARGV);
	 if ($para eq "-ns") {
		  $targetNS = shift(@ARGV);
	 } elsif ($para eq "-prefix") {
		  $prefix = shift(@ARGV);
	 } elsif ($para eq "-alias") {
		  $alias = 1;
	 } elsif ($para eq "-pcdata") {
		  # Treat #PCDATA by itself as being string (or other simple type
		  # if so designated in the mapping file)
		  $pcdata_flag = 1;
	 } elsif ($para eq "-mapfile") {
		  $mapping_file = shift(@ARGV);
	 } elsif ($para eq "-simpletype") {
		  my($pat) = shift(@ARGV);
		  my($b) = shift(@ARGV);
		  $SimpleTypes{$pat} = $b;
	 } elsif ($para eq "-attrgroup") {
		  push(@AttrGroupPatterns, shift(@ARGV));
	 } elsif ($para eq "-modelgroup") {
		  push(@ModelGroupPatterns, shift(@ARGV));
	 } elsif ($para eq "-substgroup") {
		  push(@SubstitutionGroupPatterns, shift(@ARGV));
	 } elsif ($para eq "-debug") {
		  $debug = 1;
	 } else {
		  $file = $para;
	 }
}

# Alias dictionary: defaults
my %alias_dic;
$alias_dic{"URI"} = "uriReference";
$alias_dic{"LANG"} = "language";
$alias_dic{"NUMBER"} = "nonNegativeInteger";
$alias_dic{"Date"} = "date";
$alias_dic{"Boolean"} = "boolean";

if ( $mapping_file )
{
	 print STDERR "Open mapping $mapping_file ";
	 if ( !open( MAPPINGS, "<$mapping_file" ) )
	 {
		  print STDERR "unsuccessful.\n";
	 }
	 else {
		  print STDERR "successful.\n";
		  while ( <MAPPINGS> ) {
				chop;
				if ( /^alias\s+([^ \t]+)\s*=\s*([^ \t]+)\s*/i ) {
					 $alias_dic{$1} = $2;
				}
				elsif ( /^simpletype\s+([^ \t]+)\s*=\s*([^ \t]+)\s*/i ) {
					 $SimpleTypes{$1} = $2;
				}
				elsif ( /^attrgroup\s+([^ \t]+)\s*/i ) {
					 push( @AttrGroupPatterns, $1 );
				}
				elsif ( /^modelgroup\s+([^ \t]+)\s*/i ) {
					 push( @ModelGroupPatterns, $1 );
				}
				elsif ( /^substgroup\s+([^ \t]+)\s*/i ) {
					 push( @SubstitutionGroupPatterns, $1 );
				}
				elsif ( /^pcdata\s+([^ \t]+)\s*/i ) {
					 ## BUGLET: doesn't pay attention to prefix; just a special alias
					 $pcdata_simpletype = $1;
				}
		  }
	 }

	 foreach my $key (keys(%alias_dic)) 
	 {
		  print STDERR "Alias \%$key to $alias_dic{$key}\n"
		  }
}

# Variable declaration
my $linelen = 72;

my $PROG = substr($0, rindex($0, "/") + 1);
my $USAGE = "Usage: $PROG file\n";

my $str = "(?:\"([^\"]*)\"|\'([^\']*)\')";
my %pent;				# Parameter entities
my %attributes;			# Attribute lists
my @element;			# Elements in source order
my %model;				# Content models

# Main
$/ = undef;

# Open file, remove comment and include external entity
my $buf = openFile($file);

# Alias treatment
my $alias_ident = "_alias_";
if ($alias eq 1) {
	 foreach my $key (keys(%alias_dic)) {
		  my $aliaskey = sprintf("%s%s%s", $alias_ident, $key, $alias_ident);
		  $buf =~ s/\%$key;/$aliaskey/gsie;
	 }
}


# store all parameter entities
while ($buf =~ s/<!ENTITY\s+%\s+(\S+)\s+$str\s*>//sie) {
    my($n, $repltext) = ($1, $2.$3);
    my ($pat);

    next if $pent{$n}; # only the first declaration of an entity counts

    foreach $pat (keys %SimpleTypes){
		  if ($n =~ /^$pat$/){
				$buf .= " <!_DATATYPE $n $SimpleTypes{$pat} $repltext> ";
				$pent{$n} = "#DATATYPEREF $n";
				undef $n;
				last;
		  }
    }

    foreach $pat (@AttrGroupPatterns){
		  if ($n =~ /^$pat$/){
				$buf .= " <!_ATTRGROUP $n $repltext> ";
				$pent{$n} = "#ATTRGROUPREF $n";
				undef $n;
				last;
		  }
    }

    foreach $pat (@ModelGroupPatterns){
		  if ($n =~ /^$pat$/){
				$buf .= " <!_MODELGROUP $n $repltext> ";
				$pent{$n} = "#MODELGROUPREF $n";
				undef $n;
				last;
		  }
    }

    foreach $pat (@SubstitutionGroupPatterns){
		  if ($n =~ /^$pat$/){
				$buf .= " <!_SUBSTGROUP $n $repltext> ";
				$pent{$n} = "#SUBSTGROUPREF $n";
				undef $n;
				last;
		  }

    }

    $pent{$n}=$repltext if $n;
}

# remove all general entities
$buf =~ s/<!ENTITY\s+.*?>//gsie;

# loop until parameter entities fully expanded
my $i;
do {
	 # count # of substitutions
	 $i = 0;
	 # expand parameter entities
	 $buf =~ s/%([a-zA-Z0-9_\.-]+);?/$i++,$pent{$1}/gse;
} while ($i != 0);

# treat conditional sections
while($buf =~ s/<!\[\s*?INCLUDE\s*?\[(.*)\]\]>/\1/gsie) {};
while($buf =~ s/<!\[\s*?IGNORE\s*?\[.*\]\]>//gsie) {};

# store attribute lists
$buf =~ s/<!ATTLIST\s+(\S+)\s+(.*?)>/store_att($1, $2)/gsie;

# store content models
$buf =~ s/<!ELEMENT\s+(\S+)\s+(.+?)>/store_elt($1, $2)/gsie;

#print "<?xml version='1.0'?>\n";
print "<schema
  xmlns='http://www.w3.org/2000/10/XMLSchema'
  targetNamespace='$targetNS'
  xmlns:$prefix='$targetNS'>\n";

# find maximum length of non-terminals
#my $maxlen = max(map(length, @element)) + 4;

# write simple type declarations
$buf =~ s/<!_DATATYPE\s+(\S+)\s+(\S+)\s+(.+?)>/write_simpleType($1, $2, $3)/gsie;

# write attribute groups
$buf =~ s/<!_ATTRGROUP\s+(\S+)\s+(.+?)>/write_attrGroup($1, $2)/gsie;

# write model groups
$buf =~ s/<!_MODELGROUP\s+(\S+)\s+(.+?)>/write_modelGroup($1, $2)/gsie;

# write subsitution groups
$buf =~ s/<!_SUBSTGROUP\s+(\S+)\s+(.+?)>/write_substitutionGroup($1, $2)/gsie;


my($e);

# loop over elements, writing XML schema
foreach $e (@element) {
	 my $h = $model{$e};
	 my $h2 = $attributes{$e};
	 my @model = @$h;
	 my $isSimple = ($pcdata_flag eq 1) && ($model[1] eq '#PCDATA') &&
		  ( ($#model eq 2) || 
			 ( ($#model eq 3) && ($model[3] eq '*') ) );

	 my $substGroup = $SubstitutionGroup{$e};
	 if ( $substGroup )
	 {
		  $substGroup = " substitutionGroup='$substGroup'";
	 }

	 # print rule for element $e
	 if ( $isSimple && ! $h2 )
	 {
		  # Assume (#PCDATA) is string
		  print "\n <element name='$e' type='$pcdata_simpletype'$substGroup>\n";
	 }
	 else {
		  print "\n <element name='$e'$substGroup>\n";
	 }

	 if ( $isSimple )
	 {
		  # Assume (#PCDATA) is string
		  if ( $h2 ) 
		  {
				print "  <complexType>\n";
				print "  <simpleContent>\n";
				print "  <extension base='string'>\n";
		  }
	 }

	 else {
		  # print rule for $e's content model
		  print "  <complexType";
		  if ($model[0] eq 'EMPTY') {
				if (! $h2 ) {
					 print "/>\n";
				} else {
					 print ">\n";
				}
		  } 
		  elsif ( $model[0] eq 'ANY' )
		  {
				print ">\n";
				print "   <sequence>\n";
				print "   <any namespace='$targetNS'/>\n";
				print "   </sequence>\n";
		  }
		  else {
				if ( $debug eq 1 ) {
					 print STDERR "==mixed? @model\n"; #@@
				}
				if (&isMixed(@model)) {
					 print " mixed='true'>\n";
				}
				else {
					 print ">\n";
				}

				my @list = &makeChildList('', @model);
				&printChildList(3, @list);
		  }
	 }

	 # print rule for $e's attributes
	 if (! $h2) {
		  # nothing
	 } else {
		  &printAttrDecls(@$h2);
		  if ( $isSimple ) {
				print "   </extension>\n";
				print "   </simpleContent>\n";
		  }
	 }

	 if ( !$h2 && $isSimple ) {
		  # Do nothing
	 }
	 elsif ($h2 || $model[0] ne 'EMPTY') {
		  print "  </complexType>\n";
	 }

	 print " </element>\n";
}

print "</schema>\n";
exit;

sub printSpace
{
	 my ($num) = $_[0];
	 for (my $i=0; $i<$num; $i++) {
		  print " ";
	 }
}

sub printChildList
{
	 my ($num, @list) = @_;

	 my @currentTag = ();
	 for (my $i=0; $i<= $#list; $i++) {
		  my $n = $list[$i];

		  if ($n eq 0 || $n eq 1 || $n eq 2 || $n eq 3) {
				if ( ($pcdata_flag eq 0) && ($n eq 0 || $n eq 1) && $list[$i+1] eq 20)
				{
					 # The whole list is 0 20 or 1 20; i.e. (#PCDATA) or (#PCDATA)*. 
					 # Don't generate a sequence child; mixed handles all this.
				}
				else {
#            my $do_it_flag = 1;
					 if ( $currentTag[$#currentTag] eq "" && $n eq 0 )
					 {
						  push(@currentTag, "");
#  					 my $n_1 = $list[$i+1];
#  					 if ( $n_1 eq 10 || $n_1 eq 11 || $n_1 eq 12 || $n_1 eq 13 )
#  					 {
#  						  # do nothing: we have a phantom sequence wrapping a choice
#  						  # that we want to not want to appear. OTOH we want a top 
#  						  # level sequence in other cases.
#  						  $do_it_flag = 0;
#  					 }
					 }

#  				if ( $do_it_flag eq 1 )
#  {
					 printSpace($num); $num++;
					 print "<sequence";
					 if ($n eq 1) {
						  print " minOccurs='0' maxOccurs='unbounded'";
					 } elsif ($n eq 2) {
						  print " maxOccurs='unbounded'";
					 } elsif ($n eq 3) {
						  print " minOccurs='0' maxOccurs='1'";
					 }
					 print ">\n";
					 push(@currentTag, "sequence");
				}
#}
		  } elsif ($n eq 10 || $n eq 11 || $n eq 12 || $n eq 13) {
				printSpace($num); $num++;
				print "<choice";
				if ($n eq 11) {
					 print " minOccurs='0' maxOccurs='unbounded'";
				} elsif ($n eq 12) {
					 print " maxOccurs='unbounded'";
				} elsif ($n eq 13) {
					 print " minOccurs='0' maxOccurs='1'";
				}
				print ">\n";
				push(@currentTag, "choice");
		  } elsif ($n eq 20) {
				my $tag = pop(@currentTag);
				if ($tag ne "") {
					 $num--; printSpace($num);
					 print "</", $tag, ">\n";
				}
		  } else {
				printSpace($num);
				if ($n eq '#MODELGROUPREF') {
					 print "<group ref='$prefix:$list[++$i]'";
				}
				elsif ($n eq '#SUBSTGROUPREF') {
					 print "<element ref='$prefix:$list[++$i]'";
				} else {
					 print "<element ref='$prefix:$n'";
				}

				if ($currentTag[$#currentTag] ne "choice") {
					 if ($list[$i+1] eq "+") {
						  print " maxOccurs='unbounded'";
						  $i++;
					 } elsif ($list[$i+1] eq "?") {
						  print " minOccurs='0' maxOccurs='1'";
						  $i++;
					 } elsif ($list[$i+1] eq "*") {
						  print " minOccurs='0' maxOccurs='unbounded'";
						  $i++;
					 }
				}
				print "/>\n";
		  }
	 }
}

sub makeChildList {
	 my ($groupName, @model) = @_;
	 my @ret = ();
	 my @brace = ();
	 for (my $i=0; $i<=$#model; $i++) {
		  my $n = $model[$i];

		  if ($n eq "(") {
				push(@ret, 0);
				push(@brace, $#ret);
		  } elsif ($n eq ")") {
				if ($model[$i+1] eq "*") {
					 $ret[$brace[$#brace]] += 1;
					 $i++;
				} elsif ($model[$i+1] eq "+") {
					 $ret[$brace[$#brace]] += 2;
					 $i++;
				} elsif ($model[$i+1] eq "?") {
					 $ret[$brace[$#brace]] += 3;
					 $i++;
				}
				pop(@brace);
				push(@ret, 20);
		  } elsif ($n eq ",") {
				$ret[$brace[$#brace]] = 0;
		  } elsif ($n eq "|") {
				$ret[$brace[$#brace]] = 10;
		  } elsif ($n eq "#PCDATA") {
				if ($model[$i+1] eq "|") {
					 $i++;
				}
				if($groupName){
					 $Mixed{$groupName} = 1;
				}
		  } else {
				push(@ret, $n);
		  }
	 }

	 # "( ( a | b | c )* )" gets mapped to "0 10 a b c 20 20" which will generate
	 # a spurious sequence element. This is not too harmful when this is an
	 # element content model, but with model groups it is incorrect.
	 # In general we need to strip off 0 20 from the ends when it is redundant. 
	 # Redundant means: there is some other group that bounds the whole list. 
	 # Note that it gets a little tricky:
	 # ( (a|b),(c|d) ) gets mapped to "0 10 a b 20 10 c d 20 20". If one
	 # naively chops off the 0 and 20 on the groups that there is a 10 on one
	 # end and a 20 on the other, one loses the bounding sequence, which is 
	 # required in this case.
	 #
	 if ( $ret[0] eq 0 && $ret[$#ret] eq 20 && $ret[$#ret-1] eq 20 &&
			( $ret[1] eq 0 || $ret[1] eq 1 || $ret[1] eq 2 || $ret[1] eq 3 ||
			  $ret[1] eq 10 || $ret[1] eq 11 || $ret[1] eq 12 || $ret[1] eq 13 )
			)
	 {
		  # OK, it is possible that the 0 20 is redundant. Now scan for balance:
		  # All interim 20 between the proposed new start and the proposed new
		  # final one should be at level 1 or above. 
		  my $depth = 0;
		  my $redundant_paren = 1;  # Assume redundant until proved otherwise
		  for ( my $i = 1; $i <= $#ret-1; $i++ )
		  {
				if ( $ret[$i] eq 20 )
				{
					 $depth--;
					 if ( $i < $#ret-1 && $depth < 1 )
					 {
						  $redundant_paren = 0;
						  print STDERR "i=$i,depth=$depth\n";
					 }
				}
				elsif ( $ret[$i] eq 0 || 
						  $ret[$i] eq 1 || 
						  $ret[$i] eq 2 || 
						  $ret[$i] eq 3 ||
						  $ret[$i] eq 10 || 
						  $ret[$i] eq 11 || 
						  $ret[$i] eq 12 || 
						  $ret[$i] eq 13 
						  )
				{
					 $depth++;
				}
		  }  # for

		  if ( $redundant_paren eq 1 )
		  {
				print STDERR "Truncating @ret\n";
				@ret = @ret[1..$#ret-1];
		  }
	 }

	 if ( $debug eq 1 ) {
		  print STDERR "@model to @ret\n";
	 }
	 return @ret;
}


sub printAttrDecls{
    my @atts = @_;

    for (my $i = 0; $i <= $#atts; $i++) {
		  if ($atts[$i] eq '#ATTRGROUPREF'){
				print "   <attributeGroup ref='$prefix:$atts[$i+1]'/>\n";
				$i ++;
		  } else {
				# attribute name
				print "   <attribute name='$atts[$i]'";

				# attribute type
				my @enume;
				$i++;
				if ($atts[$i] eq "(") {
					 # like `attname ( yes | no ) #REQUIRED`
					 $i++;
					 while ($atts[$i] ne ")") {
						  if ($atts[$i] ne "|") {
								push(@enume, $atts[$i]);
						  }
						  $i++;
					 }
				} elsif ($atts[$i] eq '#DATATYPEREF'){
					 print " type='$prefix:$atts[++$i]'";
				} elsif ($alias eq 1 && $atts[$i] =~ s/$alias_ident//gsie) {
					 # alias special
					 print " type='$alias_dic{$atts[$i]}'";
				} elsif ($atts[$i] =~ /ID|IDREF|ENTITY|NOTATION|IDREFS|ENTITIES|NMTOKEN|NMTOKENS/) {
					 # common type for DTD and Schema
					 print " type='$atts[$i]'";
				} else {
					 # `attname CDATA #REQUIRED`
					 print " type='string'";
				}

				$i++;

				# #FIXED
				if($atts[$i] eq "#FIXED") {
					 $i++;
					 print " use='fixed' value='$atts[$i]'/>\n";
				} else {
					 # minOccurs
					 if ($atts[$i] eq "#REQUIRED") {
						  print " use='required'";
					 } elsif ($atts[$i] eq "#IMPLIED") {
						  print " use='optional'";
					 } else {
						  print " use='default' value='$atts[$i]'";
					 }

					 # enumerate
					 if ($#enume eq -1) {
						  print "/>\n";
					 } else {
						  print ">\n";
						  print "    <simpleType>\n";
						  print "     <restriction base='string'>\n";
						  &write_enum(@enume);
						  print "     </restriction>\n";
						  print "    </simpleType>\n";
						  print "   </attribute>\n";
					 }
				}
		  }
    }
}

sub write_enum{
    my(@enume) = @_;

    for (my $j = 0; $j <= $#enume; $j++) {
		  print "      <enumeration value='$enume[$j]'/>\n";
    }
}


# Parse a string into an array of "words".
# Words are whitespace-separated sequences of non-whitespace characters,
# or quoted strings ("" or ''), with the quotes removed.
# HACK: added () stuff for attlist stuff
# Parse words for attribute list
sub parsewords {
	 my $line = $_[0];
	 $line =~ s/(\(|\)|\|)/ $1 /g;
	 my @words = ();

	 while ($line ne '') {
		  if ($line =~ /^\s+/) {
				# Skip whitespace
		  } elsif ($line =~ /^\"((?:[^\"]|\\\")*)\"/) {
				push(@words, $1);
		  } elsif ($line =~ /^\'((?:[^\']|\\\')*)\'/) {
				push(@words, $1);
		  } elsif ($line =~ /^\S+/) {
				push(@words, $&);
		  } else {
				die "Cannot happen\n";
		  }
		  $line = $';
	 }
    return @words;
}

# Store content model, return empty string
sub store_elt
{
	 my ($name, $model) = @_;
	 $model =~ s/\s+/ /gso;
	 push(@element, $name);

	 my @words;
	 while ($model =~ s/^\s*(\(|\)|,|\+|\?|\||[\w_\.-]+|\#\w+|\*)//) {
		  push(@words, $1);
	 };
	 $model{$name} = [ @words ];
	 return '';
}


# Store attribute list, return empty string
sub store_att
{
	 my ($element, $atts) = @_;
	 my @words = parsewords($atts);
	 $attributes{$element} = [ @words ];
	 return '';
}

sub write_simpleType{
    my($n, $b, $stuff) = @_;
    my @words = parsewords($stuff);

    print "\n  <simpleType name='$n'>\n";
    print "   <restriction base='$b'>\n";
#    print STDERR "\n==stuff:\n$stuff \n\n===\n", join('|', @words);

    my $i = 0;
    my @enume;

    if ($words[$i] eq "(") {
		  $i++;
		  while ($words[$i] ne ")") {
				if ($words[$i] ne "|") {
					 push(@enume, $words[$i]);
				}
				$i++;
		  }
		  write_enum(@enume);
    }

	 print "   </restriction>\n";
    print "  </simpleType>\n";
}

sub write_attrGroup{
    my($n, $stuff) = @_;
    my @words = parsewords($stuff);

    print "\n  <attributeGroup name='$n'>\n";
#    print STDERR "\n==stuff:\n$stuff \n\n===\n", join('|', @words);
    printAttrDecls(@words);
    print "  </attributeGroup>\n";
}

sub write_modelGroup{
    my($n, $stuff) = @_;
    my @words = parsewords($stuff);

    print "\n  <group name='$n'>\n";
    print "<!-- $stuff -->\n";

    my @list = &makeChildList($n, '(', @words, ')');
    &printChildList(3, @list);

    $ModelGroup{$n} = \@list;

    print "  </group>\n";
}

sub write_substitutionGroup
{
    my($n, $stuff) = @_;
    my @words = parsewords($stuff);

    print "\n  <element name='$n' abstract='true'>\n";

    my @list = &makeChildList($n, '(', @words, ')');
	 for ( my $i = 0; $i < $#list; $i++ )
	 {
		  $SubstitutionGroup{ $list[$i] } = $n;
	 }

    print "  </element>\n";
}

sub isMixed{
    my(@model) = @_;
	 my $isSimple = ($pcdata_flag eq 1) && ($model[1] eq '#PCDATA') &&
		  ( ($#model eq 2) || 
			 ( ($#model eq 3) && ($model[3] eq '*') ) );

	 if ( $debug eq 1 ) {
		  print STDERR "++ mixed? @model\n"; #@@
	 }

	 if ( $isSimple )
	 {
		  if ( $debug eq 1 ) 
		  {
				print STDERR "++ no; simple type. @model\n"; #@@
		  }
		  return 0;
	 }

    my($i);

    for ($i = 0; $i <= $#model; $i++) {
		  if ( $model[$i] eq '#PCDATA' ||
				 ($model[$i] eq '#MODELGROUPREF' && $Mixed{$model[$i+1]}) ||
				 ($model[$i] eq '#SUBSTGROUPREF' && $Mixed{$model[$i+1]}) )
		  {
				if ( $debug eq 1 ) {
					 print STDERR "++ yes! $i @model\n"; #@@
				}
				return 1;
		  }
    }

	 if ( $debug eq 1 ) {
		  print STDERR "++ no. @model\n"; #@@
	 }

    return 0;
}

# Return maximum value of an array of numbers
sub max
{
	 my $max = $_[0];
	 foreach my $i (@_) {
		  if ($i > $max) {$max = $i;}
	 }
	 return $max;
}


# 1) Open file
# 2) Remove comment, processing instructions, and general entities
# 3) Include external parameter entities recursively
# 4) Return the contents of opened file
sub openFile {
	 my $file = $_[0];

	 my %extent;
	 my $bufbuf;
	 if ($file ne "") {
		  print STDERR "open $file ";
		  if(! open AAA, $file) {
				print STDERR " failed!!\n";
				return "";
		  }
		  print STDERR " successful\n";
		  $bufbuf = <AAA>;
	 } else {
		  print STDERR "open STDIN successful\n";
		  $bufbuf = <>;
	 }

	 # remove comments
	 $bufbuf =~ s/<!--.*?-->//gso;

	 # remove processing instructions
	 $bufbuf =~ s/<\?.*?>//gso;

	 # store external parameter entities
	 while ($bufbuf =~ s/<!ENTITY\s+%\s+(\S+)\s+PUBLIC\s+$str\s+$str.*?>//sie) {
		  $extent{$1} = $4.$5;
	 }
	 while ($bufbuf =~ s/<!ENTITY\s+%\s+(\S+)\s+SYSTEM\s+$str.*?>//sie) {
		  $extent{$1} = $2.$3;
	 }

	 # read external entity files
	 foreach my $key (keys(%extent)) {
		  $bufbuf =~ s/%$key;/openFile($extent{$key})/gsie;
	 }

	 return $bufbuf;
}

# $Log: dtd2xsd.pl,v $
# Revision 1.17  2001/01/19 05:59:12  connolly
# more changelog stuff; link to MH's announcement etc.
#
# Revision 1.16  2001/01/19 05:55:56  connolly
# added Log at end
#
# Changes: 2001/01/10
# Date:      Thu, 11 Jan 2001 14:51:44 -0800
# From:      Mary Holstege <holstege@mathling.com>
# To:        xml-dev@lists.xml.org
# Subject:   [ANN] Updated version of DTD to XML Schema tool
# http://lists.xml.org/archives/xml-dev/200101/msg00481.html
# http://www.mathling.com/xmlschema/
# Switch to CR syntax
# Support external mapping file for type aliases, simple types, model and
#    attribute groups
# Map ANY correctly to wildcard rather than element 'ANY'
# Support treating lead PCDATA as string or other aliased simple type instead
# of as mixed content (may be more appropriate for data-oriented DTDs)
#    e.g. <!ELEMENT title (#PCDATA)> => <element name="title" type="string"/>
# Support subsitution groups.