my @k = sort { length($b) <=> length($a) } keys(%h2) ;

  my $s = "\0". join("\0", @k)."\0" ;

  my @a = () ;
  my $p = 0 ;
  foreach my $k (@k) {
    $p += length($k) + 1 ;
    push @a, $p ;
  } ;

  foreach my $k (@k) {
    pos $s = 0 ;
    $s =~ m/$k/g ;
    next if pos($s) == shift(@a) ;
    delete $h2{$k} ;
  } ;