#!/usr/bin/perl -w
# Created by Ben Okopnik on Mon Mar 24 23:35:26 EDT 2008
# Regex Explorer

use strict qw/vars/;
use Term::ReadLine;
my $term = new Term::ReadLine 'Regex Explorer';
my $OUT = $term -> OUT || \*STDOUT;

print $OUT "Exit by entering an empty string at any prompt.\n\n";

{
    my $string = $term->readline("String: ");
    exit if $string =~ /^$/i;
    my $regex = $term->readline("Regex: ");
    exit if $regex =~ /^$/i;
    if ($regex !~ /^\s*((?:y|tr|s|m)\W|\/)/){
        print $OUT "The regex must be a valid match or a substitute ex
+pression.\n\n";
        redo;
    }
    my $tr = $regex =~ /^\s*(?:y|tr)\W/ ? 1 : 0;
    my $cap = $regex =~ /\([^?]/ ? 1 : 0;

    # This eval should fail on anything except a match, subst, or tr
    my $old_string = $string;
    eval "\$string =~ $regex";
    if ($@){
        print $OUT "$@\n\n";
        redo;
    }
    # Restore original after this eval
    $string = $old_string;

    # Variables declared in the eval must be escaped; those that aren'
+t
    # will be interpreted in the scope of the surrounding script.
    my $ret = eval qq%
        my \$match = \$string =~ $regex;
        my \$out = 'Matched: ' . (\$match ? "Yes" : "No");
        if (\@+ > 1 && ! $tr && $cap){
            \$out .= "\nCaptures:";
            \$out .= qq" [#\$_: '" . (\${\$_} || '') . "']" for 1 .. \
+$#+;
        }
        return "\$out\n";
        %;                      # End of eval

    print $OUT $@ ? "\nERROR: $@\n" : "\nResult: $string\n$ret\n";
    redo;
}
[download]