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]

Golfing it:

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

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]

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

# 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]

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]

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]

--
I'd like to be able to assign to an luser

use strict;
use warnings;
my $start_tag  = qr/\*\*\* begin file \*\*\*/;
my $end_tag    = qr/\*\*\* end file \*\*\*/;
my $case = '';

while ( <DATA> ) {
    # The range operator is sorely underused.
    if ( /$start_tag/ .. /$end_tag/ ) {
        if ( /$start_tag/ or /$end_tag/ ) {
            s/file/substituted file/;
        } else {
            $case = $_ & ' ' x length;
            s/old/NEW/i;
        }
        print $_ | $case;
    }
}

__DATA__
test
*** begin file ***
old_word
OLD_WORD
oLd_wOrd
olD_worD
*** end file ***
test2
[download]

*** begin substituted file ***
new_word
NEW_WORD
nEw_wOrd
neW_worD
*** end substituted file ***
[download]

Cheers,
Ovid

Join the Perlmonks Setiathome Group or just click on the the link and check out our stats.

You can replace:

        if ( /$start_tag/ .. /$end_tag/ ) { 
                if ( /$start_tag/ or /$end_tag/ ) {
[download]

with

        if ( my $where = /$start_tag/ .. /$end_tag/ ) { 
                if ( $where == 1 or $where =~ /E/ ) {
[download]

for more reliable (and faster!) operation.

-- Randal L. Schwartz, Perl hacker

Hey, that's sweet! If you want to get rid of another regex and make it even faster:

    if ( $where == 1 or substr($where, -2) eq 'E0' ) {
[download]

Though I am wondering one thing: why is 'E0' appended to the return value of the final sequence number? Is it just an easy test for the end or is there something significant here that I'm not aware of? (i.e., why not just append an 'x' or 'mssux' or something like that?).

Cheers,
Ovid

Join the Perlmonks Setiathome Group or just click on the the link and check out our stats.

for (<DATA>){
  chomp;
  $case = $_ & ' ' x length;
  s/old/NEW/i;
  print $_ | $case. "\n";
} 

__DATA__
old_word
OLD_WORD
oLd_wOrd
olD_worD
[download]

Jeroen
"We are not alone"(FZ)

Sounds like a potential Golf to me, but i have a few questions. by "preserve the original" i assume you mean preserve the case of the original... what if the old word was "ELEphant" and the new word is "donkey"?

as for faster ways to do it, i bet bitwise functions will come in useful here, since all capital letters are bitwise-and-equal to 64, and lowers are all bitwise-and-equal to 96.

sub UpperLower {
    my( $old, $new ) = @_;

    $new = lc $new;

    my @new = split //, $new;
    my @mask = map { uc $_ eq $_ } split //, $old;

    foreach (0..$#new) {
        $new[$_] = uc $new[$_] if $mask[$_];
    }

    return join '' => @new;
}
[download]

Or:

sub UpperLower2 {
    my( $old, $new ) = @_;

    $new = lc $new;

    while ($old =~ /[[:upper:]]/g) {
        $_ = uc $_ for substr($new, pos($old) - 1, 1);
    }

    return $new;
}
[download]

All carefully tuned to not be dependent upon oddities of ASCII.

Methinks your spec is incomplete. What if the new word is of a different length than the old word? I see that you wrote code that acts on the longer of the two, but how did you determine that was what the poster wanted to happen?

Sorry for the incompleteness, but that is how it was posted to the vim mailing list. I took it upon myself (and forgot to mention it) to simply append/disregard characters in cases where the old/new lengths do not match. Not really sure if that is what the poster wanted, but for the purposes of this lets assume it is acceptable. Also, where is the proper place to put 'golf' type questions?