++ for chipmunk's answer, but for unicode or strings with non-letters in them, here's a less elegant solution (actually this is not tested with unicode, so someone correct me if I'm wrong):

#!/usr/local/bin/perl -l -w

use strict;

my $str = "SAdBoy";

$str =~ s/($str)/fix_case($1, 'badgirl')/eig;

print $str;

sub fix_case {
 my $match_word = shift;
 my $replace_word = shift;
 my $i = 0;
 for (split '', $match_word) {
  next if $_ eq lc;
  substr($replace_word, $i, 1) = uc substr($replace_word, $i, 1);
 } continue { $i++ }
 return $replace_word;
}
[download]

Update: This and my other answer slightly updated, I just like it better now :-)