I thought a subroutine like the following would be more intuitive. Seems that pack and unpack handle 8 bit chars properly with the 'a' template, too.

Note that this sub takes the capitalization template of the original word to be absolute, ignoring the case of the replacement. Drop the lc() call in the second map to have it respect capitalization in the replacement.

#!/usr/local/bin/perl -w
use strict;
use warnings;

sub capsub ($$) {
    my ($old, $new) = @_;
    (my $len = length($new)) == length($old) or die "Won't work.\n";
    # Find the UC chars
    my @uc = map {($_ eq uc($_))? 1:0} unpack('a' x $len, $old);
    # Do the swap ignoring case
    $old =~ s/$old/$new/i;
    # Redo the capitalization
    my $j = 0;
    @uc = map {$uc[$j++] ? uc($_) : lc($_)} unpack('a' x $len, $old);
    # Put it back together
    return pack('a' x $len, @uc);
}

my $x = capsub('BaD', 'sad');
my $y = capsub('dOOd','LeeT');

print $x, $/, $y, $/;

__END__
SaD
lEEt
[download]

Update:
Why on earth am I using pack and unpack? Must be something in the water.

Replace those calls with split and join calls and it's a little more sensible, and I can drop the $len variable.

Finally, the bit that says, "Do the swap ignoring case" is just useless. That bit always returns $new, so I should just use $new in the next unpack (or split).

The fact is, this simply copies the capitalization pattern from the first argument to the second. This can then be used in a regex with the e modifier to obtain the desired results.