#!/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__
1 2 3
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