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

    $new = lc $new;

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

    return $new;
}