################################################################
# auxcrypt.pl : Auxiliary routines for cryptography over the   #
#               alphabet [A..Z]                                #
#--------------------------------------------------------------#
# Technical remark: Because Perl doesn't allow easy access to  #
#   the single letters of a string sometimes strings are       #
#   transformed into lists.                                    #
#--------------------------------------------------------------#
# Klaus Pommerening 7. Juni 1997, 18. Dezember 1999            #
#                                                              #
# This module is freeware. Use it as you like.                 #
# Usual disclaimers apply.                                     #
################################################################

$alphabet = "ABCDEFGHIJKLMNOPQRSTUVWXYZ";# Our standard alphabet
                                         #   as string
@alphabet = split(//,$alphabet);         # and as list of characters

for ($i = 0; $i < @alphabet; $i++) { # Indices for alphabet
  $sa{$alphabet[$i]} = $i;           #   as hash %sa
  }

################################################################
# Subroutine to26                                              #
#   Input:  a string of ISO-LATIN-1 characters                 #
#   Output: a string transscribed to alphabet [A..Z]           #
# Some characters are ignored.                                 #
# Some characters are replaced by GERMAN description.          #
#   To use other languages modify replacement expressions.     #
################################################################
sub to26 {
  local($mytext) = $_[0];         # Get input string.
  $mytext =~ tr/a-z/A-Z/;         # Translate to upper case.
  $mytext =~ s/0/NULL/g;          # Numbers to verbal description.
  $mytext =~ s/1/EINS/g;
  $mytext =~ s/2/ZWEI/g;
  $mytext =~ s/3/DREI/g;
  $mytext =~ s/4/VIER/g;
  $mytext =~ s/5/FUENF/g;
  $mytext =~ s/6/SECHS/g;
  $mytext =~ s/7/SIEBEN/g;
  $mytext =~ s/8/ACHT/g;
  $mytext =~ s/9/NEUN/g;
  $mytext =~ s/\$/DOLLAR/g;       # Some special characters
  $mytext =~ s/%/PROZENT/g;
  $mytext =~ s/&/UND/g;
  $mytext =~ s/\+/PLUS/g;
  $mytext =~ s/=/ISTGLEICH/g;
  $mytext =~ s/¢/CENT/g;
  $mytext =~ s/£/PFUND/g;
  $mytext =~ s/¥/YEN/g;
  $mytext =~ s/§/PARAGRAPH/g;
  $mytext =~ s/¼/EINVIERTEL/g;
  $mytext =~ s/½/EINHALB/g;
  $mytext =~ s/¾/DREIVIERTEL/g;
  $mytext =~ s/ß/SS/g;
  $mytext =~ s/[ÀÁÂÃÅàáâãå]/A/g;  # Ignore
  $mytext =~ s/[ÄÆäæ]/AE/g;       # or expand diacritical marks.
  $mytext =~ s/[Çç]/C/g;
  $mytext =~ s/[ÈÉÊËèéêë]/E/g;
  $mytext =~ s/[ÌÍÎÏìíîï]/I/g;
  $mytext =~ s/[Ññ]/NN/g;
  $mytext =~ s/[ÒÓÔÕòóôõ]/O/g;
  $mytext =~ s/[ÖØöø]/OE/g;
  $mytext =~ s/[ÚÙÛùúû]/U/g;
  $mytext =~ s/[Üü]/UE/g;
  $mytext =~ tr/A-Z/x/c;          # Remaining characters
  $mytext =~ s/x//g;              #   are ignored.
  return $mytext;
  } #--- to26 --------------------------------------------------

################################################################
# Subroutine makeperm                                          #
#   Input:  a string                                           #
#   Output: a permuted alphabet as string                      #
#   Global variables in use: $alphabet (read only)             #
#   Algorithm: 1. The input string is transformed to uppercase #
#       letters and cleaned of multiple characters             #
#       Example: Secret -> SECRT.                              #
#    2. The input characters are arranged in the output string,#
#       followed by the unused characters of the alphabet.     #
#       Example: SECRET ---> SECRTABDFGHIJKLMNOPQUVWXYZ.       #
################################################################
sub makeperm {
  local($mystring) = &to26($_[0]);# Get input string.
  local($outstring);              # Output string to be build
  local($a);                      # Loop variable

  foreach $a (split(//,$mystring)) {
    unless($outstring =~ /$a/) {  # If not yet in output string
      $outstring .= $a;           #   append to output string.
      } # unless
    } # foreach

  foreach $a (split(//,$alphabet)) {
    unless ($mystring =~ /$a/) {  # If character not in string
      $outstring .= $a;           #   append to output string.
      } # unless
    } # foreach
  return $outstring;
  } #--- makeperm ----------------------------------------------

################################################################
# Subroutine gettext                                           #
#   Reads from standard input.                                 #
#   Output: the string of input characters transformed by to26 #
#     and concatenated into 1 line.                            #
################################################################
sub gettext {
  local(@inlist, $line, $result);
  chomp(@inlist = <STDIN>);         # Read input line by line,
                                    #   chop trailing CR.
  foreach $line (@inlist) {         # Change each line
    $line = &to26($line); }         #   to Alphabet [A..Z].
  $result = join("",@inlist);       # Join lines as 1 string.
  return $result;
  } #--- gettext -----------------------------------------------

################################################################
# Subroutine puttext                                           #
#   Input: A string.                                           #
#   Writes to standard output:                                 #
#     the input string as a stream of blocks of 5 characters,  #
#     blocks separated by a blank,                             #
#     10 blocks per line.                                      #
################################################################
sub puttext {
  local($mytext) = $_[0];
  local ($j) = 0;                   # Block count per line
  local ($x);                       # Five character block
  local ($r);                       # Remaining string
  while (($x,$r) = ($mytext =~ /(.{5})(.*)/)) {
                                    # Get next five chars
    print "$x";                     # and put them out.
    $mytext = $r;                   # Save remaining string.
    if ($j==9) {                    # If 10 Blocks printed
      print "\n";                   # start new line
      $j = 0;                       # and reset counter.
      }
    else {                          # Else
      print " ";                    # print space
      $j++;                         # and increment counter.
      }
    }
  if ($mytext) {                    # If text is left
    print "$mytext\n";}             # put it out.
  elsif ($j) {print "\n";}          # Else print missing new line.
  } #--- puttext -----------------------------------------------

1; #--- exit with TRUE -----------------------------------------