Using Perl with Regex, how can I remove a string within a string?

Viewed 65

So I have several XML files that have persons with unique IDs and they each have a favorite food (a person can be in several xml files):

There are cases where the person with id=300 might have the food right in the beginning of the tag.

<person id="299">
    <food>
       <type> Hot Dog </type>
    </food>
</person>
<person id="300">
    <food>
       <type> Burger</type>
    </food>
</person>

Or there might be other tags before the food tag

<person id="300">
    <year>
       <birth> 1990 </birth>
       <marriage> 2020 </marriage>
    </year>
    <food>
       <type> Vegan </type>
    </food>
</person>

I need to use a single Perl RegEx functions to remove the food tags ONLY of the persons whose ID is 300, independently if it is at the beginning, middle, or end of the person tag

I know if it was for the whole person tag I could use something like :

$fileContents =~ s/<person id=\"300\"[^<]+<\/person>//g;

But I must leave the person tag intact, I must only remove the food tag inside the person tag, but I can't remove all the food tags because I need to leave it for people with other ID's.

Could you help me please?? I been struggling a lot with this D:

2 Answers

You can't safely do that with a substitution.

And even a half-assed approach is more complicated than using an existing XML parser.

$_->unbindNode()
   for $doc->findnodes('//person[@id="300"]/food');

Full solution:

use XML::LibXML qw( );

# my $doc = XML::LibXML->new->parse_file(...);
#    or
# my $doc = XML::LibXML->new->parse_string(...);

$_->unbindNode()
   for $doc->findnodes('//person[@id="300"]/food');

# $doc->toFile(...)
#    or
# $doc->toString(...)
perl -i.bk -pe'BEGIN{undef$/}s|<person (.*?)>.*?</person>|$p=$&;$1=~/id="300"/?$p=~s,<food>.*?</food>,,sr:$p|esg' files*.xml

...removes <food>.....</food> from persons with id="300" in one or more files*.xml. The original files are kept and renamed with .bk added to their file names. So only run this once if you need to keep the original files...or change -i.bk into for example -i.bk$(date +%Y%m%d%h%M%S).

Note: I think ikegami's answer is much better.

But sometimes one writes perl for systems not allowing extra modules and XML::LibXML sadly isn't a core module. And sometimes half-assed XML might be best/fastest handled with half-assed methods. Perhaps "XML" written by something beyond your control. Maybe it's missing a root node for the list of persons, like in the first example here (the list of <person>s could be surrounded with <list>...</list> to make it readable to XML::LibXML) Or with ' or " missing around attribute values, which also wouldn't be readable to XML::LibXML right away.

Related