Skip to content

Instantly share code, notes, and snippets.

@ernix
Last active April 11, 2019 14:14
Show Gist options
  • Star 1 You must be signed in to star a gist
  • Fork 2 You must be signed in to fork a gist
  • Save ernix/a613c09d7e5fee7f91f9 to your computer and use it in GitHub Desktop.
Save ernix/a613c09d7e5fee7f91f9 to your computer and use it in GitHub Desktop.
Mock(override) built-in `open` function in perl.
#
# http://perldoc.perl.org/CORE.html#OVERRIDING-CORE-FUNCTIONS
# > To override a built-in globally (that is, in all namespaces), you need to
# > import your function into the CORE::GLOBAL pseudo-namespace at compile
# > time:
# >
# > BEGIN {
# > *CORE::GLOBAL::hex = sub {
# > # ... your code here
# > };
# > }
#
BEGIN {
no strict 'refs';
use Symbol ();
#
# http://perldoc.perl.org/perlsub.html#Prototypes
# > If subroutine signatures are enabled (see Signatures), then the shorter
# > PROTO syntax is unavailable, because it would clash with signatures. In
# > that case, a prototype can only be declared in the form of an
# > attribute.
#
*CORE::GLOBAL::open = sub : prototype(*;$@) {
#
# http://perldoc.perl.org/functions/open.html
# > If FILEHANDLE is an undefined scalar variable (or array or hash
# > element), a new filehandle is autovivified, meaning that the
# > variable is assigned a reference to a newly allocated anonymous
# > filehandle. Otherwise if FILEHANDLE is an expression, its value is
# > the real filehandle. (This is considered a symbolic reference, so
# > use strict "refs" should not be in effect.)
#
# http://perldoc.perl.org/Symbol.html
# > Symbol::qualify turns unqualified symbol names into qualified
# > variable names (e.g. "myvar" -> "MyPackage::myvar"). If it is given
# > a second parameter, qualify uses it as the default package;
# > otherwise, it uses the package of its caller. Regardless, global
# > variable names (e.g. "STDOUT", "ENV", "SIG") are always qualified
# > with "main::".
#
# http://perldoc.perl.org/functions/caller.html
# > Returns the context of the current pure perl subroutine call. In
# > scalar context, returns the caller's package name if there is
# > a caller (that is, if we're in a subroutine or eval or require) and
# > the undefined value otherwise.
#
if (defined $_[0]) {
unshift @_, Symbol::qualify(shift, scalar caller);
}
#
# open FILEHANDLE
#
# http://perldoc.perl.org/CORE.html#DESCRIPTION
# > For all Perl keywords, a CORE:: prefix will force the built-in
# > function to be used, even if it has been overridden or would
# > normally require the feature pragma. Despite appearances, this has
# > nothing to do with the CORE package, but is part of Perl's syntax.
#
return CORE::open($_[0]) if @_ == 1;
#
# open FILEHANDLE,EXPR
#
return CORE::open($_[0], $_[1]) if @_ == 2;
#
# open FILEHANDLE,MODE,EXPR
# open FILEHANDLE,MODE,REFERENCE
#
# http://perldoc.perl.org/functions/open.html
# > As a special case the three-argument form with a read/write mode
# > and the third argument being undef:
# >
# > open(my $tmp, "+>", undef) or die ...
# >
# > opens a filehandle to an anonymous temporary file. Also using +<
# > works for symmetry, but you really should consider writing
# > something to the temporary file first. You will need to seek() to
# > do the reading.
#
return CORE::open($_[0], $_[1], $_[2]) if @_ == 3 && defined $_[2];
return CORE::open($_[0], $_[1], undef) if @_ == 3;
#
# open FILEHANDLE,MODE,REFERENCE
#
# http://perldoc.perl.org/functions/open.html
# > In the form of pipe opens taking three or more arguments, if LIST
# > is specified (extra arguments after the command name) then LIST
# > becomes arguments to the command invoked if the platform supports
# > it. The meaning of open with more than three arguments for non-pipe
# > modes is not yet defined, but experimental "layers" may give extra
# > LIST arguments meaning.
#
return CORE::open($_[0], $_[1], @_[2..$#_]);
};
}
1;
@davorg
Copy link

davorg commented Dec 9, 2015

Thanks for this, it was useful for some rather obscure work that I was doing today. I had a few problems with your Symbol::qualify line though. In the case where open() was called from a package other than main and it was using a bareword filehandle, I was getting errors. These went away when I replaced your line 49 with the following:

if (defined $_[0]) {
    my $x = shift;
    unshift @_, Symbol::qualify($x, scalar caller);
}

Hope this is useful.

@ernix
Copy link
Author

ernix commented Jun 10, 2016

@davorg Thanks, updated.

@klopp
Copy link

klopp commented Nov 15, 2016

With this code I get (when DB_File is used):
Name "DB_File::FH" used only once: possible typo at /usr/lib/i386-linux-gnu/perl/5.22/DB_File.pm line 283

@klopp
Copy link

klopp commented Nov 15, 2016

And (for use Log::Any::For::Std):

Bareword "STDERR" not allowed while "strict subs" in use at /usr/local/share/perl/5.22.1/Log/Any/Adapter/Duperr.pm line 21.
Compilation failed in require at (eval 403) line 1.
BEGIN failed--compilation aborted at /usr/local/share/perl/5.22.1/Log/Any/For/Std.pm line 11.

@ernix
Copy link
Author

ernix commented Feb 20, 2017

@klopp Put your use DB_File; and use Log::Any::For::Std above the BEGIN block. This piece of monkey patch is not for these packages but for old/legacy CGI scripts like open(FH, "|/usr/sbin/sendmail -t -n -oi -f $blahblah"); that make me want to poke my eyes out.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment