http://www.perlmonks.org?node_id=106630
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;

Back to Code Catacombs