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;
}

##</code><code>##

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

    $new = lc $new;

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

    return $new;
}