Perl Weekly Challenge 097
This is another one of those posts about the Perl Weekly Challenge where I briefly describe the solution I write for the challenge. You can see other posts in this series clicking HERE.
This week the challenge was to implement the classic Caesar cipher.
Here is the week 097 challenge:
TASK #1 › Caesar Cipher Submitted by: Mohammad S Anwar
You are given string $S containing alphabets A..Z only and a number $N.
Write a script to encrypt the given string $S using Caesar Cipher with left shift of size $N. Example
Input: $S = "THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG", $N = 3 Output: "QEB NRFZH YOLTK CLU GRJMP LSBO QEB IXWV ALD"
Plain: ABCDEFGHIJKLMNOPQRSTUVWXYZ Cipher: XYZABCDEFGHIJKLMNOPQRSTUVW
Plaintext: THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG Ciphertext: QEB NRFZH YOLTK CLU GRJMP LSBO QEB IXWV ALD
As is my habit I started by creating a .t test file:
use strict;
use warnings;
use Test2::V0 -target => 'Caesar';
can_ok( $CLASS, 'encode' );
done_testing;
This is for me an example of "[tracer bullet developmentp(https://growsmethod.com/practices/TracerBullets.html)", to a degree at least.
The idea, which I think I first saw in the Pragmatic Programmer book, is that you should try going end to end with the thinnest slice you can.
So in this case the bare minimum I am looking for is a class that has a encode method. That's my base, so this test is simply trying to load a package and checking the method exists.
At this point it fails as lib/Caesar.pm does not exist; so I create a simple file:
package Caesar;
use Moo;
1;
This also fails as there is no encode method; so I add that:
package Caesar;
use Moo;
sub encode {}
1;
And now my tests pass, as I have a module with the correct file and package names, and a correctly named method. This may seem to simple to bother as a first step, but given how terrible my typing is, I like to confirm the basics. In a "real" code base where you might be building a feature that requires multiple new classes and/or methods at varying layers I think it's really valuable to at least "wire up" the classes and methods this way before starting to add business logic. It just helps avoid the inevitable typo style errors. I think it also helps me with naming as you flex your fingers through multiple places; it becomes obvious where a naming convention is jarring. It's loads easier to make the naming changes before anything relies on it.
So... having established as frame to work from (some people call this a walking skeleton, I can start fleshing it out, so lets add a more useful test:
use strict;
use warnings;
use Test2::V0 -target => 'Caesar';
subtest '->encode()' => sub {
my $S = 'THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG';
my $N = 3;
my $expected = "QEB NRFZH YOLTK CLU GRJMP LSBO QEB IXWV ALD";
my $got = $CLASS->encode(
string => $S,
n => $N,
);
is $got, $expected, "'$S' with shift of '$N' should return '$expected'";
};
done_testing;
So we can see easily there what we are feeding in and what we expect out, and Test2::V0 makes it really easy to visualise what we are testing. The code that generates starts as simple as return 'QEB NRFZH YOLTK CLU GRJMP LSBO QEB IXWV ALD' as the first iteration. Then grows outwards, and in my case I ended up with:
sub encode {
my ( $self, %args ) = @_;
my $cipher = $self->_cipher( 'n' => $args{n}, mode => 'encode' );
my $text;
my @chars = split "", $args{string};
for my $char (@chars) {
$text .= $cipher->{ lc($char) };
}
return uc $text;
}
To be clear, this is the version after several iterations. You can see I call a "private" method $self->_cipher which was code that was originally in the method, but I moved it out when I added the ability to both encode and decode text. The code is hopefully pretty understandable, we get the cipher. We take the string we were passed and convert it into an array. Then is a simple loop through the array converting the encoded character to the decoded character. Finally returning the converted string.
You'll see I added a lc (lower case) and a uc (upper case) to format as per the examples.
The $cipher is a simple hash that has a nice encoded => decoded mapping. It's generated with this code:
sub _cipher {
my ( $self, %args ) = @_;
my @alpha = (qw/a b c d e f g h i j k l m n o p q r s t u v w x y z/);
my @cipher = @alpha;
if ( $args{mode} eq 'decode' ) {
for ( 1 .. $args{n} ) {
my $char = pop @cipher;
unshift @cipher, $char;
}
}
else {
for ( 1 .. $args{n} ) {
my $char = shift @cipher;
push @cipher, $char;
}
}
my %code;
for my $i ( 0 .. 25 ) {
$code{ $cipher[$i] } = $alpha[$i];
}
$code{' '} = ' ';
return \%code;
}
You'll notice that again this is the "final" version, not the basic code that existed in the iterations. That should be obvious from the if statement in the middle there that gives me the structure for a decode OR a encode operation. Which is a feature I added later in the process. Being in a separate method, it had the advantage that I could test it in isolation; which was helpful when I miscoded the solution to decode originally.
In a break from the norm for me; this time I actually made this work from/as a script. So here is my ch-1.pl file:
use strict;
use warnings;
use lib './lib';
use Caesar;
use Getopt::Long;
my ($string,$n,$decode);
GetOptions(
'string=s' => \$string,
'n=i' => \$n,
'd' => \$decode,
);
unless ($string && $n) {
die <<"MESSAGE";
MISSING PARAMS
You need to provide:
-s "the string to encode goes here"
-n 3
eg perl ch-1.pl -s "foo bar" -n 3
Which rotates "foo bar" by three characters, returning:
CLL YXO
By default the script will encode, add the -d param to decode.
MESSAGE
}
my $caesar = Caesar->new;
my $text;
if ($decode) {
$text = $caesar->decode(
string => $string,
n => $n,
);
} else {
$text = $caesar->encode(
string => $string,
n => $n,
);
}
print $text;
print "\n";
Now, just to protect my reputation, yes this is clunky and I am intentionally not coding defensively. I have zero parameter checking anywhere in the code. I do this for fun after all, and consciously choose to not do it "right".
OK with that caveat in place... I did start by just using @ARGV, but wanted to remind myself about how Getopt::Long feels. So using that to manage the inputs, which includes my -d switch. -d is the decode option (Do I get extra credit Mohammad?) so that you can encode and decode messages with this script. I have the module installed, so this is definitely a "Works on my machine" solution.
The last version of the module looks like this:
t/00-cipher.t l/Caesar.pm ch-1.pl X
package Caesar;
use Moo;
sub encode {
my ( $self, %args ) = @_;
my $cipher = $self->_cipher( 'n' => $args{n}, mode => 'encode' );
my $text;
my @chars = split "", $args{string};
for my $char (@chars) {
$text .= $cipher->{ lc($char) };
}
return uc $text;
}
sub decode {
my ( $self, %args ) = @_;
my $cipher = $self->_cipher( 'n' => $args{n}, mode => 'decode' );
my $text;
my @chars = split "", $args{string};
for my $char (@chars) {
$text .= $cipher->{ lc($char) };
}
return uc $text;
}
1;
sub _cipher {
my ( $self, %args ) = @_;
my @alpha = (qw/a b c d e f g h i j k l m n o p q r s t u v w x y z/);
my @cipher = @alpha;
if ( $args{mode} eq 'decode' ) {
for ( 1 .. $args{n} ) {
my $char = pop @cipher;
unshift @cipher, $char;
}
}
else {
for ( 1 .. $args{n} ) {
my $char = shift @cipher;
push @cipher, $char;
}
}
my %code;
for my $i ( 0 .. 25 ) {
$code{ $cipher[$i] } = $alpha[$i];
}
$code{' '} = ' ';
return \%code;
}
And the test file ended up looking like this:
use strict;
use warnings;
use Test2::V0 -target => 'Caesar';
can_ok( $CLASS, 'decode' );
subtest '->encode()' => sub {
my $S = 'THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG';
my $N = 3;
my $expected = "QEB NRFZH YOLTK CLU GRJMP LSBO QEB IXWV ALD";
my $got = $CLASS->encode(
string => $S,
n => $N,
);
is $got, $expected, "'$S' with shift of '$N' should return '$expected'";
};
subtest '->decode()' => sub {
my $expected = 'THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG';
my $N = 3;
my $S = "QEB NRFZH YOLTK CLU GRJMP LSBO QEB IXWV ALD";
my $got = $CLASS->decode(
string => $S,
n => $N,
);
is $got, $expected, "'$S' with shift of '$N' should return '$expected'";
};
subtest '->_cipher(mode => "encode")' => sub {
my $expected = {
' ' => ' ',
'a' => 'x',
'b' => 'y',
'c' => 'z',
'd' => 'a',
'e' => 'b',
'f' => 'c',
'g' => 'd',
'h' => 'e',
'i' => 'f',
'j' => 'g',
'k' => 'h',
'l' => 'i',
'm' => 'j',
'n' => 'k',
'o' => 'l',
'p' => 'm',
'q' => 'n',
'r' => 'o',
's' => 'p',
't' => 'q',
'u' => 'r',
'v' => 's',
'w' => 't',
'x' => 'u',
'y' => 'v',
'z' => 'w',
};
my $got = $CLASS->_cipher(
'n' => 3,
mode => 'encode'
);
is $got, $expected, 'encode mode (shift 3) cipher as expected';
$expected = {
' ' => ' ',
'a' => 'v',
'b' => 'w',
'c' => 'x',
'd' => 'y',
'e' => 'z',
'f' => 'a',
'g' => 'b',
'h' => 'c',
'i' => 'd',
'j' => 'e',
'k' => 'f',
'l' => 'g',
'm' => 'h',
'n' => 'i',
'o' => 'j',
'p' => 'k',
'q' => 'l',
'r' => 'm',
's' => 'n',
't' => 'o',
'u' => 'p',
'v' => 'q',
'w' => 'r',
'x' => 's',
'y' => 't',
'z' => 'u',
};
$got = $CLASS->_cipher(
'n' => 5,
mode => 'encode'
);
is $got, $expected, 'encode mode (shift 5) cipher as expected';
};
subtest '->_cipher(mode => "decode")' => sub {
my $expected = {
' ' => ' ',
'a' => 'd',
'b' => 'e',
'c' => 'f',
'd' => 'g',
'e' => 'h',
'f' => 'i',
'g' => 'j',
'h' => 'k',
'i' => 'l',
'j' => 'm',
'k' => 'n',
'l' => 'o',
'm' => 'p',
'n' => 'q',
'o' => 'r',
'p' => 's',
'q' => 't',
'r' => 'u',
's' => 'v',
't' => 'w',
'u' => 'x',
'v' => 'y',
'w' => 'z',
'x' => 'a',
'y' => 'b',
'z' => 'c',
};
my $got = $CLASS->_cipher(
'n' => 3,
mode => 'decode'
);
is $got, $expected, 'decode mode (shift 3) cipher as expected';
$expected = {
' ' => ' ',
'a' => 'f',
'b' => 'g',
'c' => 'h',
'd' => 'i',
'e' => 'j',
'f' => 'k',
'g' => 'l',
'h' => 'm',
'i' => 'n',
'j' => 'o',
'k' => 'p',
'l' => 'q',
'm' => 'r',
'n' => 's',
'o' => 't',
'p' => 'u',
'q' => 'v',
'r' => 'w',
's' => 'x',
't' => 'y',
'u' => 'z',
'v' => 'a',
'w' => 'b',
'x' => 'c',
'y' => 'd',
'z' => 'e',
};
$got = $CLASS->_cipher(
'n' => 5,
mode => 'decode'
);
is $got, $expected, 'decode mode (shift 5) cipher as expected';
};
done_testing;
I hope if you are reading this that you found it interesting. This is not a particularly sophisticated solution I know. I am sure some of my peers can do this as a one liner. That is not my style. I like simple. This has also only had limited attention applied and zero defensive programming or testing for edge cases. I did refactor a little as I went along, but not with much focus or time investment.
I'd be interested in your approaches and your comments, drop me a message to lance@perl.kiwi or tweet me @perlkiwi.