Perl: XML Twig 插入数据

Perl: XML Twig insert data

我有一个 settings.xml 文件作为

<settings xmlns="http://maven.apache.org/SETTINGS/1.0.0"
xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
xsi:schemaLocation="http://maven.apache.org/SETTINGS/1.0.0
                      https://maven.apache.org/xsd/settings-1.0.0.xsd">

  <pluginGroups>
    <pluginGroup>org.mortbay.jetty</pluginGroup>
  </pluginGroups>
  <servers>
    <server>
      <id>server001</id>
      <username>my_login</username>
      <password>my_password</password>
      <privateKey>${user.home}/.ssh/id_dsa</privateKey>
      <passphrase>some_passphrase</passphrase>
      <filePermissions>664</filePermissions>
      <directoryPermissions>775</directoryPermissions>
      <configuration></configuration>
    </server>
  </servers>
</settings>

可以看到,没有代理数据。我想使用 Perl:Twig 添加数据。 我不能使用其他 CPAN 模块,因为 perl 发行版不是我维护的。

我已经阅读了 perl doc on twig, but I am confused on the insert process. I have also read this perl link, where comparison/copy of XML is used (not relevant here because I am not not comparing). Also I read SO twig child adding, but I think I want to create a tag. ThisSo link explains how to use XML::DOM, but I am limited to Perl:Twig, and lastly this SO on XML:Simple,但我又一次被限制为 Perl:Twig,加上 perldoc 状态不使用 XML:Simple。

我当前的代码看起来类似于

my $t = XML::Twig->new(
    twig_roots   => { proxy => 1 },
    pretty_print => 'indented',
)->parsefile( $maven_Dir . "/" . $settings_File );

if ( !$t->root->children('proxy') ) {
    print(
        "In your settings.xml located in your .m2 folder, 
         there appears to be no proxy settings \n"
    );
    print("Adding Jlab proxy settings \n");
    my $cp = $t->root->children('settings');
    $cp->insert("proxies");

#       $cp->first_child('proxy');
#       $cp->paste( 'last_child', $t->root );

}
else {

    foreach my $proxy ( $t->root->children('proxy') ) {
        my $port     = $proxy->first_child_text('port');
        my $host     = $proxy->first_child_text('host');
        my $protocol = $proxy->first_child_text('protocol');
        my $active   = $proxy->first_child_text('active');

        if (   $port == 1492
            && $host eq "jpoop"
            && $protocol eq "http"
            && $active eq "true" )
        {
            print("Correct proxy settings are set properly for Jlab \n");
            print( "$port \n", "$host \n", "$protocol \n",
                "$active'\n \n" );

        }

    }
}

有人会指出我添加类似于

的数据的方向吗
<proxies>
    <proxy>
        <active>true</active>
        <protocol>http</protocol>
        <host>jpoop</host>
        <port>1492</port>
    </proxy>
</proxies>

使用 Perl:Twig?

进入 XML 文件

XML::Twig 不是最好的编辑方式 XML,但可以做到:

#!/usr/bin/perl
use warnings;
use strict;
use feature qw{ say };

use XML::Twig;

my ($PORT, $HOST, $PROTOCOL, $ACTIVE) = (1492, 'jpoop', 'http', 'true');

my $twig = 'XML::Twig'->new(
    pretty_print => 'indented',
)->parsefile(shift);

my $root = $twig->root;
my ($proxies) = $root->children('proxies');

if (! $proxies) {
    print STDERR
        "In your settings.xml located in your .m2 folder,
         there appears to be no proxy settings.
         Adding Jlab proxy settings \n";

    my $proxies = $root->insert_new_elt('proxies');
    $proxies->set_inner_xml(
        "<proxy><active>$ACTIVE</active><protocol>$PROTOCOL</protocol>"
        . "<host>$HOST</host><port>$PORT</port></proxy>");
    $root->print;

} else {
    my $found;
    for my $proxy ( $proxies->children('proxy') ) {
        my $port     = $proxy->first_child_text('port');
        my $host     = $proxy->first_child_text('host');
        my $protocol = $proxy->first_child_text('protocol');
        my $active   = $proxy->first_child_text('active');

        $found = 1 if $port == $PORT
                   && $host eq $HOST
                   && $protocol eq $PROTOCOL
                   && $active eq $ACTIVE;
    }
    if ($found) {
        print STDERR "Correct proxy settings are set properly for Jlab \n";
    } else {
        print STDERR "Correct proxy settings missing:\n",
            "port $PORT\nhost $HOST\nprotocol $PROTOCOL\nactive $ACTIVE\n";

    }
}