Perl 我可以用XML：：Simple返回经过解析的XML路径吗？

我有一个XML文件，其格式如下：

<testsuite name="Conformance">
 <testsuite name="Manageability">
  <testsuite name="MIBs">
   <testcase internalid="1" name="name1">...</testcase>
   <testcase internalid="2" name="name2">...</testcase>
  </testsuite>
 </testsuite>
</testsuite>

我可以用XML:：Simple实现这一点吗？如果可以，调用会是什么样子

我当前的脚本：

use strict;
use warnings;
use Data::Dumper;
#use XML::Twig;
use XML::Simple;

my $file = 'test.xml';

my $ref = XMLin($file);

print Dumper($ref);

---

我试过好几种方法，但似乎都没有得到我需要的。解析返回的数据结构以获取所需内容是否更容易

XML:：Simple

几乎在所有情况下都违反了“让一切尽可能简单，而不是更简单”的原则，但最简单的情况除外

看起来我第一次误解了您的需求，所以这里有另一种方法——然而，我认为它比@ikegami的解决方案要糟糕得多，因为它首先找到所有

testcase

节点，然后追溯到它们的父节点

#!/usr/bin/env perl

use strict; use warnings;
use XML::XPath;
use XML::XPath::XMLParser;

my $xp = XML::XPath->new(ioref => \*DATA);

my $nodeset = $xp->find('//testcase');

my %cases;

foreach my $node ($nodeset->get_nodelist) {
    my $current = $node;
    my @parents;

    while (defined(my $parent = $current->getParentNode)) {
        my $name = $parent->getAttribute('name');
        last unless defined $name;
        push @parents, $name;
        $current = $parent;
    }

    my $path = join('/', '', reverse @parents);

    push @{ $cases{ $path } }, $node->getAttribute('name');
}

for my $path (sort keys %cases) {
    print "$path\n";
    for my $case (sort @{ $cases{$path} }) {
        print "\t$case\n";
    }
}


__DATA__
<testsuite name="Conformance">
 <testsuite name="Manageability">
  <testsuite name="MIBs">
   <testcase internalid="1" name="name1">...</testcase>
   <testcase internalid="2" name="name2">...</testcase>
  </testsuite>
 </testsuite>
 <testsuite name="Yabadabadoo">
  <testsuite name="Da da da">
   <testcase internalid="1" name="name1">...</testcase>
   <testcase internalid="2" name="name2">...</testcase>
  </testsuite>
 </testsuite>
</testsuite>

#/usr/bin/env perl
严格使用；使用警告；
使用XML：：XPath；
使用XML:：XPath:：XMLParser；
我的$xp=XML:：XPath->new（ioref=>\*数据）；
我的$nodeset=$xp->find（'//testcase'）；
我的%病例；
foreach my$node（$nodeset->get\u nodelist）{
my$current=$node；
我的父母；
while（已定义（my$parent=$current->getParentNode））{
我的$name=$parent->getAttribute（'name'）；
最后，除非定义$name；
推送@parents$name；
$current=$parent；
}
my$path=join（'/'，''，reverse@parents）；
push@{$cases{$path}，$node->getAttribute（'name'）；
}
对于我的$path（排序键%cases）{
打印“$path\n”；
对于我的$case（sort@{$cases{$path}）{
打印“\t$case\n”；
}
}
__资料__
...
...
...
...

输出：

/Conformance/Manageability/MIBs name1 name2 /Conformance/Yabadabadoo/Da da da name1 name2 /一致性/可管理性/MIBs 名称1 姓名2 /合规性/亚巴达巴杜/达达 名称1

---

使用

XML:：Simple

命名2？请听一下该模块的作者所说的话：

但是，我建议不要使用XML:：Simple（我应该知道-I） （我写的）。我个人使用XML：：LibXML

资料来源：

---

帮自己一个忙，学会正确的方法，这在大多数情况下都意味着。这就是C库，它也在PHP、Python和Ruby中使用。在UNIX和WINDOWS上编译。便携式。快速的标准API。该走的路。

递归非常适合这里

use strict;
use warnings;
use XML::LibXML qw( );

sub visit_testsuite {
   my ($testsuite_node, $parent_path) = @_;

   my $name = $testsuite_node->getAttribute('name');
   my $path = defined($parent_path) ? "$parent_path/$name" : $name;

   my @testcase_nodes = $testsuite_node->findnodes('testcase');
   if (@testcase_nodes) {
      print("$path\n");
      for my $testcase_node (@testcase_nodes) {
         printf("   %s\n", $testcase_node->getAttribute('name'));
      }
      print("\n");
   }

   for my $testsuite_child ($testsuite_node->findnodes('testsuite')) {
      visit_testsuite($testsuite_child, $path);
   }
}


my $doc  = XML::LibXML->load_xml( IO => \*DATA );
my $root = $doc->documentElement();

visit_testsuite($root);

__DATA__

...
...

---

根节点实际上不应该是一个

testsuite

节点，但它就是您所说的。

既然您尝试使用XML:：Twig，这里有一个解决方案。当它找到一个

testcase

时，它会检查它是否是

testsuite

中的第一个，如果是，它会使用元素的祖先打印路径。然后打印测试用例的名称

2注意：

testcase

是第一个，如果它没有以前的

testcase

同级，并且

祖先

将元素的祖先从内部（元素父级）返回到外部（根级），因此在这种情况下，我们需要反转列表以按所需顺序获取它们

瞧

#!/usr/bin/perl

use strict;
use warnings;

use XML::Twig;

XML::Twig->new( twig_handlers => { testcase => \&test_case })
         ->parse( \*DATA);

sub test_case
  { my( $t, $test_case)= @_;
    if( ! $test_case->prev_sibling( 'testcase'))
      { # first test case, output the "path"
        print join( '/', map { $_->att( 'name') } reverse $test_case->ancestors( 'testsuite')), "\n";
      }
    print "    ", $test_case->att( 'name'),"\n";
  }

__DATA__
<testsuite name="Conformance">
 <testsuite name="Manageability">
  <testsuite name="MIBs">
   <testcase internalid="1" name="name1">...</testcase>
   <testcase internalid="2" name="name2">...</testcase>
  </testsuite>
 </testsuite>
</testsuite>

#/usr/bin/perl
严格使用；
使用警告；
使用XML：：Twig；
XML:：Twig->new（Twig\u处理程序=>{testcase=>\&test\u case}）
->解析（\*数据）；
子测试用例
{my（$t，$test_case）=@；
if（！$test\u case->prev\u同级（'testcase'））
{#第一个测试用例，输出“路径”
打印联接（'/'，映射{$\u->att（'name'）}反向$test\u case->祖先（'testsuite'），“\n”；
}
打印“$test\u case->att（'name'），“\n”；
}
__资料__
...
...

问题是关于将“一致性/可管理性/MIB”输出到为什么建议在使用XML:：Simple遇到第一个问题时停止使用它。是时候去做一些不需要为你做太多决定的事情了。

<testsuite name="Conformance">
 <testsuite name="Manageability">
  <testsuite name="MIBs">
   <testcase internalid="1" name="name1">...</testcase>
   <testcase internalid="2" name="name2">...</testcase>
  </testsuite>
 </testsuite>
</testsuite>

#!/usr/bin/perl

use strict;
use warnings;

use XML::Twig;

XML::Twig->new( twig_handlers => { testcase => \&test_case })
         ->parse( \*DATA);

sub test_case
  { my( $t, $test_case)= @_;
    if( ! $test_case->prev_sibling( 'testcase'))
      { # first test case, output the "path"
        print join( '/', map { $_->att( 'name') } reverse $test_case->ancestors( 'testsuite')), "\n";
      }
    print "    ", $test_case->att( 'name'),"\n";
  }

__DATA__
<testsuite name="Conformance">
 <testsuite name="Manageability">
  <testsuite name="MIBs">
   <testcase internalid="1" name="name1">...</testcase>
   <testcase internalid="2" name="name2">...</testcase>
  </testsuite>
 </testsuite>
</testsuite>