#!/usr/bin/perl
use 5.018;
use strict;
use warnings;
use XML::Twig;
{
my $t;
my $pos = tell 'DATA'; # save the offset...
# Process fruit
open (my $FRUIT, '>', './fruit.xml') or die "./fruit.xml:\n$!\n$^E";
$t = XML::Twig->new(
twig_handlers => {
'thing' => sub { _filter(@_, 'fruit', $FRUIT); 1; },
'thing//*' => sub { 1; },
'_default_' => sub { $_[0]->flush($FRUIT); 1; },
'#CDATA' => sub { 1; },
},
pretty_print => 'indented',
comments => 'drop', # remove any comments
empty_tags => 'normal',# empty tags =
);
$t->parse(*DATA);
close $FRUIT;
seek 'DATA', $pos, 0; # reset DATA for the second run-through
# Process vegetables
open (my $VEG, '>', './veg.xml') or die "./veg.xml:\n$!\n$^E";
$t = XML::Twig->new(
twig_handlers => {
'thing' => sub { _filter(@_, 'vegetable', $VEG); 1; },
'thing//*' => sub { 1; },
'_default_' => sub { $_[0]->flush($VEG); 1; },
'#CDATA' => sub { 1; },
},
pretty_print => 'indented',
comments => 'drop', # remove any comments
empty_tags => 'normal',# empty tags =
);
$t->parse(*DATA);
close $VEG;
}
sub _filter {
my ($_twig, $thing_element, $keep_me, $PRINT_FILE) = @_;
# Flush the twig to file if the 'type' attribute matches...
if ( $thing_element->{att}{type} eq $keep_me ) {
$_twig->flush($PRINT_FILE);
}
# ... otherwise delete the twig
else {
$thing_element->delete();
}
return 1;
}
__DATA__
Im an apple!
Toronto
Im a carrot!
Melrose
Im a potato!
Im a pear!
Im a pickle!
Patna
Im a banana!
Im an eggplant!
Taumatawhakatangihangakoauauotamateaturipukakapikimaungahoronukupokaiwhenuakitanatahu
A
B
####
perl -v
This is perl 5, version 18, subversion 2 (v5.18.2) built for MSWin32-x64-multi-thread
(with 1 registered patch, see perl -V for more detail)
####
perl -MXML::Twig -E "say $XML::Twig::VERSION;"
3.48