Schema Support Issues

#! /usr/local/bin/perl
  #######################################################################
 #                                                                     ##
####################################################################### #
#                                                                     # #
#  UNM Office of Biocomputing                                         # #
#                                                                     # #
#  Time-stamp: <2003-10-15 09:53:35 smathias>                         # #
#                                                                     # #
#  Copyright (c) 2003, University of New Mexico School of Medicine.   # #
#                                                                     # #
#  Author: Steve Mathias                                              # #
#          [email protected]                                           # #
#                                                                     ##
#######################################################################

BEGIN {
  use vars qw(@libDirs) ;

  @libDirs = qw(/usr/local/bix/perl/lib) ;

  use lib @libDirs ;
  unshift @INC, @libDirs unless $INC[0] eq $libDirs[0] ;
}

use strict ;
use warnings ;
use Getopt::Long ;
use XML::Xerces ;
use Time::HiRes qw( gettimeofday tv_interval ) ;

# Global Variables ######################################################
#
use vars qw($ProgramName $Debug $Usage $Validation $File 
	    @SAX2ParserFeatures $ContentHandler) ;

$ProgramName = substr($0, 1+rindex($0,'/')) ;

# Defaults
$Debug = 0 ;
$Validation = "auto" ;
$File = "./data.xml" ;

$Usage = "
This is a test script for XML::Xerces 

Usage: $ProgramName [options] [file]

options:
  -v | --valid <always|never|auto>      
            : Validation scheme. [$Validation]
  -d | --debug
            : Turn on debugging output.
  -h | -? | --help     
            : Print this message and exit.

file:
  Input file.  Default is \"$File\"

" ;

@SAX2ParserFeatures = (
		       'http://xml.org/sax/features/validation',
		       'http://xml.org/sax/features/namespaces',
		       'http://xml.org/sax/features/namespace-prefixes',
		       'http://apache.org/xml/features/validation/dynamic',
		       #'http://apache.org/xml/features/validation/reuse-grammar',
		       'http://apache.org/xml/features/validation/schema',
		       'http://apache.org/xml/features/validation/schema-full-checking',
		       'http://apache.org/xml/features/nonvalidating/load-external-dtd',
		       'http://apache.org/xml/features/continue-after-fatal-error',
		       'http://apache.org/xml/features/validation-error-as-fatal',
		      ) ;
#
#########################################################################


## Main #################################################################
#

#
# Command line
#
my($help, $valid) ;

GetOptions("valid|v=s" => \$valid,
	   "debug|d" => \$Debug,
	   "help|h|?" => \$help) || die $Usage ;
die $Usage if $help ;
$|++ if $Debug ; # No output buffering when debugging 
dprint("Debugging in $ProgramName is on.", 1) ;

$valid ||= $Validation ;
die "Unsupported validation scheme: $valid\n" unless $valid =~ /^(always|never|auto)$/i ;
$valid = uc($valid) ;

die "No input file!\n$Usage" unless -r $ARGV[0] ;

#
# MyContentHandler
#
package MyContentHandler ;
use strict ;
use vars qw(@ISA) ;
@ISA = qw(XML::Xerces::PerlContentHandler) ;

sub start_element {
  my ($self,$uri,$localname,$qname,$attrs) = @_ ;
  $self->{elements}++;
  $self->{attrs} += $attrs->getLength;
}
sub characters {
  my ($self,$str,$len) = @_ ;
  $self->{chars} += $len ;
}
sub ignorable_whitespace {
  my ($self,$str,$len) = @_ ;
  $self->{ws} += $len ;
}
sub resetCounts {
  my $self = shift ;
  $self->{elements} = 0 ;
  $self->{attrs} = 0 ;
  $self->{chars} = 0 ;
  $self->{ws} = 0 ;
}

package main ;

$ContentHandler = MyContentHandler->new() ;
die "Error creating content handler!\n" unless $ContentHandler ;

#
# Program
#
my($parser, $file, $msg, $t0, $elapsed) ;

$parser = parserInit($valid) ;

foreach $file (@ARGV) {
  print "  Parsing file: $file\n" ;
  $ContentHandler->resetCounts() ;
  $t0 = [gettimeofday] ;
  eval {
    $parser->parse( XML::Xerces::LocalFileInputSource->new($file) ) ;
  } ;
  $elapsed = tv_interval($t0) ;
  if ($@) {
    if ( ref($@) ) {
      $msg = $@->getMessage() ;
    } else {
      $msg = $@ ;
    }
    print "Parse error: $msg\n" ;
    $parser = parserInit($valid) ; # create a new parser
  } else {
    print "  Count results:\n" ;
    print "                 elems: ", $ContentHandler->{elements}, "\n" ; 
    print "                 attrs: ", $ContentHandler->{attrs}, "\n" ;
    print "                 whitespace: ", $ContentHandler->{ws}, "\n" if $ContentHandler->{ws} ;
    print "                 characters: ", $ContentHandler->{chars}, "\n" ; 
    print "  Elapsed time: $elapsed sec\n\n" ;
  }
}
#
## End Main #############################################################

sub dprint {
  my($msg, $level) = @_ ;
  
  if ( $level <= $main::Debug ) {
    my $dmsg = "[DEBUG] " ;
    if ( $level >= 3 ) {
      my $trace = calledByString() ;
      $dmsg .= "$trace" if $trace ;
    }
    $dmsg .= "$msg\n" ;
    print STDERR $dmsg ;
  }

  return 1 ;
}

sub parserInit {
  my $valid = shift ;
  my($parser, $errorHandler, $msg, $fVal) ;

  $parser = XML::Xerces::XMLReaderFactory::createXMLReader() ;
  dprint("Successfully created parser: $parser", 1) ;
  $errorHandler = XML::Xerces::PerlErrorHandler->new() ;
  die "Error creating error handler!" unless $errorHandler ;
  eval {
    # Always enable namespace processing:
    $parser->setFeature("http://xml.org/sax/features/namespaces", 1) ;
    # Always enable schema processing and full checking:
    $parser->setFeature("http://apache.org/xml/features/validation/schema", 1) ;
    $parser->setFeature("http://apache.org/xml/features/validation/schema-full-checking", 1) ;
    # the value of this seems to have no affect
    #$parser->setFeature("http://apache.org/xml/features/continue-after-fatal-error", 1) ;
    $parser->setFeature("http://apache.org/xml/features/validation-error-as-fatal", 1) ;
    if ( $valid eq 'ALWAYS') {
      $parser->setFeature("http://xml.org/sax/features/validation", 1) ;
      $parser->setFeature("http://apache.org/xml/features/validation/dynamic", 0) ;
    } elsif ( $valid eq 'NEVER') {
      $parser->setFeature("http://xml.org/sax/features/validation", 0) ;
    } elsif ( $valid eq 'AUTO') {
      $parser->setFeature("http://xml.org/sax/features/validation", 1) ;
      $parser->setFeature("http://apache.org/xml/features/validation/dynamic", 1) ;
    }
    $parser->setErrorHandler($errorHandler) ;
    $parser->setContentHandler($ContentHandler) ;
  };
  if ($@) {
    if (ref $@) {
      $msg = sprintf "Error configuring parser: %s\n", $@->getMessage() ;
    } else {
      $msg = "Error configuring parser: $@\n" ;
    }
    die $msg ;
  }
  if ($Debug) {
    dprint("Successfully configured parser:", 1) ;
    foreach (@SAX2ParserFeatures) {
      eval {
	$fVal = $parser->getFeature($_) ;
      };
      if ($@) {
	if (ref $@) {
	  $msg = sprintf "Error getting feature $_: %s", $@->getMessage() ;
	} else {
	  $msg = "Error getting feature $_: $@" ;
	}
      } else {
	$msg = "  Value of feature $_ is '$fVal'" ;
      }
      dprint($msg, $Debug) ;
    }
  }

  return $parser ;
}