=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 Creates an instance of C, a subclass of C 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}, \&MatchOrSubstitute ); 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 ) = ""; 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[

Error in regex text : $@

<\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->{explainCheckbox}->GetValue() ) { my $yape_text = YAPE::Regex::Explain->new( $REGEX_QR )->explain; $yape_text =~ s{<}{<}g; $yape_text =~ s{>}{>}g; $ret .= qq[

            $yape_text

]; } elsif(keys %FLAGS) { $ret.=qq[ Using modifier(s): ].join(' ',keys %FLAGS ).q[ ]; } 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[ Regex text is : $REGEXSTRING Compiled regex is : $REGEX_QR ]; if (exists $FLAGS{g}){ # output global matches in ordered list form @match= map {"'$_'"}@match; $ret .=qq[ Global Matches

Listing matches

Found a newline in the regex, maybe you meant to enable /x?

1) Substitution global match count : $match

2) Substitution global match count : $match

4) Substitution global match count : $match

5} Replacement

\$&

\$`

\$'

\$+