Added "well-formed" XML checker script.

1 files changed, 67 insertions, 0 deletions

diff --git a/Docs/Support/xwf b/Docs/Support/xwf
new file mode 100755
index 00000000000..38f89774fe8
--- /dev/null
+++ b/Docs/Support/xwf
@@ -0,0 +1,67 @@
+#!/usr/bin/perl -w
+#
+# Parse document and report first syntax (well-formedness) error found.
+#
+
+use strict;
+use XML::Parser;
+use Getopt::Std;
+
+my %opts;
+getopts('e', \%opts);
+my $ENTREFS = exists( $opts{'e'} );                 # flag: check ent refs
+
+my $parser = XML::Parser->new( 
+                               ErrorContext => 2,   # output error context
+                               );
+
+# get input from files
+if( @ARGV ) {
+    foreach( @ARGV ) {
+        my $file = $_;
+        unless( -r $file ) {
+            print STDERR "ERROR: Can't open '$file'.\n";
+            return;
+        }
+        my $input = '';
+        open( F, $file );
+        while( <F> ) { $input .= $_; }
+        close F;
+
+        # parse and report errors
+        if( &parse_string( $input )) {
+            print STDERR "ERROR in $file:\n$@\n";
+        } else {
+            print STDERR "'$file' is well-formed.\n";
+        }
+    }
+    print "All files checked.\n";
+
+# get input from STDIN
+} else {
+    my $input = "";
+    while( <STDIN> ) { $input .= $_; }
+    if( &parse_string( $input )) {
+        print STDERR "ERROR in stream:\n$@\n";
+    } else {
+        print STDERR "No syntax errors found in XML stream.\n";
+    }
+}
+
+
+# parse the string and return error message
+#
+# NOTE: By default, entity refs are not expanded.  XML::Parser can be
+# told not to expand entity refs, but will still try to find
+# replacement text just in case, which we don't want.  Therefore, we
+# need to do a stupid regexp replacement, removing entities from input.
+#
+sub parse_string {
+    my $string = shift;
+    unless( $ENTREFS ) {
+        $string =~ s/\&[^\s;]+;//g;         # remove entity references
+    }
+    eval { $parser->parse( $string ); };
+    $@ =~ s/at \/.*?$//s;               # remove module line number
+    return $@;
+}