jdtoronto

More like some bizarre SGML variant than XML. Valid XML can't omit closing tags; the sample data does that everywhere. But yes, this is a job for a real parser not regexen.

Yeah, they're right that you're probably best off with a parser. However, if you really wanted to stick with regex, you could do the job more slowly and less elegantly with a line-by-line solution like this (make sure to improve before actual use):

while (<INPUT>) {
    if (m#<level1 id=\"([^"]*)\"#) {
        $id=$1;
        print;
    }
    elsif (m#(\s*)<level2>#) {
        print "$1<level2 id=\"$id\">\n";
    }
    else {
        print;
    }
}
[download]

Your regex doesn't work because you don't capture the id from the level1 tag when you get to the 2nd level2 tag below that tag. This works by capturing the last level1 id into a persistent variable, and replacing level2 tags when it finds them.

Hays

having said that, you could approach your regex from the other end and work backwards. I think this does what you want.

while ( $content =~ s/(.*<level1 id="([^"]*).*?)<level2>/$1<level2 id=
+\"$2\">/gsi ) {  }
[download]

UPDATE

I couldn't shake the feeling inflicted on myself by the above post. I seek to redeem myself with a full xml version :)

#!/usr/bin/perl
use XML::DOM;
use warnings;
use strict;
 

my $xml = q|<root>
<level1 id="L1_0001">
    <level2>
        <level3>
            <level4/>
        </level3>
        <level3>
            <level4/>
        </level3>
    </level2>
    <level2/>
</level1>   
<level1 id="L1_0002">
</level1>   
<level1 id="L1_0003">
    <level2>
        <level3/>
    </level2>
</level1>
</root>|;

my $parser = new XML::DOM::Parser;
my $doc = $parser->parse($xml);

foreach my $l1_node ($doc->getElementsByTagName ('level1') ) {
    my $current_id = $l1_node->getAttribute('id');
    foreach my $l2_node ($l1_node->getElementsByTagName ('level2') ) {
        $l2_node->setAttribute('id', $current_id);
    }    
}

print $doc->toString;
exit();
[download]

perl -pi -e 'if(/<level1(\sid=\".*\")>/){$a=$1};if(/<level2>/){$_=~s/(
+<level2)>/$1$a>/g}' input

or

perl -pi -e '$a=m/(<level([12]))(\sid=\".*\")*>/;if($a){$2==1?$b=$3:$_
+=~s/($1)/$1$b/g;}' input

or

perl -pi -e '$a=m/(<level(1|2))(\sid=\".*\")*>/;$a?$2==1?$b=$3:$_=~s/(
+$1)/$1$b/g:next;' input

or

perl -pi -e '$a=m;(<level(1|2))(\sid=\".*\")*>;;$a?$2==1?$b=$3:$_=~s;(
+$1);$1$b;g:1;' input
[download]

or golf by monsieur_champs

perl -pi -e 'm;(<level(1|2))(\sid=\".*\")*>;;$&?$2==1?$b=$3:$_=~s;($1)
+;$1$b;g:1;' input
[download]

sorry =) -1 char

perl -pi -e 'm;(<level(1|2))(\sid=\".*\")*>;;$&?$2==1?$b=$3:$_=~s;($1)
+;$1$b;g:1' input
[download]

insane !!! 33 chars


perl -pi -e '/l1(\sid=.*)>/?$a=$1:s;l2>;l2$a>;' input
[download]


=)



Mago
mago@rio.pm.org

perl -pi -e '/(<level(1|2))(\sid=\".*\")*>/;$&?$2==1?$b=$3:$_=~s;($1);$1$b;g:1;' input

Sivaraman,

I can see couple of mistakes in your code. I don't know why you are using '*?' when you are already using negative look behind. Also you are matching only the first <level2> from <level1> in your coding, so it is not matching.

Also it is good to use Parser for these kind of works like jdtoronto and Fletch suggested.

Though not efficient, here is my try in regex to match all <level2> inside <level1>

update: sivaraman, immediately, i added '?' in (<level1)? after i posted. Sorry for not mentioning the updation in the node.