I have some code file beginning like

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;

This part I can't change (except adding something at "some extra").

So now there is a sub called "my_today" in it and because I need to use package my_pck its available everywhere und used often in the source file. This method gives the current day as numer in the format "YYYYMMDD".

To check some testdata from the previous day, I need to redefine this method to give the previous day too.

I tried to redefined it by

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

But so I get an error:

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!

How can I solve this? I can't change the whole code cause it's too much.

CodePudding user response：

You'd normally want

{
   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;
}

The issue is that the new code must appear before the sub being replaced, but we need to execute it after the rest of the module has been compiled. To that end, we'll use 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;
}

Demo

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

(The BEGIN is absolutely not necessary; it's just there to show that the UNITCHECK can be used in the situation you described.)