#!/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]]);

}