0: I don`t know if this is Craft, or a hack, I DO know that
1: it comes in handy (For me, since I am not a complete master
2: of regular expressions (not until japhy's) book at least ;))
3:
4: I am sure there is something like this out there, but I haven`t
5: bothered to look (sometimes it is just more fun to do something
6: yourself ;)
7:
8: What does it do ?
9:
10: It draws you a little Tk window, and allows you to enter a string
11: and let a RegEx loose on it.
12: Dynamically the result of the RegEx is shown, and updated, so you
13: can see exactly what the result is of a change in the RegEx, or the
14: string.
15:
16: TODO:
17:
18: - Do something about that UI! ;)
19: - Put an another eval in the function so $1..n are really
20: 1..n, instead of 1..5 ;)
21: - Support for @+ @-
22: - Clean up code ;)
23: - Loads of stuff
24:
25: Code will be updated soon, I hope ;)
26:
27: Update: Implemented List context feature, as suggested by Jepri
28:
29: The Code:
30: #!/usr/bin/perl -w
31: use strict;
32: use Tk;
33:
34: sub KeyPress;
35:
36: my $MW=MainWindow->new;
37:
38: my $AsList;
39: my %Border=qw(-relief raised);
40: my %Fill=qw(-fill both);
41:
42: my $Top =$MW->Frame->pack(-side=>'top');
43: my $TopLeft =$Top->Frame(%Border)->pack(-side=>'left');
44: my $TopRight =$Top->Frame(%Border)->pack(-side=>'left');
45:
46: my $RegLabel=$TopLeft->Label(%Border,-text=>'RegExp')->pack(%Fill);
47: my $TextLabel=$TopLeft->Label(%Border,-text=>'Text')->pack(%Fill);
48: my $AsListBox=$Top->Checkbutton(-text=>'List context',-variable=>\$AsList,-command=>\&KeyPress)->pack();
49: $Border{-bd}=1;
50: my $RegExp=$TopRight->Entry(-width=>30)->pack();
51: my $Text=$TopRight->Entry(-width=>30)->pack();
52:
53: my $ResultTextFrame =$MW->Frame(%Border)->pack(-side=>'left');
54: my $ResultTextLabel=$ResultTextFrame->Label(-justify=>'left',-text=>"PreMatch:\nMatch:\nPostMatch:\nResult:\n\$1..n")->pack(%Fill);
55:
56: my $ResultFrame =$MW->Frame(%Border)->pack(-side=>'left',%Fill);
57: my $ResultLabel=$ResultFrame->Label(-justify=>'left',-text=>"none\nnone\nnone\nnone")->pack(%Fill);
58:
59:
60: $MW->bind('all', '<KeyPress>', \&KeyPress);
61: MainLoop();
62:
63: sub KeyPress
64: {
65: local $^W=0;
66: my $RegEx=$RegExp->get;
67: my $Text =$Text->get;
68: my (@Dollar,@Result,$Result,$Match,$PreMatch,$PostMatch);
69: my $Function;
70: my $FieldCodes=join "",'$Match=$&;',
71: '$PreMatch=$`;',
72: "\$PostMatch=\$';",
73: "\$Dollar[0]=\$1;",
74: "\$Dollar[1]=\$2;",
75: "\$Dollar[2]=\$3;",
76: "\$Dollar[3]=\$4;",
77: "\$Dollar[4]=\$5;";
78: if (!$AsList)
79: {
80: $Function=join "",'($Result=$Text)=~',"$RegEx;",$FieldCodes;
81: }
82: else
83: {
84: $Function=join "",'@Result=($Text=~',"$RegEx);",$FieldCodes;
85: };
86: eval $Function;
87: $Result||=join "|",@Result;
88: $Match||='none'; $PreMatch||='none'; $PostMatch||='none';
89: $ResultLabel->configure(-text=>"$PreMatch\n$Match\n$PostMatch\n$Result\n@Dollar");
90: $ResultLabel->update;
91: };
92:
In reply to Test-a-Rex
by ChOas
-
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.