I'd been working on this as a new tutorial, but since major tom expressed the desire, here's a little wx tool that will break down a regex into component bits.
I sincerely apologize for the godawful eval in the OnRunButton sub, but this was the only way I could come up with to safely execute a regex that might not compile. If you have suggestions on how to improve this, please tell me!
This script is released under the same terms as perl.
There's room for improvement, as always :) I thought about putting a rich text control into the tool so that matches could be color coded and so forth, and probably some statistical information about the regex itself.

Breakdown :

Given a regex of "s/(foo)/bar/" and a test string of "foo bax", the tool will give you this output:
Regex text is : 's/(foo)/bar/'

Test text is : 'foo bax'

Contents of test text changed :

Was : 'foo bax'

Is now :  'bar bax'

This is a match



Captures --

Capture $1 is 'foo'



$& is 'foo'

$` is ''

$' is ' bax'

$+ is 'foo'

The goods : 

use Wx;
package MyApp;

use strict;
use vars qw(@ISA);
@ISA=qw(Wx::App);

sub OnInit {
  my( $this ) = @_;

  # create new MyFrame
  my( $frame ) = MyFrame->new( "wxRegTest",
                   Wx::Point->new( 50, 50 ),
                   Wx::Size->new( 450, 350 )
                             );

  $this->SetTopWindow( $frame );
  $frame->Show( 1 );
  1;
}

package MyFrame;

use strict;
use vars qw(@ISA);

@ISA=qw(Wx::Frame);

use Wx::Event qw(EVT_MENU);
use Wx qw(wxBITMAP_TYPE_ICO wxMENU_TEAROFF
          wxTE_MULTILINE wxBITMAP_TYPE_ICO wxTE_READONLY
          wxWidth wxHeight wxLeft wxTop wxPercentOf wxBottom wxDefault
+Position wxDefaultSize
          wxID_CANCEL wxCentreX wxCentreY wxALIGN_RIGHT );
use Wx::Event qw(EVT_SIZE EVT_MENU EVT_COMBOBOX EVT_UPDATE_UI
 EVT_TOOL_ENTER EVT_TEXT_ENTER);

my( $ID_TOOLBAR, $ID_COMBO ) = ( 1 .. 100 );
my( $IDM_TOOLBAR_TOGGLE_ANOTHER_TOOLBAR, $IDM_TOOLBAR_TOGGLETOOLBARSIZ
+E,
    $IDM_TOOLBAR_TOGGLETOOLBARORIENT, $IDM_TOOLBAR_TOGGLETOOLBARROWS,
    $IDM_TOOLBAR_ENABLEPRINT, $IDM_TOOLBAR_DELETEPRINT,
    $IDM_TOOLBAR_INSERTPRINT, $IDM_TOOLBAR_TOGGLEHELP,
    $IDM_TOOLBAR_TOGGLEFULLSCREEN ) = ( 10_000 .. 10_100 );

use Wx qw(wxBITMAP_TYPE_BMP wxBITMAP_TYPE_XPM);
use Wx::Event qw(EVT_BUTTON);
sub new {
    my( $class ) = shift;
    my( $this ) = $class->SUPER::new( undef, -1, $_[0], $_[1], $_[2] )
+;
    
    # load an icon and set it as frame icon
    $this->SetIcon( Wx::GetWxPerlIcon() );
    $this->{Panel} = Wx::Panel->new($this,0,[0,0],[1000,1000]);
    $this->{RegexLabel}= Wx::StaticText->new($this->{Panel},-1,'regex 
+string :',[-1,-1],[-1,-1],wxALIGN_RIGHT );
    $this->{RegexText} = Wx::TextCtrl->new( $this->{Panel}, -1, 's/(fo
+o)/bar/');
    $this->{TestLabel}= Wx::StaticText->new($this->{Panel},-1,'Test st
+ring :',[-1,-1],[-1,-1],wxALIGN_RIGHT );
    $this->{TestText} = Wx::TextCtrl->new( $this->{Panel}, -1, 'foo ba
+x');
    $this->{RunButton} = myButton->new($this->{Panel}, -1, 'Test regex
+');     
    $this->{ResultText} = Wx::TextCtrl->new ($this->{Panel},-1,"", [0,
+ 250], [100, 50],  wxTE_MULTILINE);
    $this->CreateStatusBar(1);
    $this->{Panel}->SetAutoLayout( 1 );  
    my $b1 = Wx::LayoutConstraints->new();
    my $b2 = Wx::LayoutConstraints->new();  
    my $b3 = Wx::LayoutConstraints->new();
    my $b4 = Wx::LayoutConstraints->new();
    my $b5 = Wx::LayoutConstraints->new();
    my $b6 = Wx::LayoutConstraints->new();
    
    $b1->left->Absolute(00);
    $b1->top->Absolute(0);
    $b1->width->AsIs();
    $b1->height->AsIs();  
     
    $this->{RegexLabel}->SetConstraints($b1);   
    $b2->left->RightOf ($this->{RegexLabel});
    $b2->top->SameAs ($this->{RegexLabel}, wxTop);
    $b2->width->PercentOf($this->{Panel},wxWidth,86);
    $b2->height->AsIs();  
    $this->{RegexText}->SetConstraints($b2);
    $b3->left->Absolute(0);
    $b3->top->Below($this->{RegexLabel},10);
    $b3->width->SameAs ($this->{RegexLabel}, wxWidth);
    $b3->height->AsIs();
    $this->{TestLabel}->SetConstraints ($b3);
    
    $b4->left->RightOf ($this->{TestLabel});
    $b4->top->SameAs ($this->{TestLabel}, wxTop);
    $b4->width->PercentOf($this->{Panel},wxWidth,86);
    $b4->height->AsIs();  
    $this->{TestText}->SetConstraints ($b4);
    
    $b5->top->Below($this->{TestText}, wxTop);
    $b5->left->Absolute (0);
    $b5->height->AsIs();
    $b5->width->AsIs();
    $this->{RunButton}->SetConstraints ($b5);

    $b6->top->Below($this->{RunButton}, wxTop);
    $b6->left->Absolute (0);
    $b6->height->PercentOf($this->{Panel}, wxHeight, 78);;
    $b6->width->PercentOf($this->{Panel}, wxWidth, 100);;
    $this->{ResultText}->SetConstraints ($b6);
    
    $this->SetStatusText( "Regex Tester", 0 );
    
    EVT_BUTTON( $this, $this->{RunButton}, \&OnRunButton );
    $this;
}

sub OnRunButton {
    # runs the regex.
    my $this=shift;
    $|++;
    my $resulttext=$this->{ResultText};
    $resulttext->Clear();
    my $retext=$this->{RegexText}->GetValue();
    my $testtext = $this->{TestText}->GetValue();
    my $testtext2 = $testtext;
    my $ismatch;
    my @match;$match[0]="";
    my $_match;
    my $_prematch;
    my $_postmatch;
    my $_lastparen;
    # I apologize for this eval block.
    eval ("\$ismatch = \$testtext2 \=\~ $retext;
        no strict qw (refs);      
        my \$i=0;
        while (defined (\${++\$i})){
            push \@match, \${\$i}  
        }
        \$_match = \$&;
        \$_prematch=\$`;
        \$_postmatch=\$';
        \$_lastparen=\$+;
        ");
    if ($@) {        
        my $errstr = $@;
        $resulttext->AppendText ("Error running regex : $errstr\n");
        return;
    }
    $resulttext->AppendText("Regex text is : '$retext'\n");
    $resulttext->AppendText("Test text is : '$testtext'\n");
    unless ($testtext eq $testtext2) {
        $resulttext->AppendText("Contents of test text changed :\nWas 
+: '$testtext'\nIs now :  '$testtext2'\n");           
    }
    
    unless ($ismatch){
        # no match? exit early.
        $resulttext->AppendText("No match here.\n");
        return;
    }
    $resulttext->AppendText("This is a match\n");   
    
    if ($#match==0) {
         $resulttext->AppendText("No captures\n");
         return;
    }
    $resulttext->AppendText("\nCaptures --\n");              
    for my $i (1.. $#match) {
        $resulttext->AppendText("Capture \$$i is '$match[$i]'\n");    
+        
    }
    $resulttext->AppendText("\n\$& is '". $_match ."'\n");
    $resulttext->AppendText("\$` is '". $_prematch ."'\n");
    $resulttext->AppendText("\$' is '". $_postmatch ."'\n");
    $resulttext->AppendText("\$+ is '". $_lastparen ."'\n");
    
}

package myButton;
use strict;
use vars qw(@ISA);
use Wx::Event qw(EVT_BUTTON);
@ISA=qw(Wx::Button);
sub new{
    my $class = shift;
    my $this = $class->SUPER::new( @_ );   
    $this;
}
package main;
my $app = new MyApp;
$app->MainLoop();

[download]

Edit by tye to add <readmore>

Replies are listed 'Best First'.
Re: Wx Regex Tester
by Dog and Pony (Priest) on Apr 10, 2002 at 08:55 UTC
    I sincerely apologize for the godawful eval in the OnRunButton sub, but this was the only way I could come up with to safely execute a regex that might not compile.

    You could always precompile the regexp: 

    my $regexp = qr/$retext/
  or $resulttext->AppendText ("Error running regex : $errstr\n"), retu
+rn;

# regexp ok, code continues

$ismatch = $testtext2 =~ /$regexp/;

    [download]
    ... or something like that.

    Also, instead of 
    while (defined (${++$i})){
  push @match, ${$i}  
}

    [download]
    you could do something like this right off the bat: 
    @match = $testtext2 =~ /$regexp/;

    [download]

    Anyhow, I will try this program when I get home, where I have WxPerl installed. Since I am about to take the time to learn it a little myself, it is very nice to see that others are already using it!

    You have moved into a dark place.
    It is pitch black. You are likely to be eaten by a grue.
[reply]
[d/l]
[select]

      Dog and Pony sez :

      You could always precompile the regexp:

      I had a compiled regex in for a while, and it worked well for matches. But my understanding of compiled regexes led me to think I'd need something like :
      $testtext2 =~ s/$retext/$repltext/for substitutions.

      Which seems like I'd need to add in another text field for the replacement text, and then another text field (or checkboxes) for the flags. This would actually make it look quite similar to JEdit's RETester, in fact.

      I'll put it on the to do list.
[reply]
[d/l]
        You could still use the precompiled regexp to do that, if that makes things better. :) $repltext on the other hand, should of course not be compiled. 
        $testtext2 =~ s/$regexp/$repltext/

        [download]
        Still haven't been home and awake long enough simultaneously... but I'll get there, if nothing else at the weekend. Stupid friends wanting to do non-nerd stuff. And outside! Where there is light from non-monitor sources! Heathens... :)
        You have moved into a dark place.
        It is pitch black. You are likely to be eaten by a grue.
[reply]
[d/l]
[select]
Re: Wx Regex Tester
by MZSanford (Curate) on Apr 10, 2002 at 10:58 UTC
    Not that i think any changes are needed, but Safe may be a good idea to prevent the regexp s/./system('rm -rf /')/e from causing problems ... tho, this is an on-machine user-level process, so that might be taking the security too far ... if thats possible. I suggest it to save (stupid) users from themselves. Just a thought.
    from the frivolous to the serious
[reply]
[d/l]

Back to Cool Uses for Perl