Beefy Boxes and Bandwidth Generously Provided by pair Networks
Keep It Simple, Stupid
 
PerlMonks  

comment on

( [id://3333]=superdoc: print w/replies, xml ) Need Help??
RegexLab.p(m|l)
=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{RegexLab.pm}; # or the oneliner version (quotes may vary ;) perl -mRegexLab -e"exec $^X, $INC{q{RegexLab.pm}};" # -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: RegexLab.pm,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: RegexLab.pm,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/Explain.pm'} 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{'Safe.pm'}, 'Safe.pm', -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 Safe.pm 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!!! Safe.pm isn't installed.", wxYES_NO, $self, ) == wxYES ){ $INC{'Safe.pm'}++; } 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 PerlMonks.org 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 http://perlmonks.org/index.pl?node_id=164418 This one is available at http://perlmonks.org/index.pl?node_id=216762 Released under the same terms as perl it self (see perl.com 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
RegexLab.xrc
<?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

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



  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others wandering the Monastery: (6)
As of 2024-04-18 18:05 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found