package LewisCarrollCode;
use CGI::Carp qw(fatalsToBrowser);

use strict;
use Exporter;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);

$VERSION     = 0.10;
@ISA         = qw(Exporter);
@EXPORT      = ();
@EXPORT_OK   = qw(&lcc_encrypt &lcc_decrypt);
%EXPORT_TAGS = (
  Both    => [qw(&lcc_encrypt &lcc_decrypt)],
  Encrypt => [qw(&lcc_encrypt)],
  Decrypt => [qw(&lcc_decrypt)]
);

my $upper = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
my $lower = 'abcdefghijklmnopqrstuvwxyz';

# I didn't do join('' (a..z)) because (in 5.00503)
# it caused errors for some reason.

sub lcc_encrypt {
  my ($key_phrase, @clear_text) = @_;
  unless (@clear_text && $key_phrase) {
    die
      "Too few arguments. Syntax: lcc_encrypt(KEYPHRASE,CLEARTEXT)";
  }
  my @key_array = $key_phrase =~ /[a-z]/gi;
  if (scalar(@key_array) == 0){
    die
      "Keyphrase contains no alphabetic characters.";
  }
  my $i         = 0;
  my $output    = '';
  foreach (@clear_text) {
    foreach (split ('', $_)) {
      if (/[a-z]/) {
        $output .= substr(
          $lower,
          (
            index($lower,   $_) -
              index($lower, lc($key_array[$i]))
          ),
          1
          )
          ; # encoded output is the letter in the alphabet found at:
            # (letter's normal position) minus (letter-position of
            # the current keyphrase-letter). As substr() is cool with
            # negative numbers we don't have to worry about using
            # abs() or mod to fix the number.
        $i = (($i + 1) % @key_array);
      }    # end of if lowercase
      elsif (/[A-Z]/) {
        $output .= substr(
          $upper,
          (
            index($upper,   $_) -
              index($upper, uc($key_array[$i]))
          ),
          1
        );
        $i = (($i + 1) % @key_array);
      } else {
        $output .= $_;
      }
    }
  }
  return $output;
}

sub lcc_decrypt {
  my ($key_phrase, @cypher_text) = @_;
  unless (@cypher_text && $key_phrase) {
    die
      "Too few arguments. Syntax: lcc_decrypt(KEYPHRASE,CYPHERTEXT)";
  }
  $key_phrase =~ tr/a-z/A-Z/;
  my @key_array = $key_phrase =~ /[a-z]/gi;
  if (scalar(@key_array) == 0){
    die
      "Keyphrase contains no alphabetic characters.";
  }
  my $i         = 0;
  my $output    = '';
  foreach (@cypher_text) {
    foreach (split ('', $_)) {
      if (/[a-z]/) {
        $output .= substr(
          $lower,
          (
            (
              index($lower,   $_) +
                index($lower, lc($key_array[$i]))
            ) % 26
          ),
          1
          )
          ; # decoded output is the letter in the alphabet found at:
            # (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);
      }    # end of if lowercase
      elsif (/[A-Z]/) {
        $output .= substr(
          $upper,
          (
            (
              index($upper,   $_) +
                index($upper, uc($key_array[$i]))
            ) % 26
          ),
          1
        );
        $i = (($i + 1) % @key_array);
      }    # end of if uppercase
      else {    # neither kind of letter
        $output .= $_;
      }
    }
  }
  return $output;
}

1;

=pod

=head1 LewisCarrollCode

This is an encryption module. Not a very secure one. 

I wrote it purely as an exercise in creating a Perl Module.

It uses a text keyphrase as the encryption/decryption key for a string
+ or an array.

The way manual encryption/decription with a pen or pencil would occur 
+is as follows.

You'd write the alphabet across your page, and your keyphrase 
vertically below it.

In this case the keyphrase is "PERL":

  ABCDEFGHIJKLMNOPQRSTUVWXYZ
  --------------------------
  P
  E
  R
  L

Then you complete the alphabet on each line, starting with the letter 
from your keyphrase.

Start again with A when you reach Z:

  ABCDEFGHIJKLMNOPQRSTUVWXYZ
  --------------------------
  PQRSTUVWXYZABCDEFGHIJKLMNO
  EFGHIJKLMNOPQRSTUVWXYZABCD
  RSTUVWXYZABCDEFGHIJKLMNOPQ
  LMNOPQRSTUVWXYZABCDEFGHIJK

Then you encrypt by cycling through the lines, each time 
converting your letter from the one in the lower lines to the one in 
the top line.

So, for example, B<"JAPH"> encoded using the keyphrase B<"PERL"> would
+ be B<"UWYW">. 

If you have more letters to encrypt, you would just go back to the top
+ and start again with the "P" line.

Decryption, of course, simply goes the other way.

This module implements this encryption scheme in Perl.

As you can see, it's not much different to a substitution scheme like 
ROT-13, only it's not always 13. In fact, if you used as your 
keyphrase the single letter "n" LewisCarrollCode would B<be> ROT-13.

I suppose the longer the keyphrase, the harder it will be to 
decypher, though I don't really know enough about cryptography to say.

=head1 How To Use This Module

  use LewisCarrollCode qw(:Encrypt);

or

  use LewisCarrollCode qw(:Decrypt);

or

  use LewisCarrollCode qw(:Both);


=head1 Functions

  lcc_encrypt('perl','japh');

will encrypt 'japh' as 'UWYW'.

  lcc_decrypt('perl','uwyw');

will decrypt'uwyw' as 'JAPH'

=head1 Notes

The second argument for the functions lcc_encrypt() and lcc_decrypt() 
can be an array or a scalar, but the first must be a scalar.

Keyphrases can contain non-alphabetical characters, to make them 
easier to remember if needed, but they get stripped. B<"Tom's a-cold">
+ can be used as the phrase, but B<TOMSACOLD> will be the 
actual keyphrase used.

This module was suggested by the novel B<Red Shift> by Alan Garner, in
which I first learned about this "code".

I realise that the term "code" is less correct than the term "encrypti
+on"
but that's the way it's referred to in the book.

=cut
[download]

“Every bit of code is either naturally related to the problem at hand, or else it's an accidental side effect of the fact that you happened to solve the problem using a digital computer.”
M-J D