use strict ; use warnings ;

my %h = ('this is a test' => 2,
         'is a test' => 2,
         'a test' => 1,
         'this is' => 1,
         'is a' => 1,
         'unique' => 1,
         'also Unique' => 3,
        ) ;

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

my $s = "\0". join("\0", @k)."\0" ;  # Assumption: "\0" doesn't appear in any key
study $s ;

foreach my $k (@k) {
  $s =~ m/(.)$k(.)/ ;
  if (($1 ne "\0") || ($2 ne "\0")) { delete $h{$k} ; } ;
} ;

print join(', ', map "'$_'", sort keys %h), "\n" ;

##</code><code>##

  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} ;
  } ;

##</code><code>##

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

  my $s = '' ;

  foreach my $k (@k) {
    delete($h4{$k}) and next if ($s =~ m/$k/) ;
    $s .= $k . "\0" ;
  } ;

##</code><code>##

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

  my $lx = length($k[-1]) ;
  my $ll = 0 ;
  my $li = 0 ;

  for my $k (@k) {
    if (length($k) != $ll) {
      $ll = length($k) ;
      last if $ll == $lx ;
      ++$li until length($k[$li]) > $ll ;
    } ;

    for my $i ($li..$#k) {
      next if ($k[$i] !~ /$k/) ; 
      delete $h3{$k} ;
      last ;
    } ; 
  } ;