私は2つのことをしたい：
製品コードでは、自動ファイル ログを追加できるように open コマンドを再定義したいと考えています。私はデータ処理アプリケーション/フローに取り組んでおり、その一環として、ユーザーがどのファイルが処理されているかを正確に知ることが重要です。古いバージョンのファイルを使用している場合、それを見つける方法の 1 つは、処理中のファイルのリストを読むことです。
このログを記録してファイル ポインターを返す新しいサブを作成し、それをコード内の open の代わりに使用することができます。
open を再定義して、既存のコードがこの動作から恩恵を受けることができれば、本当に素晴らしいことです。これはできますか？
デバッグ コードでは、 printfコマンドを再定義して、どのコードがその行を生成したかを示す出力と共にコメントを挿入したいと考えています。繰り返しますが、オプションでこれを行うサブがありますが、既存のコードを変換するのは面倒です。
CORE サブルーチンにプロトタイプがある場合、*それを置き換えることができます。現在の名前空間の関数を置き換えるのは簡単です。
#!/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;
すべてのモジュールの関数もオーバーライドしたい場合は、docsを読むことができます。
*Perl 5.10 のすべての関数をテストするコードを次に示します (以前のバージョンでも動作します)。一部の関数はオーバーライドできますが、このプログラムではオーバーライドできないことが示されますが、オーバーライドされた関数は元の関数と同じようには動作しません。
perldoc -f プロトタイプから
ビルトインがオーバーライド可能でない場合 (qw// など)、またはその引数をプロトタイプ (システムなど) で適切に表現できない場合、prototype() は undef を返します。これは、ビルトインが実際には 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
オープンの場合：これは私にとってはうまくいきました。
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';
Printfの場合：この質問を確認しましたか？-> Perlの印刷にフックするにはどうすればよいですか？