My Fellow Monks,
I was reading a book the other day in which the characters use "Lewis Carroll's Code".
This is, apparently, a cypher based on a keyphrase using the following scheme.
The keyphrase is written vertically down your paper:
J
U
S
T
A
N
O
T
H
E
R
and so on.
Then the alphabet is written across, starting with each letter:
ABCDEFGHIJKLMNOPQRSTUVWXYZ
--------------------------
JKLMNOPQRSTUVWXYZABCDEFGHI
UVWXYZABCDEFGHIJKLMNOPQRST (etc.)
To encode, you find your first letter in the line beginning with J, and look up to the regular-alphabet line. If your letter is "P", it becomes "G". Then you find the next letter on the line beginning with U -- "E" becomes "T".
Below is my implementation of this in Perl.
I would really like your comments.
This is the first time I've tried to make a proper piece of Perl which has error messages and follows strict rules and could conceivably be used by someone else.
I know that as an encryption scheme goes it's pretty much useless, but as an exercise in writing Good Perl, how have I done?
TIA
use strict;
use warnings;
print "Encode (E) or Decode (D)?\n";
my $choice = <STDIN>;
if ( $choice =~ /e/i ) {
print "What's the key-phrase:\n";
my $key_phrase = <STDIN>;
chomp($key_phrase);
print "What's the text to encode:\n";
my $clear_text = <STDIN>;
chomp($clear_text);
print
" '$clear_text' \nencoded using \n '$key_phrase'\nresult:\n "
+;
print &amp;amp;amp;encode_lcc( $clear_text, $key_phrase ), "\n
+";
}
elsif ( $choice =~ /d/i ) {
print "What's the key-phrase:\n";
my $key_phrase = <STDIN>;
chomp($key_phrase);
print "What's the text to decode:\n";
my $cypher_text = <STDIN>;
chomp($cypher_text);
print
" '$cypher_text' \ndecoded using \n '$key_phrase'\nresult:\n
+";
print &amp;amp;amp;decode_lcc( $cypher_text, $key_phrase ), "\
+n";
}
else {
print "Entry must be D or E\n";
exit;
}
sub encode_lcc {
my $alpha = 'abcdefghijklmnopqrstuvwxyz';
my ( $clear_text, $key_phrase ) = @_;
unless ( $clear_text &amp;amp;amp;&amp;amp;amp; $key_phras
+e ) {
die
"Wrong number of arguments. Syntax: encode_lcc(CLEARTEXT,KEYPHRASE)";
}
$key_phrase =~ tr/A-Z/a-z/;
my @key_array = $key_phrase =~ /[a-z]/gi;
my $i = 0;
my $output = '';
foreach ( split ( '', $clear_text ) ) {
if (/[^a-z]/i) {
$output .= $_;
}
else {
$output .= substr(
$alpha,
(
index( $alpha, lc($_) ) -
index( $alpha, $key_array[$i] )
),
1
)
; # encoded output is the letter in the alphabet found a
+t:
# (letter's normal position) minus (letter-position of
# the current keyphrase-letter)
$i = ( ( $i + 1 ) % @key_array );
}
}
return $output;
}
sub decode_lcc {
my $alpha = 'abcdefghijklmnopqrstuvwxyz';
my ( $cypher_text, $key_phrase ) = @_;
unless ( $cypher_text &amp;amp;amp;&amp;amp;amp; $key_phra
+se ) {
die
"Wrong number of arguments. Syntax: encode_lcc(CYPHERTEXT,KEYPHRASE)";
}
$key_phrase =~ tr/A-Z/a-z/;
my @key_array = $key_phrase =~ /[a-z]/gi;
my $i = 0;
my $output = '';
foreach ( split ( '', $cypher_text ) ) {
if (/[^a-z]/i) {
$output .= $_;
}
else {
$output .= substr(
$alpha,
(
(
index( $alpha, lc($_) ) +
index( $alpha, $key_array[$i] )
) % 26
),
1
)
; # decoded output is the letter in the alphabet found a
+t:
# (letter's normal position) plus (letter-position of
# the current keyphrase-letter), mod 26 to stop us
# going past the end of the alphabet.
$i = ( ( $i + 1 ) % @key_array );
}
}
return $output;
}
Update: (myocom) Added the rest of Cody_Pendant's description per his request.
--
($_='jjjuuusssttt annootthheer
pppeeerrrlll haaaccckkeer')=~y/a-z//s;print;