Is there a way to overload the regex binding operator `=~` in Perl?

Question

I am working on a small DSL that uses the nomethod fallback for overloading to capture the operators used on the overloaded values. This is similar to the function of the symbolic calculator described in overload's documentation.

This works fine for the standard comparison operators, but consider the following:

my $ret = $overloaded =~ /regex/;

In this case, nomethod gets called to stringify $overloaded, and after that the overloading is lost. I thought about returning a tied variable, which will at least let me carry around the original overloaded object, but that will still get lost during the execution of the regex.

So, the ultimate question is if there is any way to extend overload's idea of a symbolic calculator to include the regex binding operators =~ and !~, so that the above code sample would call nomethod with ($overloaded, qr/regex/, 0, '=~') or something similar?

I also briefly looked into overloading the smartmatch operator ~~ but that didn't seem to do the trick either (always defaults to regex matching rather than overloading).

Edit: I looked into ~~ more, and found that my $ret = $overloaded ~~ q/regex/ works due to smartmatching rules. Close, but not an ideal solution, and I would like it to work pre 5.10, so I welcome other answers.

Answer 1

I feel as though DSLs are best written with source filters in perl. You can literally do ANYTHING you want. ;-) In your example, you can regex replace FOO =~ BAR with myfunc(FOO, BAR) and run arbitrary code.

Here's an example solution:

# THE "MyLang" SOURCE FILTER
package MyLang;
use strict;
use warnings;
use Filter::Util::Call;

sub import {
    my ($type, @args) = @_;
    my %p = @args;
    no strict 'refs';
    my $caller = caller;
    # Create the function to call
    *{"${caller}::_mylang_defaultmethod"} = sub {
        my ($a, $op, $b) = @_;
        $p{nomethod}->($a, $b, 0, $op);
    };
    my ($ref) = [];
    filter_add(bless $ref);
}

sub filter {
    my ($self) = @_;
    my ($status);
    if ($status = filter_read() > 0) {
        $_ =~ s/([^=]+)(=~)([^;]+)/ _mylang_defaultmethod($1,'$2',$3)/g;
    }
    $status;
}

1;

EXAMPLE USE

use MyLang nomethod => \&mywrap;

my $a = "foo";
my $b = "bar";
$x = $a =~ $b;

sub mywrap {
   my ($a, $b, $inv, $op) = @_;
   print "$a\n";
}

Now the above will print "foo\n" since it's what is in the "$a" variable. Of course you may want to do some slightly more intelligent parsing for the regex replacement in the filter, but this is a simple proof of concept.