Как я могу удалить элементы, используя Perl XML :: Twig?

Question

У меня есть несколько XML-файлов, таких как:

<machines>
<server>
    127.0.0.1
</server>
<proxy>
    <ip>127.0.0.2</ip>
    <etc>abc</etc>
</proxy>
</machines>

, и я хочу сохранить сервер и удалить другие, вывод должен быть:

<machines>
<server>
127.0.0.1
</server>
</machines>

Я написал скрипт какследует:

use warnings;
use strict;
use feature ':5.10';
use XML::Twig;

my $path='C:\strawberry\perl\site\lib\file.xml';
my $filehandle;
my $tweak_server =sub{
    my ($twig, $root) =@_;
    my $elt=$root;
    while( $elt=$elt->next_elt($root)){
        my $tag=$elt->tag;
        say $tag;
        if ($tag!~/server/){
            $elt->delete($tag);         
        }       
    }
    $twig->flush;
};




open( $filehandle, "+<$path") or die "cannot open out file out_file:$!";
my $roots = { machines => 1 };
my $handlers = { 'machines' => $tweak_server,
            };
my $twig = new XML::Twig(TwigRoots => $roots,
                 TwigHandlers => $handlers,
                 pretty_print  => 'indented'#,
                # twig_print_outside_roots => \*$filehandle
                 );
$twig->parsefile($path);
close $filehandle;

и получил вывод:

server
#PCDATA
<machines>
<server></server>
<proxy>
<ip>127.0.0.2</ip>
<etc>abc</etc>
</proxy>
</machines>

Я действительно не понимаю, почему существует "#PCDATA" и почему он не работает так, как я ожидаю?

@ mirod Я попытался сделать следующее:

use warnings;
use strict;
use feature ':5.10';
use XML::Twig;

my $tweak_server =sub{
my ($twig, $root) =@_;
my $elt=$root;
my $text=$elt->first_child_text('id');
if ($text=~m/12/){
    while( $elt=$elt->next_elt('#ELT')){
        my $tag=$elt->tag;
        say $tag;
        if ($tag!~/id/){
            $elt->delete;           
        }       
    }
}
};

my $roots = { machines => 1 };
my $handlers = { 'machines/aaa' => $tweak_server,
            };
my $twig =XML::Twig->new(TwigRoots => $roots,
                 TwigHandlers => $handlers,
                 pretty_print  => 'indented'#,
                # twig_print_outside_roots => \*$filehandle
                 )
    ->parse( \*DATA) 
    ->print; 
__DATA__

<machines> 
<server> 127.0.0.1 </server> 
<aaa>
<id>12</id> 
<ip>127.0.0.2</ip>   
<option>127.0.0.6</option>
<etc>abc</etc>
</aaa> 
<aaa>
<id>14</id> 
<ip>127.0.0.2</ip>   
<etc>abc</etc>
</aaa> 
<aaa>
<id>15</id> 
<ip>127.0.0.2</ip>
<etc>abc</etc>
</aaa>
</machines>

и выдает:

<machines>
<server> 127.0.0.1 </server>
<aaa>
<id>12</id>
<option>127.0.0.6</option>
<etc>abc</etc>
</aaa>
<aaa>
<id>14</id>
<ip>127.0.0.2</ip>
<etc>abc</etc>
</aaa>
<aaa>
<id>15</id>
<ip>127.0.0.2</ip>
<etc>abc</etc>
</aaa>
</machines>

, и я хочу удалить три элемента, а не только один:

<ip>127.0.0.2</ip>   
<option>127.0.0.6</option>
<etc>abc</etc>

под элементом

 <id>12</id>

какие-либо предложения?

Answer 1

Если ваше требование состоит в том, чтобы хранить только элементы сервера, вы можете сообщить модулю, что они имеют значение twig_roots.это приведет к сохранению корня XML и серверных элементов (и их содержимого), при этом отбрасывая все остальные:

#!/usr/bin/perl

use strict;
use warnings;

use XML::Twig;

XML::Twig->new( twig_roots => { server => 1 },
                pretty_print => 'indented',
              )
         ->parse( \*DATA)
         ->print;

__DATA__
<machines>
<server>
    127.0.0.1
</server>
<proxy>
    <ip>127.0.0.2</ip>
    <etc>abc</etc>
</proxy>
</machines>

Answer 2

Следующие элементы будут удалены proxy:

use warnings;
use strict;
use XML::Twig;

my $str = '
<machines>
<server>
    127.0.0.1
</server>
<proxy>
    <ip>127.0.0.2</ip>
    <etc>abc</etc>
</proxy>
</machines>
';

my $t = XML::Twig->new(
        twig_handlers => {
            proxy => sub { $_->delete() },
        },
        pretty_print  => 'indented',
);
$t->parse($str);
$t->print($str);
print "\n";

__END__

<machines>
  <server>
    127.0.0.1
</server>
</machines>

Если вы не хотите распечатывать server и #PCDATA, избавьтесь от say $tag;.