#!/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:
Generated by dwww version 1.15 on Sun Jun 30 10:43:38 CEST 2024.