Perl один вкладыш, извлекающий все «ключи» из XML-файла

Question

Я пытаюсь удалить все строки в XML-файле, которые лежат между тегами и .

В качестве первого прохода к проблеме я получил регулярное выражение, которое будет соответствовать первому блоку ключей в файле, но не будет продолжать сопоставлять другие блоки в файле. Я попытался добавить "/ g" к регулярному выражению, и я попытался "-0777", чтобы убрать весь файл сразу, и ни один трюк не имеет никакого значения. Ниже приведен вкладыш perl one:

perl -00 -ne 'print $1 if /(\s+\<KEYS\>\n\s+.*?\n\s+\<\/KEYS\>)/s' someFile.xml

и я получаю этот вывод:

  <KEYS>
    <KEY name="cone_id" type="long" nativeType="number(17)"/>
    <KEY name="bar_id" type="long" nativeType="number(32)"/>
    <KEY name="foo_type" type="int" nativeType="number(3)"/>
  </KEYS>

Как указывалось выше, в файле гораздо больше блоков (длина которых составляет почти пять тысяч строк), но код perl не мешает остальным.

Есть предложения?

Answer 1

Ваш однострочник будет делать то, что вы хотите, сделав два изменения:

1. Измените if на while.
2. Добавьте параметр g в свое регулярное выражение: /.../gs

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

perl -ne 'print if m{<KEYS>} .. m{</KEYS>}' DATA_FILE

Answer 2

Я не совсем уверен, что вы имеете в виду, говоря "обрезать все строки".Если вы хотите напечатать все элементы KEYS, а не другие, тогда вы идете:

perl -MXML::Simple -e 'print XMLout((XMLin(join "", <>))->{KEYS})' data.xml    

или:

use XML::Simple;
my $xml = XMLin(join '', <DATA>); 
print XMLout($xml->{KEYS});

__DATA__
<root>
  <KEYS>
    <KEY name="cone_id" type="long" nativeType="number(17)"/>
    <KEY name="bar_id" type="long" nativeType="number(32)"/>
    <KEY name="foo_type" type="int" nativeType="number(3)"/>
  </KEYS>
  <NOTKEYS1>
    <KEY name="cone_id" type="long" nativeType="number(17)"/>
    <KEY name="bar_id" type="long" nativeType="number(32)"/>
    <KEY name="foo_type" type="int" nativeType="number(3)"/>
  </NOTKEYS1>
  <NOTKEYS2>
    <KEY name="cone_id" type="long" nativeType="number(17)"/>
    <KEY name="bar_id" type="long" nativeType="number(32)"/>
    <KEY name="foo_type" type="int" nativeType="number(3)"/>
  </NOTKEYS2>
  <KEYS>
    <KEY name="cone_id" type="long" nativeType="number(17)"/>
    <KEY name="bar_id" type="long" nativeType="number(32)"/>
    <KEY name="foo_type" type="int" nativeType="number(3)"/>
  </KEYS>
</root>

Даже если вам не нужна структура, это немного легче рассуждать, чем регулярные выражения, не так ли?

В любом случае, вот версия регулярных выражений:

perl -e '$a = join "", <>; print $a =~ m/(\s+\<KEYS\>\n\s+.*?\n\s+\<\/KEYS\>)/sg' data.xml

Answer 3

Если XML правильно сформирован, вы можете использовать либо xml_grep, который поставляется с XML :: Twig , либо xml_grep2 в App :: xml_grep2 :

xml_grep -v KEYS to_strip.xml
xml_grep2 -v '//KEYS' to_strip.xml

Первый основан на XML :: Twig и работает в потоковом режиме, второй основан на XML :: LibXML и загружает весь документ в память перед началом grep, но он должен быть быстрее (у меня нет Хотя это сравнительно).

Ни один из них не является Perl one liner, но они оба написаны на Perl, поэтому я надеюсь, что это приемлемо для вас; -)

Answer 4

perl -MXML::LibXML -e'
   my $doc = XML::LibXML->new->parse_file($ARGV[0]);
   $_->parentNode->removeChild($_)
      for $doc->documentElement->findnodes("//KEYS");
   $doc->toFile($ARGV[1], 0);
' infile outfile

Я добавил разрывы строк для удобства чтения.Вы можете удалить их, если вы действительно один лайнер, хотя это работает и с переносами строк.

Answer 5

Вы должны использовать Perl?Если нет, попробуйте sed:

sed -i".backup" 's/<KEYS>([^<]*)<\/KEYS>/\1/g' somefile.xml