[MacPerl] BSDgames caesar in perl (rot13 followup)

[Geoffrey C Kinnel <Geoffrey.Kinnel@bms.com>]

Here is my attempt at the caesar program in perl. It doesn't work
the same as the original, in that it doesn't read from STDIN.
That was a choice on my part, and it should probably be changed.
I'm not much of a Perler, so I welcome any comments or
improvements. I wrote this on a linux system, so it probably
won't work on MacPerl. Doh, I just realized that now. (using
STDIN/STDOUT would fix that...silly me.)

Thanks to Brian McNett for asking about rot 13 and to Ronald
Kimball for some of the perl code. And, of course, to the BSD
folks. I have included the entire BSD copyright in the code,
which basically doubles the size of the file. *chuckle*

Geoff

--- cut here ---

#!/usr/bin/perl -w
# 
# Usage: caesar [rotation] "string"
#
# With a rotation value, it will encrypt the string. Without a
rotation
# value, it will try to decrypt the string based on frequency
analysis.
#
# This has been converted from perl to C by Geoffrey Kinnel, 11
Jan 2000
# original copyright notice of the caesar.c program is included
# below.
#
# sections of the perl code derived from Ronald J. Kimball 
#
# Begin included copyright notice from original source 
#
#/*      $NetBSD: caesar.c,v 1.9 1999/09/08 21:17:46 jsm Exp $  
*/
#
#/*
# * Copyright (c) 1989, 1993
# *      The Regents of the University of California.  All rights
reserved.
# *
# * This code is derived from software contributed to Berkeley by
# * Rick Adams.
# *
# * Authors:
# *      Stan King, John Eldridge, based on algorithm suggested
by
# *      Bob Morris
# * 29-Sep-82
# *
# * Redistribution and use in source and binary forms, with or
without
# * modification, are permitted provided that the following
conditions
# * are met:
# * 1. Redistributions of source code must retain the above
copyright
# *    notice, this list of conditions and the following
disclaimer.
# * 2. Redistributions in binary form must reproduce the above
copyright
# *    notice, this list of conditions and the following
disclaimer in the
# *    documentation and/or other materials provided with the
distribution.
# * 3. All advertising materials mentioning features or use of
this software
# *    must display the following acknowledgement:
# *      This product includes software developed by the
University of
# *      California, Berkeley and its contributors.
# * 4. Neither the name of the University nor the names of its
contributors
# *    may be used to endorse or promote products derived from
this software
# *    without specific prior written permission.
# *
# * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS
``AS IS'' AND
# * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
TO, THE
# * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
PARTICULAR
# * PURPOSE
# * ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR
CONTRIBUTORS BE LIABLE
# * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
# * CONSEQUENTIAL
# * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
SUBSTITUTE GOODS
# * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
INTERRUPTION)
# * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
CONTRACT,
# * STRICT
# * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
ARISING IN ANY
# * WAY
# * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
POSSIBILITY OF
# * SUCH DAMAGE.
# */
#/*
#* letter frequencies (taken from some unix(tm) documentation)
#* (unix is a trademark of Bell Laboratories)
#*/

# I am working on building my own letter frequency counter - gk

@freq=( 7.97, 1.35, 3.61, 4.78, 12.37, 2.01, 1.46, 4.49,
		6.39, 0.04, 0.42, 3.81, 2.69, 5.92,  6.96, 2.91, 0.08,
		6.63, 8.77, 9.68, 2.62, 0.81, 1.88, 0.23,  2.07, 0.06);

$winner = 0;
$candidate = 0;

# check for passed args, branch based on number of args
if (@ARGV > 1) { 
  cipher(@ARGV); 
} elsif (@ARGV == 0) {
     die "Usage: caesar [rotation] \"string\"\n"; 
} else {

# This heavily weights the frequency counts
  @logfreq = map { log($_)+log(26.0/100.0) } @freq; 
  
#gather frequencies from input string
  foreach (0..25) { push @obs, 0;}

  foreach $letter (split(//,$ARGV[0])){ 
    if ($letter =~ /\w/) {
      if ($letter =~ /[a-z]/) {
      $obs[ord($letter)-ord('a')]+= 1;
      } else {
      $obs[ord($letter)-ord('A')]+= 1;
      }
    }
  }

#find best fit to observed freqencies 
  foreach $try (0..25) { 
    $dot = 0;
    foreach $i (0..25) {
      $dot += $obs[$i] * $logfreq[($i+$try)%26];
    }
#initial try
    if ($try==0) {
      $winner = $dot;
    }
#save highest total
    if ($dot > $winner){
      $candidate = $try;
      $winner = $dot;
    }
  }
  print "Rotation is $candidate\n";
  
#send winning rotation plus string to cipher subroutine
  cipher($candidate, "$ARGV[0]");
}

sub cipher() { 
# peel off the rotation value
  $rot = shift; 

# if the rotation value isn't a number, exit
  if ( $rot =~ /\D/ ) { 
    die "Usage: caesar [rotation] \"string\"\n"; 
  } 

# allow for rotations greater that 26
  $rot %= 26;
  $replace = chr(ord('A')+$rot) . '-ZA-' . chr(ord('A')+$rot-1); 
  $replace .= lc($replace); 
  $string = join (' ', @_); $_ =
	$string; 
  eval <<EOEVAL; 
  tr/A-Za-z/$replace/; 
EOEVAL

$string = $_; 
print $string,"\n";

}

# ===== Want to unsubscribe from this list?
# ===== Send mail with body "unsubscribe" to macperl-request@macperl.org