Perl Smart Matching Not Sufficiently Smart

Recently I have been adding more and more functionality into emacs using comint. And as there are more and better perl libraries for hooking into other systems (such as DBI, SOAP, HTTP…), I often start with a script that reads commands from stdin and writes the result to stdout. That is the comint way.

use strict;
use warnings;

use 5.010;

init(); # -- some initialization that takes a while

# ...

while (defined(my $command = <STDIN>)) {
    chomp $command;

    given (lc($command)) {
        when (/^\s*exit\s*$/)    { exit 0; }
        when (/^\s*send\s*$/)    { say 'send' }
        when (/^\s*receive\s*$/) { say 'receive' }
        default { say "Error: unrecognized command $command"; }
    }
}

If initialisation takes a long time, it is a big saving to only do it once for many commands.

As emacs has full control over the process, I can control what gets sent and filter what is received before display. However, I prefer to be a little bit flexible with what the perl process receives for when I am testing it from the command line. That is why I allow surrounding spaces.

when (/^\s*exit\s*$/)    { ... }
when (/^\s*send\s*$/)    { ... }
when (/^\s*receive\s*$/) { ... }

Those matching regexes look pretty similar. I almost feel like I’m violating DRY.

Unfortunately, the subroutine references only take a single parameter.

sub cexit { return $_[0] =~ /^\s*exit\s*$/ }
sub csend { return $_[0] =~ /^\s*send\s*$/ }
sub creceive { return $_[0] =~ /^\s*receive\s*$/ }

# ...

when (\&cexit)    { exit 0; }
when (\&csend)    { say 'send' }
when (\&creceive) { say 'receive' }

But there is a way of storing data along with a subroutine – a closure. However, the following strangely doesn’t work.

sub match_command
{
    my $command = shift;
    return sub {
        my $input = shift;
        say "Input is [$input]";
        return $input =~ /^\s*$command\s*$/;
    }
}

while (defined(my $command = <STDIN>)) {
    chomp $command;

    given (lc($command)) {
        when (match_command('send')) { say 'send' }
        when (match_command('exit')) { exit 0; }
        when (match_command('receive')) { say 'receive' }
        default { say "Error: unrecognized command $command"; }
    }
}

Whereas storing the closures in a variable before smart matching does work. Unfortunately it looks like smart matching isn’t smart enough for my needs.

my $send = match_command('send');
my $exit = match_command('exit');
my $receive = match_command('receive');

# ...

when ($send) { say 'send' }
when ($exit) { exit 0; }
when ($receive) { say 'receive' }

And the result:

c:\home\juang>perl t.pl
send
Input is [send]
send
exit
Input is [exit]

About these ads