Это можно сделать просто с помощью анализа JSON.Я сомневаюсь, что это хорошая идея сделать это вообще без анализа JSON.
Я написал реализацию, которая может модифицировать группы, добавлять, а также удалять домены из них.Вы должны иметь в виду, что изменение содержимого в XML с помощью регулярных выражений всегда неубедительно и наивно.Он легко сломается, поскольку полагается на то, что все находится в правильном порядке.Он не знает об атрибутах внутри тегов XML или даже самих тегах.Это просто куча текста.
Сказав это, давайте сначала посмотрим на конфигурацию и фактический вызов.
use strict;
use warnings;
use JSON;
my $json =
q[{"xml" :"SOMESTUFFWEDONOTCARE<node n=\"Group1\" u-l=\"toto.com;tata.com;tutu.com\"></node><node n=\"Group2\" u-l=\"bobo.com;baba.com\"></node><node n=\"Group3\" u-l=\"toto.com;papa.com;pepe.com;pupu.com\"></node>SOMESTUFFWEDONOTCARE"}];
my $hash = decode_json $json;
$hash->{xml} = process(
$hash->{xml} => {
"Group1" => {add => [qw/newwebsite.com/]},
"Group3" => {remove => [qw/toto.com/]}
},
);
print encode_json($hash);
Первое предположение состоит в том, что строка данных, которую вы далиНас, который выглядит как JSON, на самом деле является JSON, и что экранирование с обратными слешами является дословным.Если это изменится, весь код нарушится.
Здесь есть конфигурация, которая позволяет вам сказать, что вы хотите add и / или remove домены из группы.
Это сделано вprocess sub, который будет перебирать группы, находит первое вхождение в строке XML и обрабатывает его.Это предполагает, что весь документ XML находится в одной строке.Если есть новые строки, это прерывается.
Вот полная функция.
sub process {
my ($xml, $args) = @_;
foreach my $group (keys %$args) {
if ($xml =~ m/<node n="\Q$group\E" u-l="([^"]+)">/) {
my $existing_list = $1;
my @items = split /;/, $existing_list;
# remove items from the list
if (exists $args->{$group}->{remove}) {
no warnings 'experimental';
my @remove = @{$args->{$group}->{remove}};
@items = grep { not $_ ~~ @remove } @items;
}
# add new items to the list
if (exists $args->{$group}->{add}) {
push @items, @{$args->{$group}->{add}};
}
# serialise the list and stick it back in
# need the "" as an anchor
my $new_list = join ';', @items;
$xml =~ s/"(\Q$existing_list\E)"/"$new_list"/;
}
}
return $xml;
}
Помните, что, хотя это выглядит как XML, мы воспринимаем его как просто текст.Нам нужен открывающий и закрывающий кронштейн <node> в качестве якоря.Мы берем список доменов и манипулируем им.Если есть лишние пробелы или порядок элементов изменяется, это нарушается.
Код использует простые операции со списками для обработки списков доменов.
Чтобы разрешить легкое удаление нескольких доменов, это используетэкспериментальный оператор smartmatch.Вы можете реализовать это по-другому, но мне было лень.Он будет работать только на определенной версии Perl, поскольку это экспериментально.
Затем мы вставляем новый список обратно в большую строку, которая выглядит как XML, заменяя старую.Нам нужно убедиться, что никакие специальные символы (например, точка .) не попадают в шаблон, поэтому мы избегаем его с помощью \Q и \E.
В случае, если это еще не ясно, я будускажи это снова.Хотя это работает для этого очень специфического набора параметров, который вы задали в своем вопросе, скорее всего, это не будет работать в полной мере для вас.Вам придется адаптировать его, и, вероятно, адаптировать его часто.
Возможно, вам лучше использовать как JSON-анализатор, так и XML-анализатор.