Tuesday, January 21, 2014

A Perl Tidbit (aka Evil P3rl R Us)

Say you have Perl script A which is deployed in multiple sites, does its job well and thus should not be changed/refactored. In my case it takes a phone number on the command line and decides whether it's from Canada. The verdict is communicated via the exit code.

At one site one needs to write script B which does what A does but has a different interface incompatible with the one of A (in my case it must be an Asterisk AGI script).

Refactor? Nah, that's for wimps. Call A from B as a subshell? Suboptimal, for wimps only.

We need to go old skool and do. Never heard of perl-do? Not-for-the-faint-hearted.

Bad news: A calls exit(1) in multiple places. That bombs B as well. Two things to do: use $SIG{__DIE__} [doesn't work satisfactorily] or overload exit:

#!/usr/bin/perl

use strict;
use warnings;

use Asterisk::AGI;

push @INC => '/root'; # A.pl needs this :(

my $AGI = new Asterisk::AGI;

my %input = $AGI->ReadParse();

$ARGV[0] = $input{callerid}; # fake passing args using command line

my $canada;
eval {
   no warnings;
   local *CORE::GLOBAL::exit = sub {
     my $excode = shift;
     $AGI->noop("Exit code was $excode");
     $canada = !int($excode);
     goto out; # A.pl calls the overloaded exit twice w/o this (!!)
   };

   -r '/root/A.pl' or $AGI->noop("Cannot read A.pl: $!");
   $AGI->noop("do() FAILED $@ - $!") unless do '/root/A.pl';
};
out:
$AGI->set_variable('RESULT', $canada? 'YES': 'NO');

0;
-ulianov