Nat Torkington had an approach like yours, probably in the Perl Cookbook. I offer a much simpler solution:

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

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

Update: it works by creating a mask of NULs and spaces from the "from" string ("OlD" maps to "NUL SP NUL"). Then, it turns the "to" string to uppercase, and bitwise ORs the mask onto it ("NEW" & "\x00\x20\x00" is "NeW").

Golfing it:

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

Update 2: if you use this to change "ThIs{" to "ThAt[", you'll end up getting "ThAt{", because of the bitwise operations. This is a side effect of the unprejudiced ANDing. It can be "fixed" like so (this, and the corresponding golf, are locale sensitive):

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

An alternative to the $mask creation is to use a regex:

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

Golfing that, I get:

# 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}
[download]

Update 3: another fix, to account for changing "a" to "BcDe", and for changing "AbCd" to "e":

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;
}
[download]

Update 4: Larry Rosler has code in the FAQ for this, and I've found faster way to form the mask from it:

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);
}
[download]

This works slightly differently from Larry's code. His code turns a "TeSt" => "succesS" to "SuCcESS", whereas mine preserves the case of the new word, if it's longer than the original ("SuCcesS").

japhy -- Perl and Regex Hacker

---

---

Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!

Titles consisting of a single word are discouraged, and in most cases are disallowed outright.

Read Where should I post X? if you're not absolutely sure you're posting in the right place.

Please read these before you post! —

• How do I compose an effective node title?
• How do I post a question effectively?
• Markup in the Monastery

Posts may use any of the Perl Monks Approved HTML tags:

a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr

You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)

	For:		Use:
	&		&
	<		&lt;
	>		&gt;
	[		&#91;
	]		&#93;

Link using PerlMonks shortcuts! What shortcuts can I use for linking?

See Writeup Formatting Tips and other pages linked from there for more info.