Tôi làm cách nào để xác định lại các hàm Perl được xây dựng?

Question

Tôi muốn làm hai việc:

Trong mã sản xuất, tôi muốn xác định lại lệnh mở để cho phép tôi thêm ghi nhật ký tệp tự động. Tôi làm việc trên các ứng dụng xử lý dữ liệu/luồng và là một phần của điều đó, điều quan trọng là người dùng phải biết chính xác những tệp nào đang được xử lý. Nếu họ đang sử dụng phiên bản cũ của một tệp, một cách để họ tìm ra là đọc qua danh sách các tệp đang được xử lý.

Tôi chỉ có thể tạo một phụ mới thực hiện việc ghi nhật ký này và trả về một con trỏ tệp và sử dụng con trỏ đó thay cho mã mở trong mã của tôi.

Sẽ thật tuyệt nếu tôi chỉ có thể xác định lại mở và có lợi ích từ mã sẵn có từ hành vi này. Tôi có thể làm được không?

Trong mã gỡ lỗi, tôi muốn xác định lại lệnh printf để chèn nhận xét cùng với đầu ra bằng văn bản cho biết mã nào đã tạo dòng đó. Một lần nữa, tôi có một phụ mà sẽ tùy chọn làm điều này, nhưng chuyển đổi mã hiện tại của tôi là tẻ nhạt.

Answer 1

Để mở: Điều này phù hợp với tôi.

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

Đối với Printf: Bạn đã xem câu hỏi này chưa? ->How can I hook into Perl’s print?

Answer 2

Nếu chương trình con CORE có nguyên mẫu *, nó có thể được thay thế. Thay thế một hàm trong không gian tên hiện tại là đủ đơn giản.

#!/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; 

Nếu bạn muốn ghi đè chức năng cho tất cả các mô-đun, bạn có thể đọc docs.

* Đây là mã để kiểm tra mọi chức năng trong Perl 5.10 (nó cũng sẽ hoạt động trên các phiên bản cũ hơn). Lưu ý, một số chức năng có thể được ghi đè rằng chương trình này sẽ cho bạn biết không thể, nhưng hàm bị ghi đè sẽ không hoạt động giống như chức năng gốc.

từ perldoc -f nguyên mẫu

Nếu được xây dựng trong không overridable (như qw //) hoặc nếu đối số của nó không thể được diễn tả đầy đủ bởi một nguyên mẫu (chẳng hạn như hệ thống), nguyên mẫu() trả về undef, vì BUILTIN không thực sự hoạt động như một hàm 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