indietro

Ecco una deliziosa soluzione a-la Perl di Larry Rosler. Essa sfrutta le proprietà a livello di bit dello xor sulle stringhe ASCII

    $_= "questo e` un TEsT";

    $vecchio = 'test';
    $nuovo = 'successo';

    s{(\Q$vecchio\E)}
     { uc $nuovo | (uc $1 ^ $1) .
	(uc(substr $1, -1) ^ substr $1, -1) x
	    (length($nuovo) - length $1)
     }egi;

    print;

E qui sotto forma di subroutine, modellata in base a quanto sopra:

    sub preserva_maiuscole_minuscole($$) {
        my ($vecchio, $nuovo) = @_;
        my $maschera = uc $vecchio ^ $vecchio;

        uc $nuovo | $maschera .
            substr($maschera, -1) x (length($nuovo) - length($vecchio))        
    }

    $a = "questo e` un TEsT";
    $a =~ s/(test)/preserva_maiuscole_minuscole($1, "successo")/egi;
    print "$a\n";

Questo stampa:

    questo e` un SUcCESSO

Come alternativa, per mantenere le maiuscole/minuscole della parola sostituita se è più lunga dell'originale, potete usare questo codice, di Jeff Pinyan:

    sub preserva_maiuscole_minuscole {
      my ($partenza, $arrivo) = @_;
      my ($lp, $la) = map length, @_;

      if ($la < $lp) { $partenza = substr $partenza, 0, $la }
      else { $partenza .= substr $arrivo, $lp }

      return uc $arrivo | ($partenza ^ uc $partenza);
    }

Questo cambia la frase in "questo e` un SUcCesso".

Tanto per mostrare che i programmatori C possono scrivere C in un qualunque linguaggio di programmazione, se preferite una soluzione maggiormente in stile C, il seguente script fa sì che le sostituzioni abbiano le stesse maiuscole/minuscole, lettera per lettera, dell'originale (Può anche capitare che questo venga eseguito circa il 240% più lentamente di quello che fa la soluzione a-la Perl). Se la sostituzione ha più caratteri della stringa che si sta sostituendo, le maiuscole/minuscole dell'ultimo carattere sono usate per il resto della sostituzione.

    # Originale di Nathan Torkington, rimaneggiato da Jeffrey Friedl
    #
    sub preserva_miuscole_minuscole($$)
    {
        my ($vecchio, $nuovo) = @_;
        my ($stato) = 0; # 0 = nessun cambiamento; 1 = lc; 2 = uc
        my ($i, $lungvecchio, $lungnuovo, $c) = (0, length($vecchio), length($nuovo));
        my ($lung) = $lungvecchio < $lungnuovo ? $lungvecchio : $lungnuovo;

        for ($i = 0; $i < $lung; $i++) {
            if ($c = substr($vecchio, $i, 1), $c =~ /[\W\d_]/) {
                $stato = 0;
            } elsif (lc $c eq $c) {
                substr($nuovo, $i, 1) = lc(substr($nuovo, $i, 1));
                $stato = 1;
            } else {
                substr($nuovo, $i, 1) = uc(substr($nuovo, $i, 1));
                $stato = 2;
            }
        }
        # termina con ogni nuovo rimanente (per quando nuovo e` piu` lungo di vecchio)
        if ($lungnuovo > $lungvecchio) {
            if ($stato == 1) {
                substr($nuovo, $lungvecchio) = lc(substr($nuovo, $lungvecchio));
            } elsif ($state == 2) {
                substr($nuovo, $lungvecchio) = uc(substr($nuovo, $lungvecchio));
            }
        }
        return $nuovo;
    }

vedi in inglese