Use CORE when you need the real thing

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.
Leave a comment

0 Comments.

Leave a Reply


[ Ctrl + Enter ]

7ads6x98y