2020 twenty-four merry days of Perl Feed

Help! Rudolf's Nose Won't Light Up!

Devel::Hide - 2020-12-20

2020 has been time consuming - a global pandemic, giant fires, horrific floods and political unrest - which has left us little time for side projects. This year we're looking back to happier times into the 20+ year archive with the Best of the Perl Advent Calendar.

Often we find ourselves writing code that copes with optional dependencies; Code that will use a module to do amazing things if it's installed, but will muddle through with some lesser code path if that dependency is missing or unavailable on the system. When developing this code we need to test how the code works in both situations, preferably without breaking parts of our system setup just to check that the alternative code paths still work!

How can we do this? Gather round, I have a story to tell...

A Christmas Tale

At the north pole Cyber-Santa was in a bit of a pickle because he'd forgotten to charge the batteries for his new Robo-Reindeer's light-up nose! How would he be able to find his way through the dark and deliver techno-toys to all the good programmers and sysadmins?

Cyber-Santa was stressing out and whining on Twitter when one of his older elves reminded him that cost over-runs on the Reindeer Upgrade Project meant that he was still using the old sleigh, and that still had mounting brackets for old oil lamps.

"But do we know that those lamps still work? Are they bright enough?", Cyber-Santa asked

"Oh yes", replied the elf. "Don't you remember, last Christmas we weren't sure whether all the new Robo-Reindeer would be ready in time, so we did our test run both with and without cybernetic cervids, and everything worked just fine."

"Let me show you how we tested this", said the elf elaborated, "I'll take you step by step through what we normally do. First, we dig the sleigh out from under that snowdrift. Would you mind doing it, only my poor old back is giving me gyp right now....and then could you fetch the reindeer and attach them to the sleigh?",

So Santa dug out the sleigh, fetched the reindeer, got kicked by the reindeer, harnessed them and finally climbed up into the driver's seat, all sweaty and bruised and smelling of reindeer.

"So at this point, we're ready to go, right?" asked the elf.

"Yes!", said Cyber-Santa.

"Wrong!", replied the elf, "We're not yet ready. If you turn to page two of your Sleigh Operations Manual you'll see the pre-flight checklist. The ninety fourth item on the list (after 'are the presents tied down?' and 'do you have banging choonz queued up on your iPod?') is 'is the robot providing sufficient lighting to navigate by?'".

And so Santa checked, and the glowing Robo-NoZe™ wasn't working because of that flat battery.

"And after checklist item ninety four it tells you that if it isn't working you should use an oil lamp, doesn't it", scolded the elf.

Santa looked a bit sheepish and apologised, muttering something about being too eager to get his deliveries done so he could relax with a pint and some pork scratchings.

"I'll let you off this time", scolded the elf, "but don't do it again."

"But ... but ..." Santa said hesitantly "how do we know it will work?"

"Oh, right, I was going to show you how we tested this wasn't I. Sorry, I'm getting forgetful in my old age. Let's go indoors and simulate it on your laptop where it'll be nice and warm" smirked the elf, who really preferred the previous Santa, because the elf's children got to play with left over toys and far preferred traditional wooden blocks and balls and things instead of the modern nonsense that Cyber-Santa was obsessed with.

Modeling With Perl

"First let's simulate what you just did", said the elf. "We'll create a sleigh object, and a factory class to simulate the field that the reindeer come from.

my $sleigh   = Sleigh->new();
my @reindeer = ReindeerFactory->fetch(9);

"Then we'll harness the reindeer to the sleigh and have the sleigh run through the pre-flight checks because you're so forgetful. Then, once the pre-flight checks are complete we can get going:

$sleigh->harness(@reindeer);
if ($sleigh->pre_flight()) {
# FIXME, deliver presents here
}

"So far, so simple. Now, consider that right now your pasture contains Robo-Reindeer, but previously it contained normal reindeer. So the ReindeerFactory has to look something like this:

package ReindeerFactory;

my $reindeer_class = eval "use RoboReindeer" ? "RoboReindeer" :
                     eval "use BioReindeer" ? "BioReindeer" :
                     die("No reindeer found\n");

sub fetch {
  my $number_wanted = shift;
  return (($reindeer_class->new()) x $number_wanted);
}

"I see", said Santa, "so if the RoboReindeer module is installed (or if in real life I've got RoboReindeer in the pasture) then the factory will give me those, otherwise it'll give me BioReindeer. Very clever. That looks like a pain to test though."

"Yes, unfortunately it is" admitted the elf. "We had to run through the whole damned process twice, once for Robo-Reindeer, once for normal ones, being very careful to keep the two completely separate."

Santa was very thankful that he had elves to do that sort of hard work for him, but thought that it looked like a jolly useful technique for some of his hobby projects. "If only I could automate that in Perl..." mused Santa. But he put that aside, because he had a busy two days ahead of him.

Magic in @INC

After he'd done his two days work for the whole year, and was stretched out on the sofa with a glass of brandy and some mince pies, Santa was still wondering how to automate that. Obviously he could wrap all his tests in a shell script that would install/uninstall modules as appropriate, but that seemed terribly inelegant. But then it dawned on him - all he needed to do was interfere with how Perl loaded modules.

Normally the @INC array is just a list of directories in which perl will look, one directory after another, for modules that you try to use. But you can also put code-refs in it. For example:

  $ perl -E '
    BEGIN { unshift @INC, sub { say "Hello World" } }
    use Foo;
  '
  Hello World
  [loud complaining from perl]

(NB the BEGIN block is required so that we get to diddle @INC at compile- time. The complaining from perl is because say returns something that perl doesn't know what to do with)

When Perl finds a code-ref in @INC it passes the desired module to the code- ref, with its name reformatted from something like Foo::Bar to a filename like Foo/Bar.pm. Your code-ref can then decide not to do anything, thus making perl look in the next place listed in @INC, or it can return the source code for a module:

To have your sub-routine do nothing and have Perl carry on to the next entry in @INC have it return undef:

  $ perl -E '
    BEGIN { unshift @INC, sub { return undef } }
    use File::Temp;
  '

That code-ref has absolutely no effect - when Perl tries to use File::Temp it first executes our subroutine, which returns undef, so Perl then tries to load it from the directories that make up the rest of the list, and eventually succeeds.

So what if we want to prevent File::Temp from loading? Our @INC hook has to return an open filehandle which Perl can read the module code from, and the code we return (which Perl will then read and execute as if it were the File::Temp module) should just die instead:

  $ perl -E '
    BEGIN { unshift @INC, sub {
      # is this what we're hiding?  return an alternative file-handle
      if ($_[1] eq "File/Temp.pm") {
        open my $fh, "<", \"die(qq{$_[1] is hidden})";
        return $fh;
      }

      # not something we're hiding, return undef so Perl will continue as normal
      return undef;
    } }
    use File::Temp;
  '
  File/Temp.pm is hidden at /loader/0x7ffe498186e8/File/Temp.pm line 1.
  Compilation failed in require at -e line 8.
  BEGIN failed--compilation aborted at -e line 8.

PERL5OPT and -M

Santa was very happy and wrapped this up in a module:

package Without;

sub import {
  shift;
# translate a list of modules to a list of filenames
my @hidden = map {
    s!::!/!g;
    "$_.pm";
  } @_;

  unshift @INC, sub {
# $_[0] is this sub-routine itself.
my $wanted = $_[1];
    if(grep { $wanted eq $_ } @hidden) {
      open my $fh, "<", \"die(qq{$wanted is hidden})";
      return $fh
    }
    return undef;
  }
}

1;

So that he could invoke like this to test his code with both RoboReindeer and BioReindeer, with one but not the other, and even without both:

  make test &&
  PERL5OPT=-MWithout=RoboReindeer             make test &&
  PERL5OPT=-MWithout=BioReindeer              make test &&
  PERL5OPT=-MWithout=RoboReindeer,BioReindeer make test

PERL5OPT is an environment variable that contains extra command line arguments that will be passed to any Perl process. -M is used to load a module on the command line, but using it to pass arguments to the module's import()method is less well known.

A few days later

Santa was very pleased with himself and later that week he went to his local Perl Mongers meeting, with his laptop, so that he could show everyone his nifty new trick.

"Oh, you wanted Devel::Hide", they told him, adding that PERL5OPT isn't used in taint-mode and that the trick of using open to turn a scalar into a filehandle didn't work in some really old perls.

"Bother", said Santa, as he deleted his code and installed Devel::Hide from the CPAN. "Ah well, it was fun anyway."

  make test &&
  PERL5OPT=-MDevel::Hide=RoboReindeer             make test &&
  PERL5OPT=-MDevel::Hide=BioReindeer              make test &&
  PERL5OPT=-MDevel::Hide=RoboReindeer,BioReindeer make test

SEE ALSO

Gravatar Image This article contributed by: David Cantrell <david@cantrell.org.uk>