Perl’s a dynamic language, which means you get to change the definition of almost anything while the programming is running. You can even change the defintions of Perl’s built-in subroutine. Once you (or the evil doer who wrote the module you need) change the definition, you might want to get back to the original, and Perl provides a way for you to do that.
You can always get to the original definition by using the CORE namespace. For instance, the Tk module redefines exit so other modules don’t inadvertantly shut down your user interface. If a module such as Parallel::Forkmanager wants to run a process in the background, it doesn’t want to use the exit that Tk defined, so it needs to use CORE::exit
to get the right one:
# Parallel/ForkManager.pm sub finish { my ($s, $x, $r)=@_; if ( $s->{in_child} ) { ... CORE::exit($x || 0); } ... }
You might also redefine a Perl subroutine when you want to mock certain situations in testing. Although this Item doesn’t cover that, consider the situation where you want to test a failure to open a file. To ensure the open fails, you can redefine to always fail. You’ll see how to do that in a moment.
You can only redefine certain Perl built-in subroutines, though (who knows why, go figure). The subroutines that you can redefine have a prototype, so you just have to go through the list to see what you can play with:
use 5.013; use strict; use warnings; use Text::Autoformat qw(autoformat); my @builtins = map { "CORE::$_" } <DATA>; chomp( @builtins ); my( $redefinable, $not_redefinable ) = ( [], [] ); foreach my $builtin ( @builtins ) { push @{ defined eval { prototype $builtin } ? $redefinable : $not_redefinable }, $builtin =~ s/CORE:://r; } print autoformat "redefinable: @$redefinable\n\n"; print autoformat "not redefinable: @$not_redefinable\n\n"; __END__ ...get the list from perlfunc...
The list of non-redefinable subroutines is much shorter:
$ perl5.13 builtin.pl redefinable: abs accept alarm atan2 bind binmode bless break caller chdir chmod chown chr chroot close closedir connect continue cos crypt dbmclose dbmopen die dump each eof exit exp fcntl fileno flock fork formline getc getlogin getpeername getpgrp getppid getpriority getpwnam getgrnam gethostbyname getnetbyname getprotobyname getpwuid getgrgid getservbyname gethostbyaddr getnetbyaddr getprotobynumber getservbyport getpwent getgrent gethostent getnetent getprotoent getservent setpwent setgrent sethostent setnetent setprotoent setservent endpwent endgrent endhostent endnetent endprotoent endservent getsockname getsockopt gmtime hex index int ioctl join keys kill lc lcfirst length link listen localtime lock log lstat mkdir msgctl msgget msgrcv msgsnd oct open opendir ord pack pipe pop push quotemeta rand read readdir readline readlink readpipe recv ref rename reset reverse rewinddir rindex rmdir seek seekdir select semctl semget semop send setpgrp setpriority setsockopt shift shmctl shmget shmread shmwrite shutdown sin sleep socket socketpair splice sprintf sqrt srand stat substr symlink syscall sysopen sysread sysseek syswrite tell telldir tie tied time times truncate uc ucfirst umask unlink unpack untie unshift utime values vec wait waitpid wantarray warn write not redefinable: chomp chop defined delete do eval exec exists format glob goto grep import last local map my next no our package pos print printf prototype redo require return say scalar sort split format flags vector size order state study sub system undef use
Now that you know that you can redefine open, make one that you can use for testing. There are two ways to do this. You can redefine the subroutine per package by declaring the subourtine with use subs
. This allows you to supply your own definition for just that package:
use 5.013; package Foo { use subs qw(open); sub open { 0 } if( open my $hosts_fh, '<', '/etc/hosts' ) { print "Failed to open hosts file in foo\n"; } else { print "Failed to open hosts file in foo\n"; } } package main { if( open my $hosts_fh, '<', '/etc/hosts' ) { print "Opened hosts file in main\n"; } else { print "Failed to open hosts file in main\n"; } }
$ perl5.13 open.pl Failed to open hosts file in foo Opened hosts file in main
In that script, you only changed the open
in the Foo
package (and you used the sexy new block package
form). If you want to change the definition for the entire program, you have to do a bit more work, and you have to do it right away in a BEGIN
block so Perl knows about your definition as early as possible. You use the special CORE::GLOBAL
namespace this time (which leaves the original in CORE
). Since a global redefinition affects the entire program, you change the second use of open
to be CORE::open
:
use 5.013; BEGIN { *CORE::GLOBAL::open = sub { 0 }; } package Foo { if( open my $hosts_fh, '<', '/etc/hosts' ) { print "Failed to open hosts file in foo\n"; } else { print "Failed to open hosts file in foo\n"; } } package main { if( CORE::open my $hosts_fh, '<', '/etc/hosts' ) { print "Opened hosts file in main\n"; } else { print "Failed to open hosts file in main\n"; } } if( open my $hosts_fh, '<', '/etc/hosts' ) { print "Opened hosts file in default package\n"; } else { print "Failed to open hosts file in default package\n"; }
The output is the same, although for different reasons:
$ perl5.13 open2.pl Failed to open hosts file in foo Opened hosts file in main Failed to open hosts file in default package
If you need to be sure that you use Perl's definition, no matter what anyone else has done in your application, use the version in CORE
. You might even do that pre-emptively for something like exit
Things to remember
- You can redefine the Perl built-in subroutines that have prototypes.
- The original subroutine definition is always available in the
CORE
namespace. - You can redefine the subroutine per package with
use subs
. - You can redefine the subroutine for the entire program by redefining it in
CORE::GLOBAL
.
So if you override something like open in a .t file, then how do you get open unoverridden? For example I am writing all my unit tests in a validate.t file. For the 1st test I need unlink to fail, so you do the above, and it you can return die. For the 2nd unit test, how do you get unlink to actualy work like unlink did before you overrode it? I’ve tried *CORE::GLOBAL::unlink = \&CORE::unlink, but it doesn’t work.