################################################################
# pattword.pl : Pattern search in texts or wordlists.          #
#                                                              #
#    The pattern is taken from the command line parameter      #
#       and converted to a regular expression.                 #
#       Non-letters are deleted from pattern,                  #
#       the pattern is converted to uppercase,                 #
#       the search is case insensitive.                        #
#    Input from STDIN : Text to search.                        #
#       Non-letters are deleted from text.                     #
#    Output to STDOUT : Matching lines with line number and    #
#       first occurence of the pattern.                        #
#--------------------------------------------------------------#
# Example: The pattern AEGKEEA matches (d)iskussi(on).         #
#--------------------------------------------------------------#
# Klaus Pommerening 7. September 1999, 29. Oktober 1999        #
#                                                              #
# This program is freeware. Use it as you like.                #
# Usual disclaimers apply.                                     #
################################################################

$ARGV[0] =~ s/[^a-zA-Z]//g;        # Delete non-letters.
$ARGV[0] =~ tr/a-z/A-Z/;           # Convert to uppercase.

$regexp = &str2reg($ARGV[0]);      # Build a regular expression
                                   #   from the pattern.
$nn = 0;                           # Line number
while (<STDIN>) {                  # Read input line.
  $nn++;                           # Increment line number.
  s/[^a-zA-Z]//g;                  # Delete non-letters.
  print "$nn : $_ : $&\n" if /$regexp/io;# Match case insensitive,
                                   #   only first occurence,
                                   #   print matching line.
  }

################################################################
# Subroutine str2reg                                           #
#  Input:  a string                                            #
#  Output: a regular expression describing the correspopnding  #
#          numerical pattern, or - in other words -            #
#          the string and all its monoalphabetic substitutions.#
# Adapted from Mats Kindahl, matkin@mailhost.iar.se            #
#   sci.crypt, 26 Jan 1999                                     #
################################################################
sub str2reg {
  local($myreg);                   # Output regular expression
  local($n);                       # Actual number in pattern
  local(%myassoc);                 # Character is key,
                                   #   associated number ist value.

  foreach (split(//,$_[0])) {      # Split input string into single chars.
                                   # Actual character in $_
    if ($myassoc{$_}) {            # If character already registered,
      $myreg .= "\\". $myassoc{$_};# append associated variable number
      }                            #   (with backslash escaped).
    else {
      $myreg .= $n ? "(?!\\" . join("|\\",values(%myassoc)) . ")(.)"
                   : "(.)";
           # If $n = 0, append "(.)" - meaning "match any char".
           # Else append an expression like "(?!\\1|\\2)(.)" -
           # meaning "match any character but none with is
           # the value of an already assigned variable number.
      $myassoc{$_} = ++$n;         # Increment actual number and
                                   #   associate character with it.
      }
    }
  return $myreg;
  } #--- str2reg -----------------------------------------------
