Inspired by Re: Polyglot (crypto) which at first glance looked something like this, I implemented the famous Vigenère Cypher, once lauded as chifre indéchiffrable, in Perl.

The use of multiple rotating cipher alphabets, such as the 8-way used in Polyglot, was developed in an essay by Battista Alberti sometime during the 1460's.

Eventually in 1586, Blaise de Vigenère wove together the concepts written by Alberti, Trithemius, and Porta into a polished product, a truely revolutionary cipher.

This was the invention of the "Key", whereby knowing the algorithm is not enough, but the process (chart and pen in those days) was reused through different keys.

It was not broken until 1854 when Charles Babbage figured out that he could do n-way frequency analysis, where n is the number of chars in the key. The Brits kept that a secret until it was independantly invented by Friedrich Wilhelm Kasiski in 1863.

I suppose this was some blow to commerce, spys, and others who suddenly had their "unbreakable code" compromised. It was in the era where businessmen and generals started using secure communications via telegraph, much as we need SSL/TLS on some web pages today. It wasn't until typewriter-like machines (such as Enigma) came into being decades later that clerks could once again produce "unbreakable" encodings without undo effort or logistical problems.

—John

Here is the example from The Code Book encoded and decoded by this class: 

require 5.6.1;
use utf8;
use strict;
use warnings;
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";

[download]
Here is the complete Perl module. Note that it can be instantiated with an arbitrary alphabet; it defaults to 'a'..'z'. 
=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

[download]

In reply to Vigenère Cypher by John M. Dlugosz

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.