=head1 NAME

Vigenere Cypher Module
 
=head1 SYNOPSIS

	use Vigenere;
	
	my $v= new Vigenere;
	my $key= "white";
	
	print join ("\n", $v->print_square());
	
	$v->set_key ($key);
	my $s1= "divert troops to east ridge";
	my $output= $v->encode ($s1);
	print "plaintext : $s1\nciphertext: $output\n";
	
	$v->set_key ($key);
	my $decode= $v->decode ($output);
	print "decoded   : $decode\n";

=head1 DESCRIPTION

This implements the Vigenere cypher, as described in chapter 2 of 
"The Code Book" by Simon Singh.

=head1 AUTHOR

John M. Dlugosz, john@dlugosz.com, http://www.dlugosz.com

=cut

use utf8;
package Vigenere;
use strict;
use warnings;

sub new
 {
 my ($class, $alphabet)= @_;
 $alphabet ||= join ('', 'a'..'z');
 my %table= _make_table ($alphabet);
 my %index= _make_index ($alphabet);
 my $self= bless {
    alphabet => $alphabet,
    table => \%table,
    index => \%index
    }, $class;
 }

sub set_key
 {
 my $self= shift;
 $self->{key}= shift;
 }
 
sub _make_table ($)
 {
 my @alphabet= split (//, shift);
 my %table;
 foreach (1.. scalar @alphabet) {
    my $L= shift @alphabet;
    push @alphabet, $L;
    $table{$alphabet[0]}= [ @alphabet ];
    }
 return %table;
 }

sub _make_index ($)
 {
 my @alphabet= split (//, shift);
 my %index;
 my $ord;
 foreach my $L (@alphabet) {
    $index{$L}= $ord++;
    }
 return %index;
 }

sub print_square
 {
 my $self= shift;
 my @results;
 push @results, "    $self->{alphabet}";
 foreach my $L (split(//,$self->{alphabet})) {
    my @row= @{$self->{table}{$L}};
    push @results, "$L - " . join ('', @row);
    }
 return @results;
 }

sub encode
 {
 my $self= shift;
 my $plaintext= shift;
 my $cyphertext;
 my $O;
 foreach my $C (split(//,$plaintext)) {
    # TODO: massage case, other transformations of input.
    my $N= $self->{index}{$C};
    if (defined $N) {
       my $K= $self->_nextkeychar();
       $O= $self->{table}{$K}[$N];
       }
    else {
       $O= $C;  # not in alphabet, pass through unchanged.
       }
    $cyphertext .= $O;
    }
 return $cyphertext;
 }

sub decode
 {
 my $self= shift;
 my $cyphertext= shift;
 my $plaintext;
 my $O;
 foreach my $C (split(//,$cyphertext)) {
    if ($self->{alphabet} =~ /\Q$C\E/) {
       my $K= $self->_nextkeychar();
       my $row= $self->{table}{$K};
       # OK, which position in this row matches $C ?
       my $N= _find_ord ($C, $row);
       $O= substr ($self->{alphabet}, $N, 1);
       }
    else {
       $O= $C;  # not in alphabet, pass through unchanged.
       }
    $plaintext .= $O;
    }
 return $plaintext;
 }

sub _find_ord ($$)
 {
 my ($C, $list)= @_;
 my $count= 0;
 foreach my $x (@$list) {
    return $count  if $x eq $C;
    ++$count;
    }
 }
 
sub _nextkeychar
 {
 my $self= shift;
 $self->{key} =~ s/^(.)(.*)$/$2$1/;
 return $1;
 }
 
1;  # loaded OK