... and then the "Duh" moment strikes and I see how to preserve the key.

sub print_zHoA {
   my $ref = shift;
   my %HoA = %{$ref};
   my @values = sort { 
      $HoA{$b}->[0] <=> $HoA{$a}->[0]
   } keys %HoA;
   return { $values[0] => $HoA{$values[0]} };
}
[download]