如何在我自己的包中重新定义 sub 但从新的访问旧的

Question

我有一些代码文件开头像

use my_pck;

BEGIN {
    package my_pck;
    my(@p) = ();
    foreach ( keys(%my_pck::) ) {
        push( @p, "$$_" ) if (defined $$_);
        push( @p, "\%$_" ) if (%$_);
        push( @p, "\@$_" ) if (@$_);
    }
    # ... some extra
    ( @EXPORT = @p, Exporter::import pal ) if ( $#p >= 0 );
}
use strict;
use warnings;

package my_pck;

这部分我无法更改（除了在“some extra”处添加一些内容）。

所以现在里面有一个名为“my_today”的子程序，因为我需要使用 package my_pck 它随处可用，而且经常在源文件中使用。此方法以“YYYYMMDD”格式给出当前日期作为数字。

为了检查前一天的一些测试数据，我需要重新定义这个方法来给出前一天。

我试图通过

重新定义它

sub my_today {
    my $date = my_pck::my_today();
    $date = my_datefunc($date, "-", 1)  # substracts one day
    return $day;
}

但是我得到一个错误：

Subroutine my_today redefined at ./my_file.pl line 123.
Deep recursion on subroutine "my_pck::my_today" at ./my_file.pl line 124.
Out of memory!

我该如何解决这个问题？我无法更改整个代码，因为它太多了。

Answer 1

你通常想要

{
   my $old_my_today = \&my_pck::mytoday;
   my $new_my_today = sub { my_pck::my_datefunc($old_my_today->(), "-", 1) };
   no warnings qw( redefine );
   *my_pck::mytoday = $new_my_today;
}

问题是新代码必须出现在被替换的sub之前，但我们需要在模块的其余部分编译完成后执行它。为此，我们将使用 UNITCHECK.

UNITCHECK blocks are run just after the unit which defined them has been compiled. The main program file and each module it loads are compilation units, as are string evals, run-time code compiled using the (?{ }) construct in a regex, calls to do FILE, require FILE, and code after the -e switch on the command line.

UNITCHECK {
   my $old_my_today = \&my_pck::mytoday;
   my $new_my_today = sub { my_pck::my_datefunc($old_my_today->(), "-", 1) };
   no warnings qw( redefine );
   *my_pck::mytoday = $new_my_today;
}

演示

my_pck.pm:

BEGIN {
   UNITCHECK {
      my $old_my_today = \&my_pck::mytoday;
      my $new_my_today = sub { my_pck::my_datefunc($old_my_today->(), "-", 1) };
      no warnings qw( redefine );
      *my_pck::mytoday = $new_my_today;
   }
}

package my_pck;
sub mytoday { 20211011 }
sub my_datefunc { $_[0] - 1 }
1

$ perl -I . -M5.010 -e'use my_pck; say my_pck::mytoday'
20211010

（BEGIN 完全没有必要；只是为了表明 UNITCHECK 可以用于您描述的情况。）

如何在我自己的包中重新定义 sub 但从新的访问旧的

How to redefine sub in my own package but access the old one out of the new

perl

package

perl-exporter