#!/usr/bin/perl -w

# matchtest.pl

#    VERSION: 3 (25 June 2004)
#    PURPOSE: Facilitates testing of regular expressions
#    INPUT: From keyboard
#        1. input string
#        2. regular expression
#    OUTPUT: To monitor, either "Expression ... found" or 
#            "Expression ... not found"

############## LIBRARIES AND PRAGMAS ################
  use strict;

#################### CONSTANTS ######################

  my $true = 1;                # used to assign truth value 
  my $false = 0;               # used to assign truth value 
  my $LF = "\n";               # Line feed

#################### VARIABLES ######################

  my $wants_to_stop;           # false until user wants out
  my $answer;                  # response from yes/no question
  my $string;                  # string to be searched
  my $new_string;              # string offered by user. If blank, use old string
  my $regex;                   # regular expression used in matching
  my $new_regex;               # regular expression offered by user.
                               #   If blank, use old regular expression

################### MAIN PROGRAM ####################

  do {

     $answer = Yes_or_no("Want to try a regular expression? (yes or no) ");

     if ($answer eq "yes") {          # user wants a go at it
        $wants_to_stop = $false;

          ### get string to be searched and regular expression
        $new_string = Get_string("Enter a line of text to be searched " .
                                 "(or nothing to retain previous line)" .  
                                 $LF . "    TEXT: ");
        if ($new_string ne "") {$string = $new_string};
        $new_regex = Get_string("Enter a regular expression " .
                                "(or nothing to retain previous expression)" .
                                $LF . "    EXPRESSION: ");     
        if ($new_regex ne "") {$regex = $new_regex};
        $regex = Check_regex_format($regex);

          ### print results
        print "Expression '$regex' ";
        if ($string =~ $regex) {
           print "FOUND\n";
           if (defined $1) {print "Captured: $1", "\n"};
        } else {print "NOT FOUND\n"}

     } else {                         # user wants to stop
        $wants_to_stop = $true;
     }

  } until ($wants_to_stop);

  print $LF, $LF, "Thank you for using matchtest!", $LF;

#################### SUBROUTINES ####################

sub Get_string {
# Prints prompt given from subroutine call
# Gets input from user (removes ENTER) and returns it

  my $prompt = $_[0];
  print $prompt;
  my $string = <STDIN>;
  chomp $string;
  return $string;
}

sub Yes_or_no {
# Prints prompt given from subroutine call
# Forces yes/no response from user
# Returns answer in lower case

  my $prompt = $_[0];
  my $answer = "";

  until ($answer eq "y" | $answer eq "n") {
    print "\n", $prompt;
    $answer = substr(lc(<STDIN>), 0, 1);
    chomp $answer;
  }
  if ($answer eq "y") {return "yes"}
  else {return "no"}
}

sub Check_regex_format {
# Removes leading and lagging blanks
# Makes sure that regex begins, ends with /
# Strips away / /

  (my $given_expr) = @_;
  $given_expr =~ /^ *(.*) *$/;
  my $expr = $1;
  if (substr($expr,0,1) ne "/" 
      or substr($expr,-1,1) ne "/")
     {print "WARNING: You forgot to enclose the pattern in '/'", $LF}
  $expr =~ /^\/?(.*?)\/?$/;
  return $1
  }