sub preserve_case {
  my ($to, $from) = @_;
  my $len = length $to;

  if ($len < length $from) { $from = substr $from, 0, $len }
  else { $from .= substr $to, length($from) }

  (my $mask = $from) =~ s{(\w)|.}{ $1 ? $1 & ' ' : "\0" }egs;

  return uc($to) | $mask;
}