$xml =~ s{(?:(<!\[CDATA\[.*?\]\]>)|(<[^\s?!>]+))}{ 
  $1 or do {(my $tagname = $2 ) =~ tr/.//d;$tagname;} }seg;

# or ... sligthly more efficient for XMLs with most tags without the dots 

$xml =~ s{(?:(<!\[CDATA\[.*?\]\]>)|(<[^\s?!>\.]+\.[^\s?!>]+))}{ 
  $1 or do {(my $tagname = $2 ) =~ tr/.//d;$tagname;} }seg;

# and now even more efficient thanks to moving the &lt; outside the or

$xml =~ s{<(?:(!\[CDATA\[.*?\]\]>)|(<[^\s?!>\.]+\.[^\s?!>]+))}{
  '<'. ($1 or do {(my $tagname = $2 ) =~ tr/.//d;$tagname;} ) }seg;