Is there a way to mock the built-in require function in Perl?

I am developing an application that has to replace an existing mess of spaghetti-code piece by piece. To achieve this I have a dispatcher that runs required HTTP resources when a URI has been matched and otherwise uses the legacy HTTP resource class.

So, this legacy HTTP resource has to require the entry point file of the old system, and I'm trying to figure out how to test this process. The way I see it now is I would like to replace the original require function with a mock subroutine and check that it has b开发者_如何学Goeen called with an appropriate file name.

Is this possible, and if not, maybe there is a better way to do it?

To override require in a single package:

use subs 'require';  # imports `require` so it can be overridden

sub require {print "mock require: @_\n"}

To override require globally:

BEGIN {
    *CORE::GLOBAL::require = sub {print "mock require: @_\n"}
}

And then:

require xyz;           # mock require: xyz.pm

require Some::Module;  # mock require: Some/Module.pm

A better way to override require globally may be to install a hook into @INC. This little-known functionality is described at the end of the require documentation.

Here's a simple example that intercepts any request for a module whose name begins with HTTP:

BEGIN {
  unshift @INC, sub {
    my ($self, $file) = @_;
    return unless $file =~ /^HTTP/;
    print "Creating mock $file\n";
    my @code = "1"; # Fake module must return true
    return sub { $_ = shift @code; defined $_ };
  }
}

require HTTP::Foo;
use HTTPBar;

Note that this also mocks use, since it's based on require.

Hooks can be added as code refs into your @INC path. These will then be applied globally to both use and require statements.

To quote perldoc require

You can also insert hooks into the import facility by putting Perl code directly into the @INC array.

There are three forms of hooks: subroutine references, array references, and blessed objects.

Subroutine references are the simplest case. When the inclusion system walks through @INC and encounters a subroutine, this subroutine gets called with two parameters, the first a reference to itself, and the second the name of the file to be included (e.g., "Foo/Bar.pm"). The subroutine should return either nothing or else a list of up to three values in the following order:

1. A filehandle, from which the file will be read.

2. A reference to a subroutine. If there is no filehandle (previous item), then this subroutine is expected to generate one line of source code per call, writing the line into $_ and returning 1, then finally at end of file returning 0. If there is a filehandle, then the subroutine will be called to act as a simple source filter, with the line as read in $_ . Again, return 1 for each valid line, and 0 after all lines have been returned.

3.Optional state for the subroutine. The state is passed in as $_[1] . A reference to the subroutine itself is passed in as $_[0]

Here's an example:

#!/usr/bin/perl

sub my_inc_hook {
    my ($sub_ref, $file) = @_;

    unless ($file =~ m{^HTTP/}) {
        warn "passing through: $file\n";
        return;
    }

    warn "grokking: $file\n";
    return (\*DATA);
}

BEGIN {
    unshift(@INC, \&my_inc_hook);
}

use strict;
require warnings;
require HTTP::Bazinga;

HTTP::Bazinga::it_works();

__DATA__
package HTTP::Bazinga;

sub it_works {warn "bazinga!\n"};

1;

Produces:

$ perl inc.pl
passing through: strict.pm
passing through: warnings.pm
grokking: HTTP/Bazinga.pm
bazinga!

I believe this works for perl 5.10.0 and above.