use strict; use warnings; my $input = do{local $/; }; $input =~ s/(<(h\d+>)[^\n]+)/$1<\/$2/gsi; $input =~ s/(]*>)(.*?)(?=(]*>))/"$1".§ion_close($2,$3,$5)/egsi; $input =~ s/(<(h\d+>)){2,}/$1/gsi; ######Last level if ($input =~/]*>)(.*)(]*>)(.*)$/si) { $input =~s/(]*>)(.*)(]*>)(.*)$/"$1$2$3".§ion_close($4,$5,1)/egsi; } else { $input =~s/(.*)(]*>)(.*)$/"$1$2".§ion_close($3,$4,1)/egsi; } } ############Heading replacement $input =~ s/()((?:(?!<\/h\2>).)*)<\/h\2>/$1$3<\/head>/gsi; $input =~ s/(<\/?)h(\d+>)/$1section$2/gsi; print $input; sub section_close { my ($csect_no,$aft_txt,$asect_no)=@_; my $tag_close; if ($csect_no == $asect_no) { $tag_close="$aft_txt<\/h$csect_no>\n" } if ($csect_no < $asect_no) { my $j = $asect_no - $csect_no; my $i = $csect_no; my $temp = ""; while ($j > 1) { my $k = $i + 1; $temp = $temp."\n"; $i++; $j--; } $tag_close = "".$aft_txt.$temp; } if ($csect_no > $asect_no) #head separation { my $temp = ""; my $i = $asect_no; for ($i = $asect_no; $i <= $csect_no; $i++) { $temp = "<\/h$i>\n".$temp; } $tag_close = $aft_txt.$temp; } return $tag_close; } __DATA__

Heading level 1

Heading level 2

Heading level 3

Heading level 2

Heading level 1 paragraph here paragraph here Output: ------- Heading level 1 Heading level 2 Heading level 3 Heading level 2 Heading level 1 paragraph here paragraph here