#!perl -T use strict; use warnings; use Test::More tests => 7; use XML::Rules; my $xml = <<'*END*'; Jane Luser JLuser@bogus.com
Washington st. Old Creek & Pond The US bleargh
123-456-7890 663-486-7890 663-486-7000
John&Mary Other JOther@silly.com
Grant's st. New Creek Canada sdrysdfgtyh degtrhy degtrhy werthywerthy drthyu
663-486-7891
*END* { #1 my $parser = new XML::Rules ( style => 'filter', rules => [ # '^phone' => sub {return exists($_[1]->{type}) and $_[1]->{type} eq 'office'}, 'phone' => sub { return unless $_[1]->{type} eq 'office'; return $_[0] => $_[1]; } ] ); my $res = ''; open my $FH, '>', \$res; $parser->filterstring($xml, $FH); close $FH; (my $correct = $xml) =~ s{[^<]+}{}g; is($res, $correct, "Remove tag according to attribute"); #open my $F, '>', 'test_mine.txt';print $F $res;close $F; #open $F, '>', 'test_correct.txt';print $F $correct;close $F; } { #2 my $parser = new XML::Rules ( style => 'filter', rules => [ '^phone' => sub {return (exists($_[1]->{type}) and $_[1]->{type} eq 'office')}, ] ); my $res = ''; open my $FH, '>', \$res; $parser->filterstring($xml, $FH); close $FH; #print $res; #exit; (my $correct = $xml) =~ s{[^<]+}{}g; is($res, $correct, "Remove tag according to attribute using start rule"); #open my $F, '>', 'test_mine.txt';print $F $res;close $F; #open $F, '>', 'test_correct.txt';print $F $correct;close $F; } { #3 my $parser = new XML::Rules ( style => 'filter', rules => [ 'fname' => sub { $_[1]->{_content} = ":" . $_[1]->{_content} . ":"; return $_[0] => $_[1]; }, ] ); my $res = ''; open my $FH, '>', \$res; $parser->filterstring($xml, $FH); close $FH; (my $correct = $xml) =~ s{([^<]+)}{:$1:}g; is($res, $correct, "Tweak the content of "); #open my $F, '>', 'test_mine.txt';print $F $res;close $F; #open $F, '>', 'test_correct.txt';print $F $correct;close $F; } { #4 my $parser = new XML::Rules ( style => 'filter', rules => [ 'fname' => sub {return 'firstname' => $_[1]}, 'lname' => sub {return 'lastname' => $_[1]}, ] ); my $res = ''; open my $FH, '>', \$res; $parser->filterstring($xml, $FH); close $FH; (my $correct = $xml) =~ s{([^<]+)}{$1}g; $correct =~ s{([^<]+)}{$1}g; is($res, $correct, "Change to and to "); #open my $F, '>', 'test_mine.txt';print $F $res;close $F; #open $F, '>', 'test_correct.txt';print $F $correct;close $F; } { #5 my $parser = new XML::Rules ( style => 'filter', rules => [ 'phone' => sub {$_[1]->{type} => $_[1]->{_content}}, 'phones' => sub { if (exists $_[1]->{home}) { return 'phone' => $_[1]->{home} } else { return 'phone' => $_[1]->{office} } }, ] ); my $res = ''; open my $FH, '>', \$res; $parser->filterstring($xml, $FH); close $FH; (my $correct = $xml) =~ s{.*?}{123-456-7890}s; $correct =~ s{.*?}{663-486-7891}s; is($res, $correct, "Change to a single using the home or office phone"); #open my $F, '>', 'test_mine.txt';print $F $res;close $F; #open $F, '>', 'test_correct.txt';print $F $correct;close $F; } { #6 my $parser = new XML::Rules ( style => 'filter', ident => ' ', rules => [ 'phone' => sub {$_[1]->{_content} = "(1)" . $_[1]->{_content}; return $_[1]->{type} => [$_[1]->{_content}]}, 'phones' => sub { delete $_[1]->{_content}; $_[1]->{home} = ['not_specified'] unless exists $_[1]->{home}; $_[1]->{office} = ['not_specified'] unless exists $_[1]->{office}; $_[1]->{fax} = ['not_specified'] unless exists $_[1]->{fax}; return $_[0] => $_[1]; }, ] ); my $res = ''; open my $FH, '>', \$res; $parser->filterstring($xml, $FH); close $FH; my $correct = <<'*END*'; Jane Luser JLuser@bogus.com
Washington st. Old Creek & Pond The US bleargh
(1)663-486-7000 (1)123-456-7890 (1)663-486-7890
John&Mary Other JOther@silly.com
Grant's st. New Creek Canada sdrysdfgtyh degtrhy degtrhy werthywerthy drthyu
not_specified not_specified (1)663-486-7891
*END* is($res, $correct, "Change to a tags and include all types"); #open my $F, '>', 'test_mine.txt';print $F $res;close $F; #open $F, '>', 'test_correct.txt';print $F $correct;close $F; } { #7 my $parser = new XML::Rules ( style => 'filter', ident => ' ', rules => [ 'phone' => sub {$_[1]->{_content} = "(1)" . $_[1]->{_content}; return $_[1]->{type} => [$_[1]->{_content}]}, ] ); my $res = ''; open my $FH, '>', \$res; $parser->filterstring($xml, $FH); close $FH; my $correct = <<'*END*'; Jane Luser JLuser@bogus.com
Washington st. Old Creek & Pond The US bleargh
(1)123-456-7890 (1)663-486-7890 (1)663-486-7000
John&Mary Other JOther@silly.com
Grant's st. New Creek Canada sdrysdfgtyh degtrhy degtrhy werthywerthy drthyu
(1)663-486-7891
*END* is($res, $correct, "Change to a tags and include all types"); #open my $F, '>', 'test_mine.txt';print $F $res;close $F; #open $F, '>', 'test_correct.txt';print $F $correct;close $F; }