perl XML Twig在不生成白色时删除标记

bksxznpy 于 2023-08-06 发布在 Perl

关注(0)|答案(1)|浏览(129)

我有一个巨大的XML文件，其中包含一些元素。我可以使用一个处理程序来删除所有这些元素（替换一个元素，删除所有其他元素）。但这会在文档中创建白色。如何用“nothing”替换元素，以便在文档中不创建空格？需要说明的是，我正在处理的XML数据/文件没有优化，并且包含多行。
下面是我的问题的一个小例子。
XML数据：

<data>
    <Metadata>
        <Name>Test</Name>
        <Company>Acme</Company>
    </Metadata>
    <Info>
        <tag r="1"/>
        <tag r="2"/>
        <tag r="3"/>
        <tag r="4"/>
        <tag r="5"/>
        <tag r="6"/>
        <tag r="7"/>
        <tag r="8"/>
        <tag r="9"/>
        <tag r="10"/>
        <tag r="11"/>
        <tag r="12"/>
        <tag r="13"/>
        <tag r="14"/>
        <tag r="15"/>
        <tag r="16"/>
        <tag r="17"/>
        <tag r="18"/>
        <tag r="19"/>
        <tag r="20"/>
    </Info>
</data>

字符串
我想在拆除后看看

<data>
    <Metadata>
        <Name>Test</Name>
        <Company>Acme</Company>
    </Metadata>
    <Info>
        <Newtag>abc</Newtag>
    </Info>
</data>

型
但我却得到了

<data>
    <Metadata>
        <Name>Test</Name>
        <Company>Acme</Company>
    </Metadata>
    <Info>
        
        
        
        
        
        
        
        
        
        
        
        
        
        
        <Newtag>abc</Newtag>
        
        
        
        
        
    </Info>
</data>

型
那么，应该如何修改我的代码（如下），以避免创建空格？

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

my $START_Number=1;
my $END_Number=20;
my $fh1A_file='file containing the XML to modify';

my $twig = XML::Twig->new(
            pretty_print => 'none',
            twig_roots => {'tag' => sub{modify_datatagX2_TEST1(@_,$START_Number,$END_Number)}},twig_print_outside_roots => 1);
        $twig->parsefile_inplace($fh1A_file);
        $twig->flush;
#
#
#
sub modify_datatagX2_TEST1 {
    my ( $twig, $datatag, $START_Number, $END_Number) = @_;
    my $Match_Found;
    #                      
    if(int($datatag -> att('r'))>$END_Number || int($datatag -> att('r'))<$START_Number){
        $twig->flush;
    } else {
        $Match_Found=0;
        if(int($datatag -> att('r'))>=$START_Number && int($datatag -> att('r'))<=$END_Number){
            $datatag->delete;
            $Match_Found++;
        }
        print '<Newtag>abc</Newtag>' if $Match_Found==1 and int($datatag -> att('r'))==15;
        $twig->flush if $Match_Found==0;
        #END1:
    }
}

型

perl

来源：https://stackoverflow.com/questions/76762166/xml-twig-delete-tags-while-not-generating-white-space

1条答案

按热度按时间

yi0zb3m41#

标签之间的空白对于使用XML的其他任何东西都不重要（它不是那么多，它是 * 创建 *，但它只是没有 * 删除 *），但如果它是出于装饰性的原因，而不想以后重新格式化整个文件...诀窍是通过为Info添加一个新的处理程序，在处理完所有的tag之后才调用flush：

#!/usr/bin/env perl
use strict;
use warnings;
use XML::Twig;

my $START_Number=1;
my $END_Number=20;
my $fh1A_file='file containing the XML to modify';

my $twig = XML::Twig->new(
    pretty_print => 'none',
    twig_roots => {
        'Info' => sub { $_[0]->flush },
        'tag' => sub { modify_datatagX2_TEST1(@_, $START_Number, $END_Number) }
    },
    twig_print_outside_roots => 1
    );
$twig->parsefile_inplace($fh1A_file);
$twig->flush;

# Note a lot of cleanup here.
sub modify_datatagX2_TEST1 {
    my ($twig, $datatag, $START_Number, $END_Number) = @_;
    # Only fetch the attribute once; no need for int()
    my $r = $datatag->att('r'); 
    if ($r >= $START_Number && $r <= $END_Number){
        # Don't just blindly print text, replace the element in the XML tree on match
        if ($r == 15) {
            my $newtag = XML::Twig::Elt->new(Newtag => 'abc');
            $newtag->replace($datatag);
        } else {
            $datatag->delete;
        }
    }
}

字符串
这将产生

<data>
    <Metadata>
        <Name>Test</Name>
        <Company>Acme</Company>
    </Metadata>
    <Info><Newtag>abc</Newtag></Info>
</data>

型

赞(0）回复(0）举报 2023-08-06

我来回答

perl XML Twig在不生成白色时删除标记

1条答案

相关问题

热门标签

最新问答