test_re.pl 

• Download

#!/usr/bin/perl -w

use strict;

my ($re_str, $mod);
while (my $a = shift @ARGV) {
    if ( my ($m) = ($a =~ /-(\w+)/) ) {
        $mod .= $m;
        next;
    }
    $re_str = $a;
    last;
}
die "No regexp" unless $re_str;;

my $g = grep /g/, $mod;
$mod = join '', grep { $_ ne 'g' } split '', $mod;
$mod ||= '';
my $re = qr/(?$mod:$re_str)/;

local $/ = undef;

my $test_string = <>;

print "Matching $re_str", $mod ? " with modifiers $mod" : "", $g ? " globally" : "", "\n";

#while ( my @matched = $g ? ($test_string =~ m/(?$mod:$re_str)/g)
#                 : ($test_string =~ m/(?$mod:$re_str)/);
my $alt = 0;
my @captured_all;
my $s = $test_string;
while ( $test_string =~ m/$re/g ) {
    my $wm = $&;

#   print map "$_\n", @matched;
    my @m = ($s =~ /^(.*?)$wm(.*)$/);
    my $p = shift @m;
    $s    = pop @m;
    push @captured_all, [$wm =~ $re];

    print "Matched: $wm\n";

    last unless $g;
}

if (@captured_all) {
    print "\nCaptured groups:\n";
    foreach (@captured_all) {
        print map "\n$_", @$_;
        print "\n";
    }
} else {
    print "Not matched\n";
}