Beefy Boxes and Bandwidth Generously Provided by pair Networks
Welcome to the Monastery

Comment on

( #3333=superdoc: print w/replies, xml ) Need Help??
=head1 NAME RegexLab - a Wx Dialog/App for testing Regular Expressions =head1 SYNOPSIS perl -MRegexLab -e RegexLab::App->new()->MainLoop() # or use RegexLab; # or should it be Wx::RegexLab RegexLab::App->new()->MainLoop(); # or even require RegexLab; exec $^X, $INC{}; # or the oneliner version (quotes may vary ;) perl -mRegexLab -e"exec $^X, $INC{q{}};" # -m is equivalent to use RegexLab(); in case you was wondering =head1 DESCRIPTION Run it as a standalone app, or embed it easily into any wxPerl application, so you can test and devise regular expressions without starting a separate shell. Install YAPE::Regex::Explain to gain insight into what you wrote. Perfect for newbies and experienced users. $Id:,v 1.10 2002/12/01 14:02:30 _ Exp $ =cut package RegexLab; use strict; use Wx qw[ :everything ]; use Wx::Event qw[ EVT_BUTTON EVT_CHECKBOX EVT_RIGHT_DOWN EVT_MENU EVT_ +COMMAND]; use Wx::XRC; use Wx::Html; use base 'Wx::Frame'; use vars qw( $revision $VERSION ); $revision = '$Id:,v 1.10 2002/12/01 14:02:30 _ Exp $'; $VERSION = sprintf("%d.%02d", q$Revision: 1.10 $ =~ /: (\d+)\.(\d+)/); =head1 What you need to know =head2 C<new> Creates an instance of C<RegexLab>, a subclass of C<Wx::Frame> This is the only function you should call if not running it as an app. You know what, don't. Just always run it as an app =cut sub new { my( $class ) = shift; my $self = $class->SUPER::new( undef, -1, "Regex Lab - you know what it is ;)", [0,0], [350,350], wxDEFAULT_FRAME_STYLE | wxCLIP_CHILDREN, # for easy commenting out ); $self->SetIcon( Wx::GetWxPerlIcon() ); my $rs = Wx::XmlResource->new; $rs->InitAllHandlers(); $rs->Load( 'RegexLab.xrc' ); my( $MainSizer ) = Wx::BoxSizer->new( Wx::wxHORIZONTAL ); $MainSizer->Add( $rs->LoadPanel($self,'regexLabPanel'), 1, wxGROW +); $self->SetSizer( $MainSizer ); $self->SetAutoLayout( 1 ); ## ;) $self->Layout(); ##force layout of the children anew $MainSizer->Fit( $self ); $MainSizer->SetSizeHints( $self ); $self->{regexLabPanel} = $self->XRC('regexLabPanel'); $self->{gCheckbox} = $self->XRC('gCheckbox'); $self->{iCheckbox} = $self->XRC('iCheckbox'); $self->{mCheckbox} = $self->XRC('mCheckbox'); $self->{eCheckbox} = $self->XRC('eCheckbox'); $self->{sCheckbox} = $self->XRC('sCheckbox'); $self->{xCheckbox} = $self->XRC('xCheckbox'); $self->{explainCheckbox} = $self->XRC('explainCheckbox'); $self->{replacementCheckbox} = $self->XRC('replacementCheckbox'); $self->{replacementString} = $self->XRC('replacementString'); $self->{regexString} = $self->XRC('regexString'); $self->{testString} = $self->XRC('testString'); $self->{testButton} = $self->XRC('testButton'); $self->{htmlOut} = $self->XRC('htmlOut'); $self->{replacementString}->SetValue(q[$2-$1ay]); EVT_CHECKBOX( $self, $self->{replacementCheckbox}, \&MatchOrSubsti +tute ); EVT_BUTTON( $self, $self->{testButton}, \&TestMeRegex ); EVT_RIGHT_DOWN( $self, \&OnAbout ); EVT_RIGHT_DOWN( $self->{regexLabPanel}, \&OnAbout ); EVT_RIGHT_DOWN( $self->{htmlOut}, \&OnAbout ); $self->FlickEmBoxes(); return $self; } sub TestMeRegex { #################### # html color block my $matchcolor = '"#66ff66"'; my $capturecolor = '"#ffff66"'; my $errorcolor = '"#FF6568"'; my $flagcolor = '"#FFABFC"'; my $svarcolor = '"#00D9EB"'; #'"#993399"'; my $explaincolor = '"#00E5FF"'; #'"#993366"'; # end html colors #################### my( $self, $event ) = @_; my( $hOut ) = $self->{htmlOut}; my( $ret ) = "<html><body><table border=\"0\">"; my( @Mflags ) = qw( i x m g s ); my( $E ) = $self->{eCheckbox}; # REGEXSTRING INSTRING REPSTRING my $REGEXSTRING = $self->{regexString}->GetValue(); my $INSTRING = $self->{testString}->GetValue(); #use vars qw[ $REPSTRING ]; my $REPSTRING = $self->{replacementString}->GetValue(); my $RegexFlags = ""; use vars qw[ $INSTRING2 $match $REGEX_QR ]; local( $INSTRING2, $match, $REGEX_QR ); unless( $REGEXSTRING ) { # do we have valid pattern? $ret.=qq[ <tr> <td bgcolor=$errorcolor> Error in regex text : $@</td> </tr> </table></body><\html> ]; $hOut->SetPage( $ret ); return(); }; my %FLAGS=(); my $FLAGS=""; for my $flag ( qw[ g i m s e x ]) { # what flags are we using? if( $self->{$flag."Checkbox"}->GetValue() ) { $FLAGS{$flag}=1; } } $REGEX_QR = eval qq[ qr{$REGEXSTRING}$FLAGS ]; ## ugh, LAME!!!! if(exists $FLAGS{g} ) { delete $FLAGS{g}; $FLAGS = join '', keys %FLAGS if %FLAGS; $FLAGS{g}=1; } else { $FLAGS = join '', keys %FLAGS if %FLAGS; } if( exists $INC{'YAPE/Regex/'} and $self->{explainCheckb +ox}->GetValue() ) { my $yape_text = YAPE::Regex::Explain->new( $REGEX_QR )->explai +n; $yape_text =~ s{<}{&lt;}g; $yape_text =~ s{>}{&gt;}g; $ret .= qq[ <tr> <td bgcolor=$explaincolor colspan="2"> <pre> $yape_text </pre> </td> </tr> ]; } elsif(keys %FLAGS) { $ret.=qq[ <tr> <td bgcolor=$flagcolor colspan="2"> Using modifier(s): ].join(' ',keys %FLAGS ).q[ </td> </tr> ]; } if( $INSTRING =~ m{$REGEX_QR} ) { # we match! (i'm quoting boo ;) my @match=(); if ( exists $FLAGS{g} ) { @match = ( $INSTRING =~ m{$REGEX_QR}g ); } $ret.= qq[ <tr> <td bgcolor=$matchcolor> <strong> Regex text is : </strong> </td> <td bgcolor=$matchcolor> $REGEXSTRING </td> </tr> <tr> <td bgcolor=$matchcolor> <strong> Compiled regex is : </strong> </td> <td bgcolor=$matchcolor> $REGEX_QR </td> </tr> ]; if (exists $FLAGS{g}){ # output global matches in ordered list + form @match= map {"'$_'"}@match; $ret .=qq[ <tr> <td bgcolor=$capturecolor colspan="2"> <center> <strong> Global Matches </strong> </center> </td> </tr> <tr> <td bgcolor=$capturecolor colspan="2"> <ol> ]; $ret .=join "\n",(map {"<li>$_</li>"} @match); } else { # not a global search, but matches may exist if (defined $1){ # print out $1, $2, etc. $ret.= qq( <tr> <td bgcolor=$capturecolor colspan="2"> <center> <strong> Listing matches </strong> </center> </tr> </td> ); ####EVIL, EVIL, EVIL!!!!!! Okay, not so evil, but I have issues w/it. #### I guess i'll have to rewrite this (can't steal everything) no strict qw( refs ); # booga booga! my $ct=1; while (defined ${"$ct"}) { $ret .= qq( <tr> <td bgcolor=$capturecolor colspan="2"> \$$ct is : '${"$ct"}' </td> </tr> ); $ct++; } } else { print "not found\n"; } } } else { # no match. so sorry. return early. $ret .= qq{<tr><td bgcolor=$errorcolor colspan="2">No match.}; if ($REGEXSTRING =~ m{\n} and exists $FLAGS{x} ) { $ret .=qq[ <p> Found a newline in the regex, maybe you meant to enable /x? </p> ]; } $hOut->SetPage( $ret.q[</td></tr></table></body><\html>] ); return; } ## Substitution? ## REGEXSTRING INSTRING REPSTRING if( $self->{replacementCheckbox}->GetValue() ) { my $REPLACEMENT = $self->{regexString}->GetValue(); $INSTRING2 = $INSTRING; if( $self->{eCheckbox}->GetValue() ) { if(! index( $INC{''}, '', -8) == 12 ) { # re +ally safe my $safe = Safe->new(); $safe->share(qw( $INSTRING2 $REGEX_QR $match )); $safe->trap(qw( :filesys_write :subprocess :ownprocess :dangerous :base_thread goto ) ); $safe->permit(qw( :still_to_be_decided ) ); my $DANGER = $REPSTRING; ## MAKE IT SAFE , cause I use {} as my delimiters $DANGER =~ s/([}{])/\\$1/g; $DANGER = q[ $match = ( $INSTRING2 =~ s{$REGEX_QR}{]. +$DANGER; $DANGER.= '}e'.$FLAGS.');'; $safe->reval( $DANGER ); if($@){ $ret.=qq[ <tr> <td bgcolor=$errorcolor colspan="2"> Error in eval text : $@ </td> </tr> </table></body><\html> ]; $hOut->SetPage( $ret ); return(); } if(exists $FLAGS{g}) { $ret .=qq[ <tr> <td bgcolor=$capturecolor colspan="2"> <center> <strong> 1) Substitution global match count : $match </strong> </center> </td> </tr> ]; } } else { ## THE UNSAFE EVAL (YOU CAN exit() and do all kinds of other stuff ## MAKE IT SAFE , cause I use {} as my delimiters $REPSTRING =~ s/([}{])/\\$1/g; my $codefromoutside = q[ $match = ( $INSTRING2 =~ s{$ +REGEX_QR}{]; $codefromoutside.= $REPSTRING."}"; $codefromoutside.= exists $FLAGS{g} ? 'g' : ''; $codefromoutside.= 'e );'; eval $codefromoutside; if($@){ $ret.=qq[ <tr> <td bgcolor=$errorcolor colspan="2"> Error in eval text : $@ </td> </tr> </table></body><\html> ]; $hOut->SetPage( $ret ); return(); } if (exists $FLAGS{g}) { $ret .=qq[ <tr> <td bgcolor=$capturecolor colspan="2"> <center> <strong> 2) Substitution global match count : $match </strong> </center> </td> </tr> ]; } } } else { ## IT'S A SIMPLE STRING REPLACEMENT (NOT EVAL, STRING +) ## MAKE IT SAFE , cause I use {} as my delimiters $REPSTRING =~ s/([}{])/\\$1/g; my $codefromoutside = q[ $match = ( $INSTRING2 =~ s{$REGE +X_QR}{]; $codefromoutside.= $REPSTRING."}"; $codefromoutside.= exists $FLAGS{g} ? 'g' : ''; $codefromoutside.= ');'; eval $codefromoutside; if (exists $FLAGS{g}) { $ret .=qq[ <tr> <td bgcolor=$capturecolor colspan="2"> <center> <strong> 4) Substitution global match count : $match </strong> </center> </td> </tr> ]; } } } unless ($INSTRING eq $INSTRING2) { $ret.=qq( <tr> <td bgcolor=$capturecolor colspan="2"> <strong> <center> 5} Replacement </center> </strong> Contents of test text changed : <br> Was : '$INSTRING' <br> Is now : '$INSTRING2' <br> </td> </tr> ); } ## these don't seem like they'd matter in a global match/search... unless (exists $FLAGS{g}) { $ret .= qq[ <tr> <td align="center" bgcolor=$svarcolor colspan="2"> <em> <font size="+1"> \$& </font> </em> is '$&' </td> </tr> <tr> <td align="center" bgcolor=$svarcolor colspan="2"> <em> <font size="+1"> \$` </font> </em> is '$`' </td> </tr> <tr> <td align="center" bgcolor=$svarcolor colspan="2"> <em> <font size="+1"> \$' </font> </em> is '$'' </td> </tr> <tr> <td align="center" bgcolor=$svarcolor colspan="2"> <em> <font size="+1"> \$+ </font> </em> is '$+' </td> </tr> ]; } $hOut->SetPage( $ret.q[</td></tr></table></body><\html>] ); } sub FakeACheckAndGetOffFree { my($self, $evt ) = @_; warn "@_"; } sub MatchOrSubstitute { my( $self, $event ) = @_; # my $state = $event->IsChecked() ? 1 : 0 ; ## if $event is one from an accelerator, the box don't get checked, bu +t i took that part out ? my $state = $self->{replacementCheckbox}->GetValue() ? 1 : 0; $self->{replacementString}->Enable( $state ); $self->{replacementCheckbox}->SetValue( $state ); $self->{eCheckbox}->Enable( $state ); } sub FlickEmBoxes { my $self = shift; ## tool tips seem to suck for lables and text controls if( eval q{require Safe}) { warn "Safe is instaled, enabling e modifier"; } else { if( Wx::MessageBox( "You don't have installed, so\n". "it may be unsafe to use the /e modifier\n". "in a substitution.\n". "Do you want to enable the e flag?\n". "(be warned, you can only say yes once)", "WATCHOUT!!! isn't installed.", wxYES_NO, $self, ) == wxYES ){ $INC{''}++; } else { $self->{'eCheckbox'}->Show(0); $self->{'eCheckbox'}->SetValue(0); } } if( eval {require YAPE::Regex::Explain} ){ warn "YAPE::Regex::Explain is installed, enabling Explain"; $self->{explainCheckbox}->Enable(1); } #the rohnettes opened for the stones Wx::ToolTip::Enable(1); Wx::ToolTip::SetDelay(50); # ms } sub XRC { my($self,$object)=@_; return $self->FindWindow( Wx::XmlResource::GetXRCID( $object ) ); } # display a simple about box sub OnAbout { my( $this, $event ) = @_; my $about = __PACKAGE__." $VERSION\nCreated by PodMaster\n" . "Running on wxPerl $Wx::VERSION"."\n" . wxVERSION_STRING; Wx::MessageBox( $about, "About ".__PACKAGE__, # TITLE wxOK | wxICON_INFORMATION, $this, ); } package RegexLab::App; use strict; use Wx; use base qw(Wx::App); sub OnInit { my $self = shift; my $frame = RegexLab->new(); $self->SetTopWindow($frame); $frame->Show(1); $frame->Refresh(); return 1; } package main; # if this file is invoked directly (not use'd), run the app unless( caller() ) { RegexLab::App->new()->MainLoop(); } __END__ We are not afraid to be on fire. =head1 CAVEATS RegexLab.xrc is required =head1 AUTHOR Originally written by boo_radley of fame. Transformed into its this form by PodMaster (same fame), for easy inclusion in other Wx applications, or for standalone use. If you want the original, it's available at This one is available at Released under the same terms as perl it self (see for more i +nfo). =head1 TODO +Clean up the code a little, maybe refactor some logic. +Maybe add HTML::Template support (everybody loves it, right? ;) +And perhpas a color-scheme chooser (maybe even stylesheet support) =cut ## note to self ;D ## cvs co -r 1.5 RegexLab
<?xml version="1.0" ?> <resource> <object class="wxPanel" name="regexLabPanel"> <size>450,350</size> <style>wxNO_BORDER</style> <object class="wxBoxSizer"> <orient>wxVERTICAL</orient> <object class="sizeritem"> <object class="wxStaticBoxSizer"> <label>Regex String</label> <orient>wxHORIZONTAL</orient> <object class="sizeritem"> <object class="wxTextCtrl" name="regexString"> <value>\b([b-df-hj-np-tv-z])(\w+)</value> <size>450,50</size> <style>wxTE_MULTILINE|wxNO_BORDER</style> <tooltip>Insert regular expression pattern here</tooltip +> </object> <option>1</option> <flag>wxEXPAND|wxGROW</flag> </object> </object> <option>0</option> <flag>wxTOP|wxEXPAND</flag> <border>5</border> </object> <object class="sizeritem"> <object class="wxCheckBox" name="replacementCheckbox"> <label>Make mine a replacement</label> <checked>0</checked> <style>wxNO_BORDER</style> <tooltip>make mine a substitution (s///)</tooltip> </object> <option>0</option> <flag>wxALL|wxEXPAND</flag> <border>5</border> </object> <object class="sizeritem"> <object class="wxStaticBoxSizer"> <label>Replacement String</label> <orient>wxHORIZONTAL</orient> <object class="sizeritem"> <object class="wxTextCtrl" name="replacementString"> <size>450,50</size> <style>wxTE_MULTILINE|wxNO_BORDER</style> <tooltip>s{pattern}{stuff you enter here goes here}</too +ltip> </object> <option>1</option> <flag>wxEXPAND|wxGROW</flag> </object> </object> <option>0</option> <flag>wxEXPAND</flag> </object> <object class="sizeritem"> <object class="wxStaticBoxSizer"> <label>Test String</label> <orient>wxVERTICAL</orient> <object class="sizeritem"> <object class="wxTextCtrl" name="testString"> <value>hello world!</value> <size>450,50</size> <style>wxTE_MULTILINE|wxNO_BORDER</style> <tooltip>string to operate on goes here</tooltip> </object> <option>1</option> <flag>wxEXPAND|wxGROW</flag> </object> </object> <option>0</option> <flag>wxTOP|wxBOTTOM|wxEXPAND</flag> <border>5</border> </object> <object class="sizeritem"> <object class="wxStaticBoxSizer"> <label>Flags (aka modifiers)</label> <orient>wxHORIZONTAL</orient> <object class="sizeritem"> <object class="wxBoxSizer"> <orient>wxHORIZONTAL</orient> <object class="sizeritem"> <object class="wxCheckBox" name="gCheckbox"> <label>g</label> <checked>0</checked> <style>wxNO_BORDER</style> <tooltip>g - match globally</tooltip> </object> <option>0</option> <flag>wxALIGN_CENTRE|wxALL</flag> <border>5</border> </object> <object class="sizeritem"> <object class="wxCheckBox" name="iCheckbox"> <label>i</label> <checked>0</checked> <style>wxNO_BORDER</style> <tooltip>i - Do case-insensitive pattern matching.</ +tooltip> </object> <option>1</option> <flag>wxALIGN_CENTRE|wxALL</flag> </object> <object class="sizeritem"> <object class="wxCheckBox" name="mCheckbox"> <label>m</label> <checked>0</checked> <style>wxNO_BORDER</style> <tooltip>m - Treat string as multiple lines.</toolti +p> </object> <option>0</option> <flag>wxALIGN_CENTRE|wxALL</flag> <border>5</border> </object> <object class="sizeritem"> <object class="wxCheckBox" name="eCheckbox"> <label>e</label> <checked>0</checked> <style>wxNO_BORDER</style> <enabled>0</enabled> <tooltip>e - Evaluate the right side as an expressio +n.</tooltip> </object> <option>0</option> <flag>wxALIGN_CENTRE|wxALL</flag> <border>5</border> </object> <object class="sizeritem"> <object class="wxCheckBox" name="sCheckbox"> <label>s</label> <checked>0</checked> <style>wxNO_BORDER</style> <tooltip>s - Treat string as single line</tooltip> </object> <option>0</option> <flag>wxALIGN_CENTRE|wxALL</flag> <border>5</border> </object> <object class="sizeritem"> <object class="wxCheckBox" name="xCheckbox"> <label>x</label> <checked>0</checked> <style>wxNO_BORDER</style> <tooltip>x - Permit whitespace and comments.</toolti +p> </object> <option>0</option> <flag>wxALIGN_CENTRE|wxALL</flag> <border>5</border> </object> <object class="sizeritem"> <object class="wxCheckBox" name="explainCheckbox"> <label>Explain</label> <checked>0</checked> <style>wxNO_BORDER</style> <enabled>0</enabled> <tooltip>use YAPE::Regex::Explain to explain the reg +ex.</tooltip> </object> <option>0</option> <flag>wxALIGN_CENTRE|wxALL</flag> <border>5</border> </object> </object> <option>0</option> <flag>wxEXPAND|wxGROW|wxALIGN_CENTRE</flag> </object> <object class="sizeritem"> <object class="wxBoxSizer"> <orient>wxVERTICAL</orient> <object class="sizeritem"> <object class="wxButton" name="testButton"> <label>Test Regex</label> <default>1</default> <enabled>1</enabled> <focused>1</focused> <hidden>0</hidden> <tooltip>eval that code\ntest your *hypothesis* ;)</ +tooltip> </object> <flag>wxALIGN_RIGHT|wxALIGN_CENTRE_VERTICAL</flag> </object> </object> <option>1</option> <flag>wxGROW|wxALIGN_RIGHT</flag> </object> </object> <option>0</option> <flag>wxTOP|wxBOTTOM|wxEXPAND|wxALIGN_CENTRE</flag> <border>5</border> </object> <object class="sizeritem"> <object class="wxBoxSizer"> <orient>wxHORIZONTAL</orient> <object class="sizeritem"> <object class="wxHtmlWindow" name="htmlOut"> <tooltip>This is where the explanation goes</tooltip> </object> <option>1</option> <flag>wxEXPAND|wxGROW|wxALIGN_CENTRE</flag> </object> </object> <option>1</option> <flag>wxEXPAND|wxGROW|wxALIGN_CENTRE</flag> </object> </object> <exstyle>wxWS_EX_VALIDATE_RECURSIVELY</exstyle> </object> </resource>

In reply to RegexLab (a wxPerl version) by PodMaster

Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":

  • 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, 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, 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:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?

    What's my password?
    Create A New User
    and all is quiet...

    How do I use this? | Other CB clients
    Other Users?
    Others avoiding work at the Monastery: (6)
    As of 2018-01-18 11:58 GMT
    Find Nodes?
      Voting Booth?
      How did you see in the new year?

      Results (211 votes). Check out past polls.