Perl qr // e sostituzione

Question

Sto scrivendo un piccolo programma che accetta l'input dell'utente usando Getops e, sulla base di esso, il programma proverà a far corrispondere uno schema a un testo o sostituire il testo a ciò che corrisponde.

Il problema che sto riscontrando è che non riesco a far funzionare la parte sostitutiva. Sto guardando la voce qr // nelle pagine man: http : //perldoc.perl.org/perlop.html#Regexp-Quote-Like-Operators ma non ho fortuna. Ho provato a modellare il mio codice esattamente come i documenti in questo caso. Compilo un modello di corrispondenza e lo sostituisco in una sostituzione.

Qualcuno potrebbe indicare dove sto sbagliando? (Non preoccuparti troppo della sicurezza, questo è solo un piccolo script per uso personale)

Ecco cosa sto guardando:

if($options{r}){

    my $pattern = $options{r};
    print "\nEnter Replacement text: ";
    my $rep_text = <STDIN>;

    #variable grab, add flags to pattern if they exist.
    $pattern .= 'g' if $options{g};
    $pattern .= 'i' if $options{i};
    $pattern .= 's' if $options{s};


    #compile that stuff
    my $compd_pattern = qr"$pattern" or die $@;
    print $compd_pattern; #debugging

    print "Please enter the text you wish to run the pattern on: ";
    my $text = <STDIN>;
    chomp $text;    

    #do work and display
    if($text =~ s/$compd_pattern/$rep_text/){ #if the text matched or whatever
        print $text;
    }
    else{
        print "$compd_pattern on \n\t{$text} Failed. ";
    }
} #end R FLAG

Quando lo eseguo con -r " / matt / " -i, e inserisci il testo sostitutivo 'matthew', sul testo 'matt', fallisce. Perché questo?

EDIT:

Grazie per le risposte ragazzi! È stato davvero molto utile. Ho combinato entrambi i tuoi suggerimenti in una soluzione funzionante al problema. Devo gestire la bandiera / g in modo leggermente diverso. Ecco l'esempio di lavoro:

if($options{r}){

    my $pattern = $options{r};
    print "\nEnter Replacement text: ";
    my $rep_text = <STDIN>;
    chomp $rep_text;

    #variable grab, add flags to pattern if they exist.

    my $pattern_flags .= 'i' if $options{i};
    $pattern_flags .= 's' if $options{s};

    print "Please enter the text you wish to run the pattern on: ";
    my $text = <STDIN>;
    chomp $text;    

    #do work and display
    if($options{g}){
        if($text =~ s/(?$pattern_flags:$pattern)/$rep_text/g){ #if the text matched or whatever (with the g flag)
            print $text;
        }
        else{
            print "$pattern on \n\t{$text} Failed. ";
        }
    }
    else{
        if($text =~ s/(?$pattern_flags:$pattern)/$rep_text/){ #if the text matched or whatever
            print $text;
        }
        else{
            print "$pattern on \n\t{$text} Failed. ";
        }
    }
} #end R FLAG

Answer 1

Come sottolinea il caos, incontrerai alcune difficoltà usando qr // . Hai davvero bisogno di precompilare il modello? In caso contrario, una strategia come questa potrebbe funzionare:

my $pattern      = 'matt';
my $text         = 'Matt';
my $rep_text     = 'Matthew';
my $pattern_opts = 'i';

print $text, "\n" if $text =~ s/(?$pattern_opts:$pattern)/$rep_text/;

Aggiorna in risposta al tuo nuovo codice : potresti prendere in considerazione l'utilizzo di un approccio come questo:

my ($orig, $patt, $rep, $flags) = qw(FooFooFoo foo bar ig);

my $make_replacement = $flags =~ s/g//        ?
    sub { 
 Come sottolinea il caos, incontrerai alcune difficoltà usando  qr // . Hai davvero bisogno di precompilare il modello? In caso contrario, una strategia come questa potrebbe funzionare: 

my $pattern      = 'matt';
my $text         = 'Matt';
my $rep_text     = 'Matthew';
my $pattern_opts = 'i';

print $text, "\n" if $text =~ s/(?$pattern_opts:$pattern)/$rep_text/;


  Aggiorna in risposta al tuo nuovo codice : potresti prendere in considerazione l'utilizzo di un approccio come questo: 

<*>[0] =~ s/(?$flags:$patt)/$rep/g } :
    sub { 
 Come sottolinea il caos, incontrerai alcune difficoltà usando  qr // . Hai davvero bisogno di precompilare il modello? In caso contrario, una strategia come questa potrebbe funzionare: 

my $pattern      = 'matt';
my $text         = 'Matt';
my $rep_text     = 'Matthew';
my $pattern_opts = 'i';

print $text, "\n" if $text =~ s/(?$pattern_opts:$pattern)/$rep_text/;


  Aggiorna in risposta al tuo nuovo codice : potresti prendere in considerazione l'utilizzo di un approccio come questo: 

<*>[0] =~ s/(?$flags:$patt)/$rep/  }
;

if ( $make_replacement->($orig) ){
    print $orig;
}
else {
    print "Failed...";
}

Answer 2

Eseguilo con -r " matt " , non -r " / matt / " . Non è necessario, e in effetti non è possibile, fornire delimitatori di pattern nella stringa di opzioni. Le virgolette sono i delimitatori nel tuo qr . Quindi sta effettivamente cercando matt con delle barre attorno, nel modo in cui lo stai eseguendo, che non è quello che vuoi. Stai cercando di usare le virgolette per dire a Perl di trattare la tua stringa di pattern come se fosse un codice sorgente, ma sfortunatamente non puoi farlo.

Anche tutti quei pattern aggiunti che stai facendo per le altre opzioni non funzioneranno. Dovrai cambiare il modo in cui compili la regex se vuoi fare tutto questo. Qualcosa del genere potrebbe farlo per / i e / s :

my $compd_pattern = qr/$pattern/ or die $@;
$compd_pattern = qr/$compd_pattern/i if $options{i};
$compd_pattern = qr/$compd_pattern/s if $options{s};

Per / g dovrai supportare una versione alternativa della ricerca / sostituzione. / g non è un modificatore valido per qr // .