for my $k ( keys %harry ) {
   my $a1 = $harry{$k};
   my $a2 = $harry{$phash{$k}};

   my %seen;
   for ( @$a1 ) {
      push @{ $h1{$a1} }, $_;
   }

   my %delete_a1;
   my %delete_a2;
   for ( 0..$#$a2 } ) {
      my $seen = $seen{ $a2->[$_] };
      if ( $seen && @$seen ) {
         $delete_a1{$_} = shift(@$seen);
         $delete_a2{$_} = 1;
      }
   }   

   @$a1 = map $a1->[$_], grep !$delete_a1{$_}, 0..$#$a1;
   @$a2 = map $a2->[$_], grep !$delete_a2{$_}, 0..$#$a2;
}