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