s/(old)/preserve_case("new", $1)/ieg;

sub preserve_case {
  my ($to, $from) = @_;
  die "strings don't match in length" unless length($to) == length($from);
  my $mask = $from & (' ' x length($from));
  return uc($to) | $mask;
}

##</code><code>##

# requires $" hasn't been altered
#       123456789_123456789_12345678 = 28
sub pc {uc$_[0]|$_[1]&$"x length pop}

##</code><code>##

sub preserve_case {
  my ($to, $from) = @_;
  die "strings don't match in length" unless length($to) == length($from);
  my $mask = join '', map /\w/ ? $_ & ' ' : "\0", split //, $from;
  return uc($to) | $mask;
}

##</code><code>##

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

##</code><code>##

# requires $" hasn't been altered
#       123456789_123456789_123456789_123456789_123456789_ = 50
sub pc {(my$x=pop)=~s/(\w)|./$1?$1&' ':"\0"/egs;uc$_[0]|$x}

##</code><code>##

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

##</code><code>##

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

  return uc($to) | ($from ^ uc $from);
}