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

And*_* A. 0 perl package perl-exporter

我有一些代码文件开头像

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;
Run Code Online (Sandbox Code Playgroud)

这部分我无法更改(除了在“一些额外”中添加一些内容)。

所以现在其中有一个名为“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;
}
Run Code Online (Sandbox Code Playgroud)

但我得到一个错误:

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!
Run Code Online (Sandbox Code Playgroud)

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

ike*_*ami 7

你通常会想要

{
   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;
}
Run Code Online (Sandbox Code Playgroud)

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

UNITCHECK块在定义它们的单元被编译后立即运行。主程序文件及其加载的每个模块都是编译单元,字符串eval、使用正则表达式中的构造编译的运行时代码(?{ })、调用do FILErequire FILE-e命令行上开关后的代码也是如此。

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;
}
Run Code Online (Sandbox Code Playgroud)

演示

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
Run Code Online (Sandbox Code Playgroud)
$ perl -I . -M5.010 -e'use my_pck; say my_pck::mytoday'
20211010
Run Code Online (Sandbox Code Playgroud)

BEGIN绝对没有必要;它只是为了表明可以UNITCHECK在您描述的情况下使用。)