Beefy Boxes and Bandwidth Generously Provided by pair Networks
more useful options
 
PerlMonks  

Regex Tester

by George_Sherston (Vicar)
on Aug 21, 2001 at 20:28 UTC ( #106630=sourcecode: print w/ replies, xml ) Need Help??

Category: Utility Scripts
Author/Contact Info George Sherston
Description: A cgi that lets you try out regular expressions and see the results in an ergonomic way. No rocket science, but a thing I, who am fairly new to regexes, have found very useful for learning how they work, and coming up with the right one to do what I want. Some people can work it all out in their heads - I find trial and error indispensable!

The code is below, in case anybody wants to put it on his or her own machine, or check to make sure it's doing what it says on the box. But if you just want to use it, then please feel free to click here

George Sherston

PS - Alright already, I know all my variables are global and I didn't use straitjacket ... it's For Home Use!
PPS - Having said that, I would, of course, welcome style comments and suggestions for how to make it slicker. Every day and in every way I am getting better and better.
#!/usr/bin/perl

read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
@input = split(/&/, $buffer);
for $i (@input) {
  ($name, $value) = split(/=/, $i);
  $name =~ tr/+/ /;
  $name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
  $value =~ tr/+/ /;
  $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
  $g{$name} = $value;
  }
$checkm = $g{'type'} eq 'm' ? ' checked' : '';
$checks = $g{'type'} eq 's' ? ' checked' : '';
if ($checkm eq $checks) {$checkm = ' checked'}
if ($checkm) {$cgvis = 'visible';$evis = 'hidden';$subvis = 'hidden';$
+g{'sub'} = '';$subheight=0;$che = '';undef $g{'e'}}
else {$cgvis = 'hidden';$evis = 'visible';$subvis = 'visible';$subheig
+ht=9;$chcg = '';undef $g{'cg'}}

$go = 2;

if ($g{'string'} || $g{'regex'}) {

  $go = 0;

  if ($g{'i'}){$chi = ' checked';push @mods,'i'}
  if ($g{'m'}){$chm = ' checked';push @mods,'m'}
  if ($g{'s'}){$chs = ' checked';push @mods,'s'}
  if ($g{'x'}){$chx = ' checked';push @mods,'x'}
  if ($g{'o'}){$cho = ' checked';push @mods,'o'}
  if ($g{'g'}){$chg = ' checked';push @mods,'g'}
  if ($g{'cg'}){$chcg = ' checked';push @mods,'cg'}
  if ($g{'e'}){$che = ' checked';push @mods,'e'}
  
  $m = join("",@mods);
  
  $file = (int rand 1000000000) . '.pl';
  open (FILE, ">$file");
  if ($g{'type'} eq 'm') {$regprint = "\@output = (\"$g{'string'}\" =~
+ /$g{'regex'}/$m);\n\$output = (\"$g{'string'}\" =~ /$g{'regex'}/$m);
+\n"}
  else {$regprint = "(\$output = \"$g{'string'}\") =~ s/$g{'regex'}/$g
+{'sub'}/$m;\n"}
  print FILE <<END;
#!c:\perl\bin\perl
$regprint
\$count = 1;
while (defined \$\$count) {
  push \@dynamics, \$\$count;
  \$count++;
  }
\$before = \$`;
\$match = \$&;
\$after = \$';
\$go = 1;
END
  
  close FILE;
  
  do "$file";
  
  if ($g{'type'} eq 'm') {$result = $output ? "Found " . (@output == 1
+ ? "one match<br>" : (scalar @output) . " matches<br>" ) : "Did not f
+ind a match<br>"}
  else {$result = "Input string becomes <b>$output</b><br>"}
  
  }

print "Content-Type: text/html\n\n";
print <<END;
<html>
<head>
<title>
 p e r l &nbsp; &nbsp; r e g e x &nbsp; &nbsp; t e s t e r </title>
<script language="javascript">
function
prev()
{
if (document.main.type[1].checked){document.main.cg.checked=0}
else {document.main.e.checked=0}
var modifiers=''
if (document.main.i.checked){modifiers+='i'}
if (document.main.m.checked){modifiers+='m'}
if (document.main.s.checked){modifiers+='s'}
if (document.main.x.checked){modifiers+='x'}
if (document.main.o.checked){modifiers+='o'}
if (document.main.g.checked){modifiers+='g'}
if (document.main.cg.checked){modifiers+='cg'}
if (document.main.e.checked){modifiers+='e'}
if (document.main.type[1].checked){document.main.preview.value=documen
+t.main.string.value+' =~ s/'+document.main.regex.value+'/'+document.m
+ain.sub.value+'/'+modifiers+';'}
else {document.main.preview.value=document.main.string.value+' =~ /'+d
+ocument.main.regex.value+'/'+modifiers+';'}
}
function
subber()
{
if (document.main.sub.value){
  document.main.type[0].checked=0;
  document.main.type[1].checked=1;
  }
}
</script>
<link rel=StyleSheet href="styles/main.css" type="text/css">
<style>
body {background-image:url();font-size:12px;padding:5px;margin:5px}
</style>
</head>
<body>
<form name="main" action="regextest.pl" onsubmit="prev()" method="POST
+">
<table cellpadding=0 cellspacing=0>
  <tr height=9>
    <td colspan=2 background="dots.gif">
    </td>
  </tr>
  <tr>
    <td colspan=2 align=right width=500>
      <input type=button onclick="prev()" value="Preview">&nbsp;&nbsp;
+&nbsp;<input type=submit value="Submit">
    </td>
  </tr>
  <tr height=9>
    <td colspan=2 background="dots.gif">
    </td>
  </tr>
  <tr>
    <td width=120 valign=top>
      Input string:
    </td>
    <td width=380>
      <input type=text style="width:100%;font-family:Arial,Verdana,Hel
+vetica,Sansserif" name="string" value="$g{'string'}">
    </td>
  </tr>
  <tr height=9>
    <td colspan=2 background="dots.gif">
    </td>
  </tr>
  <tr>
    <td width=120>
      Regex type:
    </td>
    <td width=380>
      <label for="typem"><input type=radio name="type" value="m" id="t
+ypem"$checkm> match ('m')</label>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
      <label for="types"><input type=radio name="type" value="s" id="t
+ypes"$checks> substitute ('s')</label>
    </td>
  </tr>
  <tr height=9>
    <td colspan=2 background="dots.gif">
    </td>
  </tr>
  <tr>
    <td width=120>
      Regular Expression:
    </td>
    <td width=380>
      <input type=text style="width:100%;font-family:Arial,Verdana,Hel
+vetica,Sansserif" name="regex" value="$g{'regex'}">
    </td>
  </tr>
  <tr height=9>
    <td colspan=2 background="dots.gif">
    </td>
  </tr>
  <tr>
    <td width=120>
      Substitute String:
    </td>
    <td width=380>
      <input type=text style="width:100%;font-family:Arial,Verdana,Hel
+vetica,Sansserif" name="sub" value="$g{'sub'}" onchange="subber()">
    </td>
  </tr>
  <tr height=9>
    <td colspan=2 background="dots.gif">
    </td>
  </tr>
  <tr>
    <td width=120>
      Modifiers:
    </td>
    <td width=380>
      <label for="modi"><input type=checkbox name="i" value="i" id="mo
+di"$chi> /i</label>&nbsp;&nbsp;&nbsp;
      <label for="modm"><input type=checkbox name="m" value="m" id="mo
+dm"$chm> /m</label>&nbsp;&nbsp;&nbsp;
      <label for="mods"><input type=checkbox name="s" value="s" id="mo
+ds"$chs> /s</label>&nbsp;&nbsp;&nbsp;
      <label for="modx"><input type=checkbox name="x" value="x" id="mo
+dx"$chx> /x</label>&nbsp;&nbsp;&nbsp;
      <label for="modo"><input type=checkbox name="o" value="o" id="mo
+do"$cho> /o</label>&nbsp;&nbsp;&nbsp;
      <label for="modg"><input type=checkbox name="g" value="g" id="mo
+dg"$chg> /g</label>&nbsp;&nbsp;&nbsp;
      <label for="modcg"><input type=checkbox name="cg" value="cg" id=
+"modcg"$chcg> /cg</label>&nbsp;&nbsp;&nbsp;
      <label for="mode"><input type=checkbox name="e" value="e" id="mo
+de"$che> /e</label>
    </td>
  </tr>
  <tr height=9>
    <td colspan=2 background="dots.gif">
    </td>
  </tr>
</table>
<table cellpadding=0 cellspacing=0>
  <tr>
    <td width=120>
      Preview Code:
    </td>
    <td>
      <input type=text name="preview" style="width:500;border:0;font-f
+amily:Times New Roman,Times,CG Times,serif" value="$g{'preview'}">
    </td>
  </tr>
</table>
<table cellpadding=0 cellspacing=0>
  <tr height=9>
    <td colspan=2 background="dots.gif" width=500>
    </td>
  </tr>
</table>
$aa
END
if ($go == 1) {
  print <<END;
<table cellpadding=0 cellspacing=0>
  <tr>
    <td width=120 valign=top>
      Result:
    </td>
    <td width=380 colspan=3>
      $result<br>
    </td>
  </tr>
END
  if ($before || $match || $after) {
    print <<END;
  <tr>
    <td width=120>
    </td>
    <td width=30>
      \$`
    </td>
    <td width=20>
      =
    </td>
    <td width=330>
      $before
    </td>
  </tr>
  <tr>
    <td width=120>
    </td>
    <td width=30>
      \$&
    </td>
    <td width=20>
      =
    </td>
    <td width=330>
      $match
    </td>
  </tr>
  <tr>
    <td width=120>
    </td>
    <td width=30>
      \$'
    </td>
    <td width=20>
      =
    </td>
    <td width=330>
      $after
    </td>
  </tr>
END
    }
  $count = 1;
  for $i (@dynamics) {
    print <<END;
  <tr>
    <td width=120>
    </td>
    <td width=30>
      \$$count
    </td>
    <td width=20>
      =
    </td>
    <td width=330>
      $i
    </td>
  </tr>
END
    $count++
    }
  print <<END;
  <tr height=9>
    <td colspan=4 background="dots.gif" width=500>
    </td>
  </tr>
</table>
END
  }
elsif ($go == 2) {
  print <<END;
<table cellpadding=0 cellspacing=0>
  <tr>
    <td width=120>
    </td>
    <td width=380 colspan=3>
    </td>
  </tr>
</table>
END
  }
else {
  print <<END;
<table cellpadding=0 cellspacing=0>
  <tr>
    <td width=120>
    </td>
    <td width=380 colspan=3>
      <font color=blue>SORRY, THAT REGEX BROKE.   PLEASE TRY ANOTHER O
+NE</FONT>
    </td>
  </tr>
  <tr height=9>
    <td colspan=4 background="dots.gif" width=500>
    </td>
  </tr>
</table>
END
  }
print <<END;
<table cellpadding=0 cellspacing=0>
  <tr height=10>
    <td colspan=2 width=500>
    </td>
  </tr>
  <tr height=70 valign=middle>
    <td width=200>
    </td>
    <td background="styles/paper.gif" align=center width=300>
      this page is part of <a href="http://www.sprogress.com">Sherston
+'s Progress</a>
    </td>
  </tr>
</table>

</form>
</body>
</html>
END

unlink $file;

Comment on Regex Tester
Download Code
advice
by boo_radley (Parson) on Aug 22, 2001 at 01:35 UTC
    use CGI or die;

    no votes, please. (or at least, no ++es :) feel free to swing the --stick if you're so inclined)

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://106630]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others chanting in the Monastery: (9)
As of 2014-11-23 21:40 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My preferred Perl binaries come from:














    Results (134 votes), past polls