How can I prevent sub rewriting in Perl?

Question

I am working with legacy code and must require .pl file that defines sub foo . My problem is that in my main:: namespace there is already another sub foo , which is called later in that part of the program that I am not currently working with.

The required file is defined by sub foo {} because, obviously, it does not want foo events to occur where they are usually called. In my case, this is bad.

I tried playing with *foo glob:

 *old_foo = *foo; require 'foo_killer.pl'; *foo = *old_foo; 

Of course, this did not work, since I created only an alias (as shown on page 133 of the Perl Master Wizard), and therefore *old_foo will now point to the "empty" routine.

Is there a way to somehow copy something in *foo{CODE} to another place instead of overlaying it? Or maybe there is a different approach to solving this issue?

Answer 1

try it

 { local *foo; require 'foo_killer.pl'; } 

Answer 2

I thought for myself. I should use the CODE part of type glob instead of assigning the whole typeglob to another type glob. This creates a copy.

 *old_foo = *foo{CODE}; require 'foo_killer.pl'; *foo = *old_foo{CODE}; 

brian d foy also talks about this in Mastering Perl (on page 131f), but does not mention the copy part.

Answer 3

I would suggest wrapping outdated malware code once and for all.

 package Foo; use strict; use warnings; use Exporter; our @ISA = qw(Exporter); our @EXPORT_OK = qw(foo bar $evil $global $variables); do "foo_killer.pl" or die "Failed to load foo_killer.pl: ".( $@ || $!); 1; 

Here I use do , because require does nothing if the code is required elsewhere. (Because of this, we had an ugly require "//path/to/code.pl" )

So you can decide whether to load foo through use Foo qw(foo); or use Foo qw(bar); .

UPDATE: Oh, and you better calculate the path to foo_killer.pl relative to __FILE__ and not load it in the absolute path:

 my $foo_killer = __FILE__; # $LIB/Foo.pm $foo_killer =~ s,(/+[^/]+),legacy,; # $LIB/legacy $foo_killer .= "foo_killer.pl"; # $LIB/legacy/foo_killer.pl # now do $foo_killer; 

It is up to you (and your team).