test_re.pl
#!/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";
my $alt = 0;
my @captured_all;
my $s = $test_string;
while ( $test_string =~ m/$re/g ) {
my $wm = $&;
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";
}