Come ridefinire le funzioni di Perl incorporate?

Question

Voglio fare due cose:

Nel codice di produzione, voglio ridefinire il comando di apertura per permettermi di aggiungere la registrazione di file automagic. Lavoro su applicazioni/flussi di elaborazione dati e, come parte di questo, è importante che l'utente sappia esattamente quali file vengono elaborati. Se stanno utilizzando una vecchia versione di un file, un modo per scoprirlo è la lettura dell'elenco di file in elaborazione.

Potrei semplicemente creare un nuovo sottotitolo che esegue questa registrazione e restituisce un puntatore di file e lo utilizza al posto di aperto nel mio codice.

Sarebbe davvero bello se potessi semplicemente ridefinire aperto e il codice preesistente trae beneficio da questo comportamento. Posso farlo?

Nel codice di debug, mi piacerebbe ridefinire il comando printf per inserire commenti insieme all'output scritto che indica quale codice ha generato quella linea. Ancora una volta, ho un sottotitolo che opzionalmente lo farà, ma la conversione del mio codice esistente è noiosa.

Answer 1

Per open: Questo ha funzionato per me.

use 5.010; 
use strict; 
use warnings; 
use subs 'open'; 
use Symbol qw<geniosym>; 

sub open (*$;@) { 
    say "Opening $_[-1]"; 
    my ($symb_arg) = @_; 
    my $symb; 
    if (defined $symb_arg) { 
     no strict; 
     my $caller = caller(); 
     $symb = \*{$symb_arg}; 
    } 
    else { 
     $_[0] = geniosym; 
    } 
    given (scalar @_) { 
     when (2) { return CORE::open($symb // $_[0], $_[1]); } 
     when (3) { return CORE::open($symb // $_[0], $_[1], $_[2]); } 
    } 
    return $symb; 
} 

open PERL4_FH, '<', 'D:\temp\TMP24FB.sql'; 
open my $lex_fh, '<', 'D:\temp\TMP24FB.sql'; 

Per Printf: Hai controllato fuori questa domanda? ->How can I hook into Perl’s print?

Answer 2

Se una subroutine CORE ha un prototipo * può essere sostituito. Sostituire una funzione nello spazio dei nomi corrente è abbastanza semplice.

#!/usr/bin/perl 

use strict; 
use warnings; 

use subs 'chdir'; 

sub chdir(;$) { 
    my $dir = shift; 
    $dir = $ENV{HOME} unless defined $dir; 
    print "changing dir to $dir\n"; 
    CORE::chdir $dir; 
} 

chdir("/tmp"); 
chdir; 

Se si desidera ignorare la funzione per tutti i moduli, così si può leggere il docs.

* Ecco il codice per testare ogni funzione in Perl 5.10 (funzionerà anche sulle versioni precedenti). Nota, alcune funzioni possono essere sovrascritte che questo programma indicherà che non puoi essere, ma la funzione ignorata non si comporterà nello stesso modo della funzione originale.

da perldoc -f prototipo

Se la funzione interna non è ridefinita (come qw //) o se i suoi argomenti non possono essere adeguatamente espressi da un prototipo (come il sistema), prototipo() restituisce undef, perché la funzione interna in realtà non si comporta come una funzione Perl

#!/usr/bin/perl 

use strict; 
use warnings; 

for my $func (map { split } <DATA>) { 
    my $proto; 
    #skip functions not in this version of Perl 
    next unless eval { $proto = prototype "CORE::$func"; 1 }; 
    if ($proto) { 
     print "$func has a prototype of $proto\n"; 
    } else { 
     print "$func cannot be overridden\n"; 
    } 
} 

__DATA__ 
abs   accept   alarm   atan2   bind   
binmode  bless   break   caller   chdir 
chmod  chomp   chop   chown   chr 
chroot  close   closedir  connect   continue 
cos   crypt   dbmclose  defined   delete 
die   do    dump   each    endgrent 
endhostent endnetent  endprotoent endpwent   endservent 
eof   eval   exec   exists   exit 
exp   fcntl   fileno   flock   fork 
format  formline  getc   getgrent   getgrgid 
getgrnam  gethostbyaddr gethostbyname gethostent  getlogin 
getnetbyaddr getnetbyhost getnetent  getpeername  getpgrp 
getppid  getpriority getprotobyname getprotobynumber getprotoent 
getpwent  getpwnam  getpwuid  getservbyname getservbyport 
getservent getsockname getsockopt  glob    gmtime 
goto   grep   hex   import   index 
int   ioctl   join   keys    kill 
last   lc    lcfirst  length   link 
listen  local   localtime  lock    log 
lstat  m    map   mkdir   msgctl 
msgget  msgrcv   msgsnd   my    next 
no   oct   open   opendir   ord 
our   pack   package  pipe    pop 
pos   print   printf   prototype  push 
q   qq    qr    quotemeta  qw 
qx   rand   read   readdir   readline 
readlink  readpipe  recv   redo    ref 
rename  require  reset   return   reverse 
rewinddir rindex   rmdir   s    say 
scalar  seek   seekdir  select   semctl 
semget  semop   send   setgrent   sethostent 
setnetent setpgrp  setpriority setprotoent  setpwent 
setservent setsockopt  shift   shmctl   shmget 
shmread  shmwrite  shutdown  sin    sleep 
socket  socketpair  sort   splice   split 
sprintf  sqrt   srand   stat    state 
study  sub   substr   symlink   syscall 
sysopen  sysread  sysseek  system   syswrite 
tell   telldir  tie   tied    time 
times  tr    truncate  uc    ucfirst 
umask  undef   unlink   unpack   unshift 
untie  use   utime   values   vec 
wait   waitpid  wantarray  warn    write 
y   -r    -w    -x    -o 
-R   -W    -X    -O    -e 
-z   -s    -f    -d    -l 
-p   -S    -b    -c    -t 
-u   -g    -k    -T    -B 
-M   -A    -C