#!/usr/local/bin/perl -- # -*- Perl -*-

# TODO: handle xsl:import
# TODO: handle use of namespace prefixes other than xsl: and fo:
# TODO: check for text inside of apply-templates

$VERSION = "0.05";

use strict;
use vars qw($VERSION %option);
use Getopt::Long ();
use XML::DOM 1.27 ();

my $usage = "XSLint version $VERSION\nUsage: $0 [ options ] ssheet[.xsl]\n";

#http://www.w3.org/TR/xsl/slice6.html#section-N8348-Formatting-Objects-Summary
#http://www.w3.org/TR/xsl/sliceE.html

# ======================================================================

my %fo_elements =
  ( 'basic-link' => 1, # new in WD-xsl-20001018
    'bidi-override' => 1,
    'block' => 1,
    'block-container' => 1,
    'character' => 1,
    'color-profile' => 1,
    'conditional-page-master-reference' => 1,
    'declarations' => 1,
    'external-graphic' => 1,
    'float' => 1,
    'flow' => 1,
    'footnote' => 1,
    'footnote-body' => 1,
    'initial-property-set' => 1,
    'inline' => 1,
    'inline-container' => 1,
    'instream-foreign-object' => 1,
    'layout-master-set' => 1,
    'leader' => 1,
    'list-block' => 1,
    'list-item' => 1,
    'list-item-body' => 1,
    'list-item-label' => 1,
    'marker' => 1,
    'multi-case' => 1,
    'multi-properties' => 1,
    'multi-property-set' => 1,
    'multi-switch' => 1,
    'multi-toggle' => 1,
    'page-number' => 1,
    'page-number-citation' => 1,
    'page-sequence' => 1,
    'page-sequence-master' => 1,
    'region-after' => 1,
    'region-before' => 1,
    'region-body' => 1,
    'region-end' => 1,
    'region-start' => 1,
    'repeatable-page-master-alternatives' => 1,
    'repeatable-page-master-reference' => 1,
    'retrieve-marker' => 1,
    'root' => 1,
    'simple-link' => 'was replaced by basic-link in WD-xsl-20001018',
    'simple-page-master' => 1,
    'single-page-master-reference' => 1,
    'static-content' => 1,
    'table' => 1,
    'table-and-caption' => 1,
    'table-body' => 1,
    'table-caption' => 1,
    'table-cell' => 1,
    'table-column' => 1,
    'table-footer' => 1,
    'table-header' => 1,
    'table-row' => 1,
    'title' => 1,
    'wrapper' => 1,
  );

my %fo_properties =
  ( 'absolute-position' => 1,
    'active-state' => 1,
    'alignment-adjust' => 1,
    'alignment-baseline' => 1, # new in WD-xsl-20001018
    'auto-restore' => 1,
    'azimuth' => 1,
    'background' => 1,
    'background-attachment' => 1,
    'background-color' => 1,
    'background-image' => 1,
    'background-position' => 1,
    'background-position-horizontal' => 1,
    'background-position-vertical' => 1,
    'background-repeat' => 1,
    'baseline-identifier' => 'was replaced by alignment-baseline in WD-xsl-20001018',
    'baseline-shift' => 1,
    'blank-or-not-blank' => 1,
    'block-progression-dimension' => 1,
    'border' => 1,
    'border-after-color' => 1,
    'border-after-precedence' => 1, # new in WD-xsl-20001018
    'border-after-style' => 1,
    'border-after-width' => 1,
    'border-before-color' => 1,
    'border-before-precedence' => 1, # new in WD-xsl-20001018
    'border-before-style' => 1,
    'border-before-width' => 1,
    'border-bottom' => 1,
    'border-bottom-color' => 1,
    'border-bottom-style' => 1,
    'border-bottom-width' => 1,
    'border-collapse' => 1,
    'border-color' => 1,
    'border-end-color' => 1,
    'border-end-precedence' => 1, # new in WD-xsl-20001018
    'border-end-style' => 1,
    'border-end-width' => 1,
    'border-left' => 1,
    'border-left-color' => 1,
    'border-left-style' => 1,
    'border-left-width' => 1,
    'border-right' => 1,
    'border-right-color' => 1,
    'border-right-style' => 1,
    'border-right-width' => 1,
    'border-separation' => 1,
    'border-spacing' => 1,
    'border-start-color' => 1,
    'border-start-precedence' => 1, # new in WD-xsl-20001018
    'border-start-style' => 1,
    'border-start-width' => 1,
    'border-style' => 1,
    'border-top' => 1,
    'border-top-color' => 1,
    'border-top-style' => 1,
    'border-top-width' => 1,
    'border-width' => 1,
    'bottom' => 1,
    'break-after' => 1,
    'break-before' => 1,
    'caption-side' => 1,
    'case-name' => 1,
    'case-title' => 1,
    'character' => 1,
    'clear' => 1,
    'clip' => 1,
    'color' => 1,
    'color-profile-name' => 1,
    'column-count' => 1,
    'column-gap' => 1,
    'column-number' => 1,
    'column-width' => 1,
    'content-height' => 1,
    'content-type' => 1,
    'content-width' => 1,
    'country' => 1,
    'cue' => 1,
    'cue-after' => 1,
    'cue-before' => 1,
    'destination-placement-offset' => 1,
    'direction' => 1,
    'display-align' => 1,
    'dominant-baseline' => 1,
    'elevation' => 1,
    'empty-cells' => 1,
    'end-indent' => 1,
    'ends-row' => 1,
    'extent' => 1,
    'external-destination' => 1,
    'float' => 1,
    'flow-name' => 1,
    'font' => 1,
    'font-family' => 1,
    'font-height-override-after' => 'was removed in CR-xsl-20001121',
    'font-height-override-before' => 'was removed in CR-xsl-20001121',
    'font-selection-strategy' => 1, # new in WD-xsl-20001018
    'font-size' => 1,
    'font-size-adjust' => 1,
    'font-stretch' => 1,
    'font-style' => 1,
    'font-variant' => 1,
    'font-weight' => 1,
    'force-page-count' => 1,
    'format' => 1,
    'glyph-orientation-horizontal' => 1,
    'glyph-orientation-vertical' => 1,
    'grouping-separator' => 1,
    'grouping-size' => 1,
    'height' => 1,
    'hyphenate' => 1,
    'hyphenation-character' => 1,
    'hyphenation-keep' => 1,
    'hyphenation-ladder-count' => 1,
    'hyphenation-push-character-count' => 1,
    'hyphenation-remain-character-count' => 1,
    'id' => 1,
    'indicate-destination' => 1,
    'initial-page-number' => 1,
    'inline-progression-dimension' => 1,
    'internal-destination' => 1,
    'keep-together' => 1,
    'keep-with-next' => 1,
    'keep-with-previous' => 1,
    'language' => 1,
    'last-line-end-indent' => 1,
    'leader-alignment' => 1,
    'leader-length' => 1,
    'leader-pattern' => 1,
    'leader-pattern-width' => 1,
    'left' => 1,
    'letter-spacing' => 1,
    'letter-value' => 1,
    'line-height' => 1,
    'line-height-shift-adjustment' => 1,
    'line-stacking-strategy' => 1,
    'linefeed-treatment' => 1,
    'margin' => 1,
    'margin-bottom' => 1,
    'margin-left' => 1,
    'margin-right' => 1,
    'margin-top' => 1,
    'marker-class-name' => 1,
    'master-name' => 1,
    'max-height' => 1,
    'max-width' => 1,
    'maximum-repeats' => 1,
    'min-height' => 1,
    'min-width' => 1,
    'number-columns-repeated' => 1,
    'number-columns-spanned' => 1,
    'number-rows-spanned' => 1,
    'odd-or-even' => 1,
    'orphans' => 1,
    'overflow' => 1,
    'padding' => 1,
    'padding-after' => 1,
    'padding-before' => 1,
    'padding-bottom' => 1,
    'padding-end' => 1,
    'padding-left' => 1,
    'padding-right' => 1,
    'padding-start' => 1,
    'padding-top' => 1,
    'page-break-after' => 1,
    'page-break-before' => 1,
    'page-break-inside' => 1,
    'page-height' => 1,
    'page-position' => 1,
    'page-width' => 1,
    'pause' => 1,
    'pause-after' => 1,
    'pause-before' => 1,
    'pitch' => 1,
    'pitch-range' => 1,
    'play-during' => 1,
    'position' => 1,
    'precedence' => 1,
    'provisional-distance-between-starts' => 1,
    'provisional-label-separation' => 1,
    'ref-id' => 1,
    'reference-orientation' => 1,
    'region-name' => 1,
    'relative-align' => 1,
    'relative-position' => 1,
    'rendering-intent' => 1,
    'retrieve-boundary' => 1,
    'retrieve-class-name' => 1,
    'retrieve-position' => 1,
    'richness' => 1,
    'right' => 1,
    'role' => 1,
    'rule-style' => 1,
    'rule-thickness' => 1,
    'scaling' => 1,
    'scaling-method' => 1,
    'score-spaces' => 1,
    'script' => 1,
    'show-destination' => 1,
    'size' => 1,
    'source-document' => 1,
    'space-after' => 1,
    'space-before' => 1,
    'space-end' => 1,
    'space-start' => 1,
    'space-treatment' => 1,
    'span' => 1,
    'speak' => 1,
    'speak-header' => 1,
    'speak-numeral' => 1,
    'speak-punctuation' => 1,
    'speech-rate' => 1,
    'src' => 1,
    'start-indent' => 1,
    'starting-state' => 1,
    'starts-row' => 1,
    'stress' => 1,
    'suppress-at-line-break' => 1,
    'switch-to' => 1,
    'table-layout' => 1,
    'table-omit-footer-at-break' => 1,
    'table-omit-header-at-break' => 1,
    'target-presentation-context' => 1, # new in WD-xsl-20001018
    'target-processing-context' => 1, # new in WD-xsl-20001018
    'target-stylesheet' => 1, # new in WD-xsl-20001018
    'text-align' => 1,
    'text-align-last' => 1,
    'text-altitude' => 1, # new in CR-xsl-20001121
    'text-decoration' => 1,
    'text-depth' => 1, # new in CR-xsl-20001121
    'text-indent' => 1,
    'text-shadow' => 1,
    'text-transform' => 1,
    'top' => 1,
    'treat-as-word-space' => 1,
    'unicode-bidi' => 1,
    'vertical-align' => 1,
    'visibility' => 1,
    'voice-family' => 1,
    'volume' => 1,
    'white-space' => 1,
    'white-space-collapse' => 1,
    'widows' => 1,
    'width' => 1,
    'word-spacing' => 1,
    'wrap-option' => 1,
    'writing-mode' => 1,
    # TODO: 'xml:lang' => 1, ???
    'z-index' => 1,
  );

# ======================================================================


%option = ('informative' => 0,
	   'warning' => 1,
	   'error' => 1,
	   'verbose' => 0);

my %opt = ();
Getopt::Long::GetOptions(\%opt,
	    'flat=s',
	    'informative!',
	    'warning!',
	    'error!',
	    'verbose+') || die $usage;

foreach my $key (keys %option) {
    $option{$key} = $opt{$key} if exists $opt{$key};
}
$option{'flat'} = $opt{'flat'};

my $XSLFILE = shift @ARGV || die $usage;

$XSLFILE .= ".xsl" if ! -f $XSLFILE && -f $XSLFILE . ".xsl";

die $usage if ! -f $XSLFILE;

my $RETVAL = 0;
my $parser = new XML::DOM::Parser (NoExpand => 0);

&status("Loading $XSLFILE...");
my $doc;
eval {
  $doc = $parser->parsefile($XSLFILE);
};
parserDieHandler($@) if $@;

#&status("Merging <xsl:include>s");
&merge_includes($doc, $XSLFILE);

&status("Building <xsl:import> tree");
&merge_imports($doc, $XSLFILE);

$doc->printToFile($option{'flat'}) if $option{'flat'};

&status("Analyzing...");

my %bymode  = ();
my %byname  = ();
my %bymatch = ();

my %modes_used = ();
my %names_used = ();

my $template_list = $doc->getElementsByTagName('xsl:template');
my $apply_list    = $doc->getElementsByTagName('xsl:apply-templates');
my $call_list     = $doc->getElementsByTagName('xsl:call-template');

for (my $count = 0; $count < $template_list->getLength(); $count++) {
    my $template = $template_list->item($count);
    my $mode  = $template->getAttribute('mode');
    my $name  = $template->getAttribute('name');
    my $match = $template->getAttribute('match');

    if ($mode) {
	if ($match) {
	    my @matches = split(/\|/, $match);
	    foreach $match (@matches) {
		$bymode{$mode} = [] if !exists $bymode{$mode};
		push(@{$bymode{$mode}}, $template);
	    }
	} else {
	    &report($template, 'W', "mode without match");
	}
    }

    if ($match) {
	my @matches = split(/\|/, $match);
	foreach $match (@matches) {
	    $bymatch{$match} = [] if !exists $bymatch{$match};
	    push(@{$bymatch{$match}}, $template);
	}
    }

    if ($name) {
	$byname{$name} = [] if !exists $byname{$name};
	if ($name =~ /\[\]\|\//s) {
	    &report($template, 'W', "name looks like a match pattern");
	} else {
	    push(@{$byname{$name}}, $template);
	}
    }
}

# Check for duplicate match patterns
foreach my $match (sort keys %bymatch) {
    my @templates = @{$bymatch{$match}};
    my %modes = ();

    # split them out by mode, because they might all be in different modes

    foreach my $template (@templates) {
	my $mode = $template->getAttribute('mode');

	$mode = "*" unless $mode;

	$modes{$mode} = [] if !exists $modes{$mode};
	push(@{$modes{$mode}}, $template);
    }

    foreach my $mode (sort keys %modes) {
	my @templates = @{$modes{$mode}};
	next if $#templates < 1;
	my $first = 1;

	for (my $count = $#templates; $count >= 0; $count--) {
	    if ($first) {
		&report($templates[$count], 'W',
			"overrides previous templates for same pattern");
		$first = 0;
	    } else {
		&report($templates[$count], 'W',
			"is overridden by later template(s)");
	    }
	}
    }
}

# Check that all applied modes actually exist
for (my $count = 0; $count < $apply_list->getLength(); $count++) {
    my $apply = $apply_list->item($count);
    my $mode  = $apply->getAttribute('mode');

    next if !$mode;

    $modes_used{$mode} = [] if !exists $modes_used{$mode};
    push (@{$modes_used{$mode}}, $apply);

    if (!exists $bymode{$mode}) {
	&report($apply, 'E', "no templates in mode $mode");
    }
}

# Check that all modes are actually applied
foreach my $mode (sort keys %bymode) {
    if (!exists $modes_used{$mode}) {
	my @templates = @{$bymode{$mode}};
	my $template = $templates[0];

	&report($template, 'W', "mode $mode is never used");
    }
}

# Check that all called templates actually exist
for (my $count = 0; $count < $call_list->getLength(); $count++) {
    my $call = $call_list->item($count);
    my $name = $call->getAttribute('name');

    if ($name) {
	$names_used{$name} = [] if !exists $names_used{$name};
	push (@{$names_used{$name}}, $call);

	if (!exists $byname{$name}) {
	    &report($call, 'E', "there is no template named $name");
	    if (exists $bymatch{$name}) {
		my $template = $bymatch{$name}->[0];
		&report($template, 'W', "perhaps match should be name?",
			$option{'error'});
	    }
	}
    } else {
	&report($call, 'E', "call-template with no name");
    }
}

# Check that all names are actually used
foreach my $name (sort keys %byname) {
    if (!exists $names_used{$name}) {
	my @templates = @{$byname{$name}};
	my $template = $templates[0];

	&report($template, 'W', "named template $name is never called");
    }
}

# Check that call-template's don't contain anything but with-param's
for (my $count = 0; $count < $call_list->getLength(); $count++) {
    my $call = $call_list->item($count);

    my $child = $call->getFirstChild();
    while ($child) {
	if ($child->getNodeType() == XML::DOM::ELEMENT_NODE()) {
	    if ($child->getTagName() ne 'xsl:with-param') {
		&report($call, 'E', "call-template contains "
			            . $child->getTagName());
	    }
	}
	$child = $child->getNextSibling();
    }
}

# check for variables...
&status("Checking variable and parameter usage...");

my %globals    = ();
my $stylesheet = $doc->getDocumentElement();
my $child      = $stylesheet->getFirstChild();
while ($child) {
    if ($child->getNodeType != XML::DOM::ELEMENT_NODE()) {
	$child = $child->getNextSibling();
	next;
    }

    if ($child->getTagName() eq 'xsl:variable'
	|| $child->getTagName() eq 'xsl:param') {
	my $name = $child->getAttribute('name');

	if ($name eq '') {
	    &report($child, 'E', "variable without name");
	} else {
	    &report($child, 'I', "defines global $name");

	    if (!exists($globals{$name})) {
		@{$globals{$name}} = ();
	    }
	    my @stack = @{$globals{$name}};

	    if ($#stack >= 0 && $option{'warning'}) {
		&report($child, 'W',
			"definition of $name shadows previous definition");

		my $prev = $stack[0];
		&report($prev, 'W', "previous definition is here");
	    }

	    push (@stack, $child);
	    @{$globals{$name}} = @stack;
	}
    }
    $child = $child->getNextSibling();
}

for (my $count = 0; $count < $template_list->getLength(); $count++) {
    my $template = $template_list->item($count);
    &check_variables($template, %globals);
}

# check for legal FOs
&status("Checking fo: elements...");
&check_fo($doc->getDocumentElement());

exit($RETVAL);

# ======================================================================

sub check_variables {
    my $node = shift;
    my %locals = @_;
    my $child = $node->getFirstChild();

    while ($child) {
	if ($child->getNodeType() != XML::DOM::ELEMENT_NODE()) {
	    $child = $child->getNextSibling();
	    next;
	}
	# handle variable declarations

	if ($child->getTagName() eq 'xsl:variable'
	    || $child->getTagName() eq 'xsl:param') {

	    # special case, process the children first so we don't
	    # miss circular definitions...
	    &check_variables($child, %locals);

	    my $name = $child->getAttribute('name');
	    if ($name eq '') {
		&report($child, 'E', "variable without name");
	    } else {
		&report($child, 'I', "defines $name");
		if (!exists($locals{$name})) {
		    @{$locals{$name}} = ();
		}
		my @stack = @{$locals{$name}};

		if ($#stack >= 0 && $option{'warning'}) {
		    &report($child, 'W',
			    "definition of $name shadows previous definition");
		    my $prev = $stack[0];
		    &report($prev, 'W', "previous definition is here");
		}

		push (@stack, $child);
		@{$locals{$name}} = @stack;
	    }
	}

	# handle expression attributes

	if ($child->getTagName() eq 'xsl:apply-templates'
	    || $child->getTagName() eq 'xsl:value-of'
	    || $child->getTagName() eq 'xsl:for-each'
	    || $child->getTagName() eq 'xsl:sort') {
	    my $select = $child->getAttribute('select');
	    while ($select =~ /\$([A-Za-z\-\.\_0-9]+)/) {
		my $name = $1;
		&report($child, 'E', "undeclared variable $name used")
		    if !exists($locals{$name});

		$select = $` . $';
	    }
	}

	if ($child->getTagName() eq 'xsl:number') {
	    my $select = $child->getAttribute('value');
	    while ($select =~ /\$([A-Za-z\-\.\_0-9]+)/) {
		my $name = $1;
		&report($child, 'E', "undeclared variable $name used")
		    if !exists($locals{$name});

		$select = $` . $';
	    }
	}

	if ($child->getTagName() eq 'xsl:if'
	    || $child->getTagName() eq 'xsl:when') {
	    my $select = $child->getAttribute('test');
	    while ($select =~ /\$([A-Za-z\-\.\_0-9]+)/) {
		my $name = $1;
		&report($child, 'E', "undeclared variable $name used")
		    if !exists($locals{$name});

		$select = $` . $';
	    }
	}

	# now handle AVTs
	my $attributes = $child->getAttributes();
	for (my $count = 0; $count < $attributes->getLength(); $count++) {
	    my $attr = $attributes->item($count);
	    my $name = $attr->getName();

	    if ($child->getTagName() eq 'xsl:element'
		|| $child->getTagName() eq 'xsl:attribute') {
		next unless ($name eq 'name'
			     || $name eq 'namespace');
	    }

	    if ($child->getTagName() eq 'xsl:number') {
		next unless ($name eq 'level'
			     || $name eq 'count'
			     || $name eq 'from'
			     || $name eq 'lang'
			     || $name eq 'grouping-separator'
			     || $name eq 'grouping-size'
			     || $name eq 'format');
	    }

	    if ($child->getTagName() eq 'xsl:sort') {
		next unless ($name eq 'lang'
			     || $name eq 'order'
			     || $name eq 'data-type'
			     || $name eq 'case-order');
	    }

	    if ($child->getTagName() eq 'xsl:processing-instruction') {
		next unless ($name eq 'name');
	    }

	    my $value = $attr->getValue();
	    while ($value =~ /\{\$([A-Za-z\-\.\_0-9]+)\}/) {
		my $name = $1;
		&report($child, 'E', "undeclared variable $name used")
		    if !exists($locals{$name});
		$value = $` . $';
	    }
	}

	# now check my descendants...
	&check_variables($child, %locals);
	$child = $child->getNextSibling();
    }
}

# ======================================================================

sub merge_includes {
    my $doc     = shift;
    my $file    = shift;
    my $dir     = $file;
    my $inclist = $doc->getElementsByTagName('xsl:include');
    my $docroot = $doc->getDocumentElement();

    $dir =~ s/\\/\//g;             # \ into /
    $dir = "." if ($dir !~ /\//);  # if there's no path, use cwd
    $dir =~ s/^(.*)\/[^\/]+$/$1/;  # /some/path/file.xsl into /some/path

    for (my $count = 0; $count < $inclist->getLength(); $count++) {
	my $inc = $inclist->item($count);
	my $href = $inc->getAttribute('href');

	$href =~ s/\\/\//g; # \ into /
	$href = "$dir/$href" if (($href !~ /^\//) && ($href !~ /^[a-z]:/i));

	&status("Loading $href...");

  my $incdoc;
  eval {
    $incdoc = $parser->parsefile($href);
  };
  parserDieHandler($@, $inc) if $@;

#	&status("Merging <xsl:include>s");

	&merge_includes($incdoc, $href);

#	&status("Performing DOM merge...");

	my $root  = $incdoc->getDocumentElement(); # <xsl:stylesheet>

	# test for proper attributes...
	my $ns = $root->getTagName();
	if ($ns !~ /^([^:]+):stylesheet$/) {
	    # this should be a warning, but I'm not sure xslint handles
	    # this case very well, so I'm leaving it an error...
	    &report($root, 'E', "expected [xsl]:stylesheet but got $ns");
	} else {
	    $ns = $1;
	    my $uri   = $root->getAttribute("xmlns:$ns");
	    my $vers  = $root->getAttribute("version");

	    if ($uri ne "http://www.w3.org/1999/XSL/Transform") {
		&report($root, 'E', "wrong XSL URI: $uri");
	    }

	    if ($vers ne "1.0") {
		&report($root, 'W', "expected version '1.0' but got '$vers'");
	    }
	}

	my $child = $root->getFirstChild();
	while ($child) {
	    my $next = $child->getNextSibling();

	    if ($child->getNodeType() == XML::DOM::ELEMENT_NODE()) {
		my $node = $root->removeChild($child);
		$node->setOwnerDocument($doc);
		$docroot->insertBefore($node,$inc);
	    }
	    $child = $next;
	}

	$docroot->removeChild($inc);
    }
}

# ======================================================================

sub merge_imports {
    my $doc     = shift;
    my $file    = shift;
    my $dir     = $file;
    my $implist = $doc->getElementsByTagName('xsl:import');
    my $docroot = $doc->getDocumentElement();

    $dir =~ s/\\/\//g;             # \ into /
    $dir = "." if ($dir !~ /\//);  # if there's no path, use cwd
    $dir =~ s/^(.*)\/[^\/]+$/$1/;  # /some/path/file.xsl into /some/path

    for (my $count = 0; $count < $implist->getLength(); $count++) {
	my $imp = $implist->item($count);
	my $href = $imp->getAttribute('href');

	my $file  = $XSLFILE;
	my $line  = $imp->xslint_getLineNumber();
	my $col   = $imp->xslint_getColumnNumber();

	&report($imp, 'E', "xslint doesn't handle import yet, $href ignored.");
    }
}

# ======================================================================

sub status {
  my ($msg, $force) = @_;
  return unless $force || $option{'verbose'};
  $msg = "" unless defined $msg;
  $msg =~ s/[\r\n]*$/\n/;
  print $msg;
}

sub report {
    my $node = shift;
    my $type = shift;
    my $message = shift;
    my $force = shift;
    my $line = shift;
    my $col = shift;

    return if ($type eq 'I') && !$option{'informative'} && !$force;

    if ($type eq 'W') {
      return if !$option{'warning'} && !$force;
      $RETVAL = 1 if $RETVAL < 2;
    }

    if ($type eq 'E') {
      return if !$option{'error'} && !$force;
      $RETVAL = 2;
    }

    my $file = $XSLFILE;
    $line = $node ? $node->xslint_getLineNumber() : 1 unless defined $line;
    $col = $node ? $node->xslint_getColumnNumber() : 1 unless defined $col;

    &status("$file:$type:$line:$col: $message", 1, 1);
}

# ======================================================================

sub check_fo
{
  my $node = shift;
  return if !$node;
  return if $node->getNodeType != XML::DOM::ELEMENT_NODE();

  if ($node->getTagName() =~ /^fo:/) {
    my $fo = $';

    if ($fo_elements{$fo}) {

      if ($fo_elements{$fo} != 1) {
        report($node, 'W', "formatting object $fo $fo_elements{$fo}");
      }
	    my $attributes = $node->getAttributes();
	    for (my $count = 0; $count < $attributes->getLength(); $count++) {
        my $attr = $attributes->item($count);
        my $name = $attr->getName();

        # we don't handle structured properties yet
        # (space-before.maximum, etc.)
        $name = $1 if $name =~ /^(.*)\./;

        if (!$fo_properties{$name}) {
          report($node, 'W', "unknown formatting object property: $name");
        } elsif ($fo_properties{$name} != 1) {
          report($node, 'W',
                 "formatting object property $name $fo_properties{$name}");
        }
	    }
    } else {
	    report($node, 'W', "unknown formatting object: $fo");
    }
  }

  my $child = $node->getFirstChild();
  while ($child) {
    check_fo($child);
    $child = $child->getNextSibling();
  }
}

# ======================================================================

sub parserDieHandler
{
  my ($err, $element) = @_;
  $err =~ s/[\r\n]+/ /g;
  $err =~ s/^\s+//;
  $err =~ s/\s+$//;

  if (my ($msg, $line, $col, $byte) =
      ($err =~ /^(.+) at line (\d+), column (\d+), byte (\d+) at /)) {
    report($element, 'E', "$msg\n", 0, $line, $col);
    exit($RETVAL);

  } elsif (($msg) = ($err =~ /^(.+) at .+? line /)) {
    report($element, 'E', "$msg\n");
    exit($RETVAL);

  } else {
    report($element, 'E', "$err\n");
    exit($RETVAL);
  }
}

# ======================================================================

#########################################################################
# HACK HACK HACK HACK HACK HACK HACK HACK HACK HACK HACK HACK HACK HACK #
#########################################################################

{
    package XML::Parser::Dom;

    sub Start
    {
        my ($expat, $elem, @attr) = @_;
        my $parent = $_DP_elem;
        my $doc = $_DP_doc;

        if ($parent == $doc)
        {
            # End of document prolog, i.e. start of first Element
            $_DP_in_prolog = 0;
        }

        undef $_DP_last_text;
        my $node = $doc->createElement ($elem);
        $_DP_elem = $node;
        $parent->appendChild ($node);

    $node->[1000] = $expat->current_line();
    $node->[1001] = $expat->current_column();

    my $n = @attr;
    return unless $n;

    # Add attributes
        my $first_default = $expat->specified_attr;
        my $i = 0;
        while ($i < $n)
        {
            my $specified = $i < $first_default;
            my $name = $attr[$i++];
            undef $_DP_last_text;
            my $attr = $doc->createAttribute ($name, $attr[$i++], $specified);
            $node->setAttributeNode ($attr);
        }
    }
}

{
  package XML::DOM::Element;

  sub xslint_getLineNumber {
    return $_[0]->[1000];
  }

  sub xslint_getColumnNumber {
    return $_[0]->[1001];
  }

}

#########################################################################
#/HACK HACK HACK HACK HACK HACK HACK HACK HACK HACK HACK HACK HACK HACK #
#########################################################################