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.)
[download]

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;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;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;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;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;
}
[download]

Update: (myocom) Added the rest of Cody_Pendant's description per his request.

--

($_='jjjuuusssttt annootthheer
     pppeeerrrlll haaaccckkeer')=~y/a-z//s;print;
[download]