Re: stress testing Xerces

# use blib;
use XML::Xerces;
use strict;
use Getopt::Long;
use Linux::MemInfo;

my %OPTIONS;
$OPTIONS{count} = 1000;
$OPTIONS{dom} = 1;
my $rc = GetOptions(\%OPTIONS,
		    'file=s',
		    'count=i',
		    'help',
		    'validate',
		    'dom',
		    'sax2',
		    'schema',
		    );
my $USAGE = <<"EOU";
usage: $0 [required flags]
  required flags:
    --file=file_name  : the XML file to parse

  optional parameters:
    --dom             : use a DOM parser (default)
    --sax2            : use a SAX2XMLReader
    --schema          : parse a W3C XML Schema file
    --count=num       : run num iterations default = $OPTIONS{count}
    --validate        : turn validation on
    --help            : print this message
EOU

die "$rc\n$USAGE" unless $rc;
die $USAGE if exists $OPTIONS{help};

die "Must specify --file\n$USAGE"
  unless exists $OPTIONS{file};

# remove the default if told to use SAX2
delete $OPTIONS{dom}
  if exists $OPTIONS{sax2};

open(IN,$OPTIONS{file})
  or die "Couldn't open $OPTIONS{file} for reading";
my $logfile = '/tmp/xerces-memtest.log';
open(LOG,">$logfile")
  or die "Couldn't open $logfile for reading";

# slurp in the file
my $xml;
{
  local $/;
  $xml = <IN>;
}

# get the initial results:
my %info = get_mem_info();
my $starting_mem = $info{mem_free};
my $errorHandler = XML::Xerces::PerlErrorHandler->new() ;

my $validate = 0;
my $schema = 0;
my $namespace = 0;
if (exists $OPTIONS{validate}) {
  $validate = 1;
  if (exists $OPTIONS{schema}) {
    $schema = 1;
    $namespace = 1;
  }
}

my $count = 0;
for (1..$OPTIONS{count}) {
  $count++;
  # run the loop
  if (exists $OPTIONS{dom}) {
    validate_dom($xml);
  } elsif (exists $OPTIONS{sax2}) {
    validate_sax2($xml);
  }
  if ($count % 100 == 0) {
    my %info = get_mem_info();
    printf LOG "%d: mem leaked: %d, leak/iteration:%f\n",
      $count,
      $starting_mem - $info{mem_free},
      ($starting_mem - $info{mem_free})/$count,
	;
  }
}

sub validate_sax2 {
  my $xml = shift ;

  # Just to make sure there is only one, $Parser is global but it's not used anywhere else:
  my $parser = XML::Xerces::XMLReaderFactory::createXMLReader() ;
  $parser->setErrorHandler($errorHandler) ;

#   my $contentHandler = new XML::Xerces::PerlContentHandler() ;
#   $parser->setContentHandler($contentHandler) ;

  eval {
    $parser->setFeature("http://xml.org/sax/features/namespaces", $namespace) ;
    $parser->setFeature("http://apache.org/xml/features/validation/schema", $schema) ;
    $parser->setFeature("http://apache.org/xml/features/validation/schema-full-checking", $schema) ;
    $parser->setFeature("http://apache.org/xml/features/validation-error-as-fatal", $validate) ;
  };
  XML::Xerces::error($@) if $@;


  eval {
    $parser->setFeature("http://xml.org/sax/features/validation", $validate) ;
    $parser->setFeature("http://apache.org/xml/features/validation/dynamic", 0) ;
  };
  XML::Xerces::error($@) if $@;

  eval {
    my $is = XML::Xerces::MemBufInputSource->new($xml);
    # my $is = XML::Xerces::LocalFileInputSource->new($OPTIONS{file});
    $parser->parse($is) ;
  } ;
  XML::Xerces::error($@) if $@;
}

sub validate_dom {
  my $xml = shift ;

  # Just to make sure there is only one, $Parser is global but it's not used anywhere else:
  my $parser = XML::Xerces::XercesDOMParser->new() ;
  $parser->setErrorHandler($errorHandler) ;

  $parser->setValidationScheme ($validate);
  $parser->setDoNamespaces ($namespace);
  $parser->setDoSchema ($schema);
  $parser->setValidationSchemaFullChecking ($schema);

  eval {
    my $is = XML::Xerces::MemBufInputSource->new($xml);
    # my $is = XML::Xerces::LocalFileInputSource->new($OPTIONS{file});
    $parser->parse($is) ;
  } ;
}