#!/usr/bin/env perl
#
# rawlinsonize - randomly mix the letters of words except the first and last
#
# $Id$

# There was a wave of publicity on this in 2003, see
#
#   http://www.mrc-cbu.cam.ac.uk/people/matt.davis/Cmabrigde/
#
# which states Graham Rawlinson's PhD research (1976, Nottingham Univ.)
# as the source.

use warnings;
use strict;

$| = 1;

sub usage
{
  print STDERR <<ZZ;

Usage:

  $0 [-s] [file [file2 [...]]]

  to reproduce the input with letters in words garbled,
  except the first and last.  This often leaves quite readable output,
  as Graham Rawlinson observed in 1976.  Details at

    http://www.mrc-cbu.cam.ac.uk/people/matt.davis/Cmabrigde/

  The -s option produces a special garbling: it sorts.
  This makes the output more compressible.

ZZ
  exit 1;
}

my $sort = 0;

while ( @ARGV && $ARGV[0] =~ /^-/ )
{
  my $opt = shift(@ARGV);

  if ( $opt =~ /^-+s/ )
  {
    $sort = 1;
  }
  else
  {
    &usage;
  }
}

sub rawlinsonized
# randomly mixes characters except the first and last
{
  my $word = shift;
  return $word if ( length($word) < 4 );

  my @chars = split( //, $word );
  for ( my $i = 1 ; $i < $#chars - 1 ; ++$i )
  {
    if ( my $pick = int( rand( $#chars - $i ) ) )
    {
      ( $chars[$i], $chars[ $i + $pick ] ) =
       ( $chars[ $i + $pick ], $chars[$i] );
    }
  }

  return join( '', @chars );
}

sub rawlinsonsorted
# sorts characters except the first and last
{
  my $word = shift;
  return $word if ( length($word) < 4 );

  my @chars  = split( //, $word );
  my $first  = shift(@chars);
  my $last   = pop(@chars);
  my @middle = sort @chars;
  return join( '', $first, @middle, $last );
}

my $garbled = $sort ? \&rawlinsonsorted : \&rawlinsonized;

while (<>)
{
  my $odd = 1;
  print map {
    if   ( $odd = !$odd ) { &$garbled($_) }
    else                  { $_ }
   }
   split( /([A-Za-z]{4,})/, $_, -1 );
}