#!/usr/bin/perl -w
#
# $Revision: 1.1.1.1 $
#
# $Date: 2003/07/27 11:07:11 $

use XML::Parser;

my $Usage =<<'End_of_Usage;';
Usage is:
    xmlfilter [-h] [-nl] [{-+}root] [{-+}el=elname] [{-+}el:elnamepat]
              [{-+}att:attname] [{-+}att:attname:attvalpat] xmlfile

Prints on standard output the result of filtering the given xmlfile
for elements according to the switches. A '-' option will drop the
element from the output; a '+' will keep it. The output should also
be a well-formed XML document.

    -h		Print this message

    -nl         Emit a newline prior to every start tag.

    [-+]root	Drop (or keep) the root element. Defaults to keep.
		If the root element were named "foo", then -root
		would be equivalent to -el=foo. Note that even if
		you're dropping the root element, it's start and
		end tag are kept in order that the output remains
		a well-formed XML document.

    [-+]el=elname
		Drop (or keep) elements of type elname.

    [-+]el:elnamepat
		Drop (or keep) element whose type name matches elnamepat.

    [-+]att:attname
		Drop (or keep) elements which have an attribute = attname.

    [-+]att:attname:attvalpat
		Drop (or keep) elements which have an attribute = attname
		and for which the attribute value matches attvalpat.
End_of_Usage;

my $pass = 1;
my $do_newline = 0;

my $attcheck = 0;

my %drop_el;
my @drop_elpat;

my %keep_el;
my @keep_elpat;

my %drop_att;
my %keep_att;

my $always_true = sub {1;};
my $root_element = '';

my $in_cdata = 0;

# Process options

while (defined($ARGV[0]) and $ARGV[0] =~ /^[-+]/)
{
    my $opt = shift;

    if ($opt eq '-root')
    {
	$pass = 0;
    }
    elsif ($opt eq '+root')
    {
	$pass = 1;
    }
    elsif ($opt eq '-h')
    {
	print $Usage;
	exit;
    }
    elsif ($opt eq '-nl')
    {
	$do_newline = 1;
    }
    elsif ($opt =~ /^([-+])el([:=])(\S*)/)
    {
	my ($disp, $kind, $pattern) = ($1, $2, $3);
	my ($hashref, $aref);

	if ($disp eq '-')
	{
	    $hashref = \%drop_el;
	    $aref    = \@drop_elpat;
	}
	else
	{
	    $hashref = \%keep_el;
	    $aref    = \@keep_elpat;
	}

	if ($kind eq '=')
	{
	    $hashref->{$pattern} = 1;
	}
	else
	{
	    push(@$aref, $pattern);
	}
    }
    elsif ($opt =~ /^([-+])att:(\w+)(?::(\S*))?/)
    {
	my ($disp, $id, $pattern) = ($1, $2, $3);
	my $ref = ($disp eq '-') ? \%drop_att : \%keep_att;

	if (defined($pattern))
	{
	    $pattern =~ s!/!\\/!g;
	    my $sub;
	    eval "\$sub = sub {\$_[0] =~ /$pattern/;};";

	    $ref->{$id} = $sub;
	}
	else
	{
	    $ref->{$id} = $always_true;
	}

	$attcheck = 1;
    }
    else
    {
	die "Unknown option: $opt\n$Usage";
    }
}

my $drop_el_pattern = join('|', @drop_elpat);
my $keep_el_pattern = join('|', @keep_elpat);

my $drop_sub;
if ($drop_el_pattern)
{
    eval "\$drop_sub = sub {\$_[0] =~ /$drop_el_pattern/;}";
}
else
{
    $drop_sub = sub {};
}

my $keep_sub;
if ($keep_el_pattern)
{
    eval "\$keep_sub = sub {\$_[0] =~ /$keep_el_pattern/;}";
}
else
{
    $keep_sub = sub {};
}

my $doc = shift;

die "No file specified\n$Usage" unless defined($doc);

my @togglestack = ();

my $p = new XML::Parser(ErrorContext => 2,
			Handlers     => {Start => \&start_handler,
					 End   => \&end_handler
					 }
			);

if ($pass) {
  $p->setHandlers(Char       => \&char_handler,
		  CdataStart => \&cdata_start,
		  CdataEnd   => \&cdata_end);
}

$p->parsefile($doc);

print "</$root_element>\n"
    unless $pass;

################
## End of main
################

sub start_handler
{
    my $xp = shift;
    my $el = shift;

    unless ($root_element)
    {
	$root_element = $el;
	print "<$el>\n"
	    unless $pass;
    }

    my ($elref, $attref, $sub);

    if ($pass)
    {
	$elref = \%drop_el;
	$attref = \%drop_att;
	$sub = $drop_sub;
    }
    else
    {
	$elref = \%keep_el;
	$attref = \%keep_att;
	$sub = $keep_sub;
    }

    if (defined($elref->{$el})
	or &$sub($el)
	or check_atts($attref, @_))
    {
	$pass = ! $pass;
	if ($pass) {
	  $xp->setHandlers(Char       => \&char_handler,
			   CdataStart => \&cdata_start,
			   CdataEnd   => \&cdata_end);
	}
	else {
	  $xp->setHandlers(Char       => 0,
			   CdataStart => 0,
			   CdataEnd   => 0);
	}
	push(@togglestack, $xp->depth);
    }

    if ($pass)
    {
	print "\n" if $do_newline;
	print "<$el";
	while (@_)
	{
	    my $id = shift;
	    my $val = shift;

	    $val = $xp->xml_escape($val, "'");
	    print " $id='$val'";
	}
	print ">";
    }
}  # End start_handler

sub end_handler
{
    my $xp = shift;
    my $el = shift;

    if ($pass)
    {
	print "</$el>";
    }

    if (@togglestack and $togglestack[-1] == $xp->depth)
    {
	$pass = ! $pass;
	if ($pass) {
	  $xp->setHandlers(Char       => \&char_handler,
			   CdataStart => \&cdata_start,
			   CdataEnd   => \&cdata_end);
	}
	else {
	  $xp->setHandlers(Char       => 0,
			   CdataStart => 0,
			   CdataEnd   => 0);
	}

	pop(@togglestack);
    }

}  # End end_handler


sub char_handler
{
    my ($xp, $text) = @_;

    if (length($text)) {

      $text = $xp->xml_escape($text, '>')
	unless $in_cdata;

      print $text;
    }
}  # End char_handler

sub cdata_start {
  my $xp = shift;

  print '<![CDATA[';
  $in_cdata = 1;
}

sub cdata_end {
  my $xp = shift;

  print ']]>';
  $in_cdata = 0;
}

sub check_atts
{
    return $attcheck unless $attcheck;

    my $ref = shift;

    while (@_)
    {
	my $id = shift;
	my $val = shift;

	if (defined($ref->{$id}))
	{
	    my $ret = &{$ref->{$id}}($val);
	    return $ret if $ret;
	}
    }

    return 0;
}  # End check_atts

# Tell Emacs that this is really a perl script
# Local Variables:
# mode:perl
# End: