#!/usr/bin/perl

use strict;
use warnings;
use Getopt::Std;

my $USAGE = 
    "playfair.pl [-o outfile] [-i infile] [-d | -e] [ keyword [infiles
+] ]";

my $opt_OK = getopts('hdeo:i:',\my %opts);

if (!$opt_OK || $opts{h}) { die "Usage:\n\n$USAGE\n\n"; }
    

my $decode = $opts{d};  # -e does nothing, being the default
if ($opts{o}) { 
    open STDOUT, '>', $opts{o} 
        or die "Unable to open $opts{o} for output: $!\n";
}
if ($opts{i} ) {
    open STDIN,  '<', $opts{i} 
        or die "Unable to open $opts{i} for input: $!\n";
}
my $keyword = lc (shift) || "playfair";
$keyword =~ tr/j/i/;

my (@square,%letters);

my $i = 0;
for (split (//, $keyword), "a".."i", "k".."z") {
    next if $letters{$_};
    my ($row,$col) = (int $i/5, $i % 5);
    $letters{$_} = [$row, $col];
    $square[$row][$col] = $_;
    $i++;        
}

# But in the Latin alphabet, Jehovah begins with an I!
$letters{j} = $letters{i}; 

my $SHIFT = $decode ? -1 : -4; # let Perl handle the wrapping for us

my (@input,@output);

while (<>) {
    push @input, lc =~ /[a-z]/g;

    while ( @input > 1 ) {
        my ($let1,$let2) = splice @input,0,2;
        if ($let2 eq $let1) {
            unshift @input, $let2;
            $let2 = ($let2 eq 'x') ? 'z': 'x';
        }
        push @output, transcribe ($let1,$let2);    
    }
}

if (@input) {
    push @output, transcribe ($input[0],($input[0] eq 'x') ? 'z': 'x')
+;
}    

$" = '';
$, = ' '; 
$\ = $/;

@output = map {$decode ? lc : uc } "@output" =~ /[a-z]{1,5}/g;
print splice @output,0,5 while @output;


sub transcribe {
    my @in1 = @{$letters{+shift}}; 
    my @in2 = @{$letters{+shift}};

    my (@out1,@out2);
    
    if      ( $in1[0] == $in2[0] ) {
        $out1[0] = $out2[0] = $in1[0];
        $out1[1] = $in1[1] + $SHIFT;
        $out2[1] = $in2[1] + $SHIFT;
    } elsif ( $in1[1] == $in2[1] ) {
        $out1[1] = $out2[1] = $in1[1];
        $out1[0] = $in1[0] + $SHIFT;
        $out2[0] = $in2[0] + $SHIFT;
    } else {
        @out1 = ($in1[0], $in2[1]);
        @out2 = ($in2[0], $in1[1]);
    }
    ($square[$out1[0]][$out1[1]],$square[$out2[0]][$out2[1]]);

}
[download]

=head2 Options

=over 4

=item B<-e>

Input should be treated as cleartext and encoded (default).

=item B<-d>

Input should be treated as ciphertext and decoded.

=item B<-i> infile

Input file (possibly useful if not specifying a keyword).
See also B<infiles>, below.

=item B<-o> outfile

Output file.  Defaults to standard output.

=back

=head2 Arguments

=over 4

=item keyword

The keyword for the cipher (in Peter Wimsey's case, this was "Royalty"
+).
If none is supplied, defaults to "playfair" (as in the example below).

=item infiles

Any number of files may be listed on the command line after the keywor
+d:
no break will be made in the output between input files.  Overrides th
+e 
B<-i> option.If no files are specified, the program reads from the
standard input.

=back

=head1 Disclaimer

B<NOTE WELL>: the Playfair cipher can be solved, for an arbitrary keyw
+ord, with 
paper and pencil.  It is not what you would call "secure".  Any ill ef
+fects 
accruing to the user as a result of using it as if it were are entirel
+y the 
user's responsibility.


=head1 The Playfair Cipher

=head2 The Square

The square is produced by entering the letters of the keyword, followe
+d by
the remaining letters of the alphabet (in standard order) into a 5x5 m
+atrix.
(I and J are considered equivalent in this cipher.)

With a keyword of "Playfair", the result is this:

   ---------------------
   | P | L | A | Y | F |
   ---------------------
   | IJ| R | B | C | D |
   ---------------------
   | E | G | H | K | M |
   ---------------------
   | N | O | Q | S | T |
   ---------------------
   | U | V | W | X | Z |
   ---------------------

B<Note>: a slightly more complicated method exists for building the sq
+uare
(I would guess it is the more authentic), based on a transposition of 

  PLAYFAIR
  BCDEGHKM
  NOQSTUVW
  XZ

(yielding a first row of C<P B N X L>).  It was not used by Dorothy Sa
+yers'
murder victim, and hence is not used in this program, though it would 
+be 
relatively simple to implement.


=head2 Encryption Rules

The Playfair cipher is a digraphic cipher: rather than simply translat
+ing each
letter of input to a unique letter in the output, we translate pairs o
+f letters.
In the case where two consecutive letters are identical, or where the 
+cleartext has
an odd number of letters, a blank of some kind must be inserted: by co
+nvention, 
this blank is X (in the case where a blank must be inserted after an X
+, we insert 
a Z, because it seems as reasonable a response as a double X in the cl
+eartext
deserves).

=over 4

=item *

In the most general case, each letter is replaced by the letter in 
its own row and in the column of the other letter in the digraph.

    LW -> AV
    RT -> DO
    TA -> QF

=item *

If the two letters of the digraph are on the same row in the chart, 
each should be replaced by the letter immediately to its right (wrappi
+ng
as necessary).

    OS -> QT
    GH -> HK
    TO -> NQ

=item *

If the two letters are in the same column, each should be replaced by 
+the 
letter immediately below it (again wrapping as necessary).

    GO -> OV
    UE -> PN

=back

=head2 Decryption Rules

Are left as an exercise to the reader. ;-)

=head1 History

The Playfair Cipher was invented by Sir Charles Wheatstone in the 
neighborhood of 1850, and popularized by his friend Lyon, First Baron
Playfair.  It saw substantial use as a field cipher in the British and
+ 
American militaries over the following century (including by the celeb
+rated
commander of PT-109), owing to its ease of use and the modest difficul
+ty
it presented to cryptanalysts (field ciphers need only stand up to att
+ack
for a matter of hours, rather than the days or weeks of higher-level c
+odes).

=head1 Author

ChemBoy (C<chemboy@perlmonk.org>).

=cut
[download]