#!/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