#
# Usage: perl batch.t [-g] [-p pattern]
#
# -p pattern: Only runs the test cases for which the output filename
# (e.g. t/out/dv_attr1.err) matches the specified pattern.
# -g: Generates the t/out/*.err files (should probably only be
# used by enno)
# -d: If specified, generates 2 output files in t/out:
# dv_attr1.err.out1 : result of test case
# dv_attr1.err.out2 : expected output (same as .err with
# normalized newlines)
# -o: Also print the result of the test case.
#
# This script basically runs all test cases for all xml files in the t/ directory
# and compares the output with the appropriate output in t/out/*.err
#
# There are currently 4 test cases:
# - cp: Uses XML::Checker::Parser
# - dc: Uses XML::DOM::Parser to create a XML::DOM::Document
# and checks it with $doc->check.
# - dv: uses XML::DOM::ValParser
# - sc: Uses XML::Parser::PerlSAX to parse and
# passes data onto the SAX interface of XML::Checker
#
# The expected output of running script 'cp' on file attr.xml can be found in
# t/out/cp_attr1.err
use strict;
use Carp;
use Getopt::Std;
use Cwd;
use vars qw( $opt_t $opt_g $opt_p $opt_d $opt_o );
# disable warnings with -w
#$opt_o = $opt_d = $opt_t = $opt_g = $opt_p = undef;
getopts ("dogt:p:");
# Determine OS path separator
sub get_path_sep
{
if ((defined $^O and
$^O =~ /MSWin32/i ||
$^O =~ /Windows_95/i ||
$^O =~ /Windows_NT/i) ||
(defined $ENV{OS} and
$ENV{OS} =~ /MSWin32/i ||
$ENV{OS} =~ /Windows_95/i ||
$ENV{OS} =~ /Windows_NT/i))
{
return "\\";
}
elsif ((defined $^O and $^O =~ /MacOS/i) ||
(defined $ENV{OS} and $ENV{OS} =~ /MacOS/i))
{
return ":";
}
else # Unix
{
return "/";
}
}
my $sep = get_path_sep();
# chdir to the t/ subdirectory
my $currdir = cwd;
my $prefix = "";
if (-d 't')
{
chdir 't';
$prefix = "t$sep";
}
my @xml = map { s/\.xml$//; $_ } <*.xml>; # strip .xml suffix
chdir $currdir;
my $GENERATE = $opt_g;
my $ONLY = $opt_p || undef;
my @scripts = qw( sc dv cp dc );
my $num_tests = @xml * @scripts;
print "1..$num_tests\n";
my $testcase = 1;
for my $script (@scripts)
{
for my $xml (@xml)
{
my $outfile = "${prefix}out${sep}${script}_$xml.err";
next if defined $ONLY && $outfile !~ /$ONLY/;
# print "-- run $outfile\n";
my $err;
{
no strict "refs";
$err = &$script ($prefix . $xml);
}
if ($GENERATE)
{
if (open (OUT, ">$outfile"))
{
print OUT $err;
close OUT;
}
else
{
print "(gen) could not open $outfile\n";
}
}
else
{
my $same = same ($err, $outfile);
my $not = $same ? "" : "not ";
print "${not}ok $testcase - $script/$xml\n";
}
$testcase++;
}
}
my $error_str = "";
sub my_fail
{
$error_str .= XML::Checker::error_string (@_);
}
sub append_str
{
$error_str .= shift() . "\n";
}
sub same
{
my ($str, $outfile) = @_;
if (open (FILE, $outfile))
{
local $/; # temporarily set file slurping on
my $str2 = <FILE> || "";
close FILE;
# Normalize newlines to current platform
$str2 =~ s/(\x0D\x0A|\x0D|\x0A)/\n/g;
if ($opt_o)
{
print $str;
}
if ($str eq $str2)
{
return 1;
}
else
{
if ($opt_d)
{
open (OUT, ">$outfile.out1");
print OUT $str;
close OUT;
open (OUT, ">$outfile.out2");
print OUT $str2;
close OUT;
}
return 0;
}
}
else
{
print "ERROR: could not open $outfile: $?\n";
return 0;
}
}
# XML::Parser throws exceptions of the form:
#
# no element found at line 5, column 0, byte -1 at
# /home1/enno/perl500502/lib/site_perl/5.005/sun4-solaris/XML/Parser.pm line 168
#
# For comparison purposes we have to chop off the filename, because that will
# be different for each installation
sub chop_exception
{
my ($ex) = @_;
$ex =~ s/ at \S+ line \d+//;
$ex;
}
# Script 'cp': Uses XML::Checker::Parser
sub cp
{
my ($xml) = @_;
require XML::Checker::Parser;
local $XML::Checker::FAIL = \&my_fail;
$error_str = "";
my $parser = new XML::Checker::Parser;
eval
{
$parser->parsefile ("$xml.xml");
};
if ($@)
{
$error_str .= "PARSER TERMINATED: " . chop_exception($@);
}
$error_str;
}
# Script 'dc': Uses XML::DOM::Parser to create a XML::DOM::Document
# and checks it with $doc->check.
sub dc
{
my ($xml) = @_;
require XML::DOM;
require XML::Checker;
local $XML::Checker::FAIL = \&my_fail;
local *XML::DOM::warning = \&append_str;
$error_str = "";
my $parser = new XML::DOM::Parser; # could pass options!
eval
{
my $doc = $parser->parsefile ("$xml.xml");
$doc->check; # could pass Checker with options!
$doc->dispose;
};
if ($@)
{
$error_str .= "PARSER TERMINATED: " . chop_exception($@);
}
$error_str;
}
# Script 'dv': uses XML::DOM::ValParser
sub dv
{
my ($xml) = @_;
require XML::DOM;
require XML::DOM::ValParser;
local $XML::Checker::FAIL = \&my_fail;
local *XML::DOM::warning = \&append_str;
$error_str = "";
my $parser = new XML::DOM::ValParser; # could pass options!
eval
{
my $doc = $parser->parsefile ("$xml.xml");
$doc->dispose;
};
if ($@)
{
$error_str .= "PARSER TERMINATED: " . chop_exception($@);
}
$error_str;
}
# Script 'sc': Uses XML::Parser::PerlSAX to parse and
# passes data onto the SAX interface of XML::Checker
sub sc
{
my ($xml) = @_;
require XML::Parser::PerlSAX;
require XML::Checker;
local $XML::Checker::FAIL = \&my_fail;
$error_str = "";
my $checker = new XML::Checker; # could pass options!
my $parser = new XML::Parser::PerlSAX (Handler => $checker);
if (open (STREAM, "$xml.xml"))
{
eval
{
$parser->parse (Source => { ByteStream => \*STREAM });
};
if ($@)
{
$error_str .= "PARSER TERMINATED: " . chop_exception($@);
}
close STREAM;
}
$error_str;
}