comment on

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>

In reply to Wx Regex Tester by boo_radley

Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!

Titles consisting of a single word are discouraged, and in most cases are disallowed outright.

Read Where should I post X? if you're not absolutely sure you're posting in the right place.

Please read these before you post! —

Posts may use any of the Perl Monks Approved HTML tags:

a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr

You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)

	For:		Use:
	&		`&`
	<		`<`
	>		`>`
	[		`[`
	]		`]`

Link using PerlMonks shortcuts! What shortcuts can I use for linking?

See Writeup Formatting Tips and other pages linked from there for more info.