diff options
| -rwxr-xr-x | challenge-025/joelle-maslak/perl5/ch-2.pl | 123 | ||||
| -rwxr-xr-x | challenge-025/joelle-maslak/perl6/ch-2.p6 | 123 |
2 files changed, 246 insertions, 0 deletions
diff --git a/challenge-025/joelle-maslak/perl5/ch-2.pl b/challenge-025/joelle-maslak/perl5/ch-2.pl new file mode 100755 index 0000000000..6b6b78bdf7 --- /dev/null +++ b/challenge-025/joelle-maslak/perl5/ch-2.pl @@ -0,0 +1,123 @@ +#!/usr/bin/env perl +use v5.26; +use strict; +use warnings; + +# Turn on method signatures +use feature 'signatures'; +no warnings 'experimental::signatures'; + +use autodie; +use Getopt::Long; + +MAIN: { + my $left = 'HXUCZVAMDSLKPEFJRIGTWOBNYQ'; + my $right = 'PTLNBQDEOYSFAVZKGJRIHWXUMC'; + my $zenith = 1; + my $nadir = 14; + GetOptions( + "left=s" => \$left, + "right=s" => \$right, + "zenity=i" => \$zenith, + "nadir=i" => \$nadir, + ); + if ( @ARGV != 2 ) { + die("Invalid parameters, provide command (encrypt|decrypt) and text at a minimum"); + } + + my $cmd = shift(@ARGV); + my $text = shift(@ARGV); + + if ($cmd ne 'encrypt' and $cmd ne 'decrypt') { + die "Invaid command, must be encrypt or decrypt"; + } + + say endecrypt($cmd, $text, $left, $right, $zenith, $nadir); +} + +sub endecrypt( + $mode, + $text, + $left, + $right, + $zenith, + $nadir, +) { + die "Wheels not same size" if length($left) != length($right); + my $size = length($left); + + # Normalize zenith and nadir to start at zero + $zenith--; + $nadir--; + + # Get the input text + my (@input) = split //, $text; + my @output; + + for my $char (@input) { + my (@left) = split //, $left; + my (@right) = split //, $right; + + my $pos = $mode eq 'encrypt' ? index($right, $char) : index($left, $char); + die "Letter ($char) not on wheel" unless $pos >= 0; + my $pletter = $right[$pos]; + my $eletter = $left[$pos]; + + push @output, $mode eq 'encrypt' ? $eletter : $pletter; + + # Permeate left wheel + do { + # We need to rotate the left alphabet so ciphertext is the + # cyphertext letter at the zenith + while ($left[$zenith] ne $eletter) { + push @left, shift @left; + } + + # We note the letter in the zenith + 1 position + my $tmp = $left[($zenith + 1) % $size]; + + # We move all the letters from the zenith + 2 to nadir left + my $pos = ($zenith + 2) % $size; + while ($pos != ($nadir + 1) % $size) { + $left[($pos - 1) % $size] = $left[$pos]; + $pos = ($pos + 1) % $size; + } + + # We put the saved letter in the nadir position + $left[$nadir] = $tmp; + + # Store the alphabet + $left = join '', @left; + }; + + # Permeate right wheel + do { + # We put the plaintext letter at the zenith + while ($right[$zenith] ne $pletter) { + push @right, shift @right; + } + + # Move the wheel one more position left + push @right, shift @right; + + # We note the letter in the zenith + 2 position + my $tmp = $right[($zenith + 2) % $size]; + + # We move all the letters from the zenith + 3 to nadir left + my $pos = ($zenith + 3) % $size; + while ($pos != ($nadir + 1) % $size) { + $right[($pos - 1) % $size] = $right[$pos]; + $pos = ($pos + 1) % $size; + } + + # We put the saved letter in the nadir position + $right[$nadir] = $tmp; + + # Store the alphabet + $right = join '', @right; + }; + } + + return join("", @output); +} + diff --git a/challenge-025/joelle-maslak/perl6/ch-2.p6 b/challenge-025/joelle-maslak/perl6/ch-2.p6 new file mode 100755 index 0000000000..da5b2aa5a4 --- /dev/null +++ b/challenge-025/joelle-maslak/perl6/ch-2.p6 @@ -0,0 +1,123 @@ +#!/usr/bin/env perl6 +use v6; + +# +# Copyright © 2019 Joelle Maslak +# All Rights Reserved - See License +# + +my Str:D $LDEFAULT = 'HXUCZVAMDSLKPEFJRIGTWOBNYQ'; +my Str:D $RDEFAULT = 'PTLNBQDEOYSFAVZKGJRIHWXUMC'; +my UInt:D $ZDEFAULT = 1; # Start counting at 1 +my UInt:D $NDEFAULT = 14; # Start counting at 1 + +multi sub MAIN( + 'encrypt', + Str:D $text, + Str:D :$left = $LDEFAULT, + Str:D :$right = $RDEFAULT, + UInt:D :$zenith = $ZDEFAULT, + UInt:D :$nadir = $NDEFAULT, +) { + say endecrypt('encrypt', $text, $left, $right, $zenith, $nadir); +} + +multi sub MAIN( + 'decrypt', + Str:D $text, + Str:D :$left = $LDEFAULT, + Str:D :$right = $RDEFAULT, + UInt:D :$zenith = $ZDEFAULT, + UInt:D :$nadir = $NDEFAULT, +) { + say endecrypt('decrypt', $text, $left, $right, $zenith, $nadir); +} + +sub endecrypt( + Str:D $mode, + Str:D $text, + Str:D $left is copy, + Str:D $right is copy, + Int:D $zenith is copy, + Int:D $nadir is copy, +) { + die "Wheels not same size" if $left.chars ≠ $right.chars; + my $size = $left.chars; + + # Normalize zenith and nadir to start at zero. + $zenith--; + $nadir--; + + # Get the input text + my @input = $text.comb; + my @output; + + for @input -> $char { + my @left = $left.comb; + my @right = $right.comb; + + my $pos = $mode eq 'encrypt' ?? $right.index($char) !! $left.index($char); + die "Letter ($char) not on wheels" unless $pos.defined; + my $pletter = @right[$pos]; + my $eletter = @left[$pos]; + + @output.push: $mode eq 'encrypt' ?? $eletter !! $pletter; + + # Permeate left wheel + { + # We need to rotate the left alphabet so ciphertext is the + # ciphertext letter at the zenith. + while @left[$zenith] ne $eletter { + @left.append: @left.shift; + } + + # We note the letter in the zenith + 1 position + my $tmp = @left[($zenith + 1) % $size]; + + # We move all the letters from the zenith + 2 to nadir left + my $pos = ($zenith + 2) % $size; + while $pos ≠ ($nadir + 1) % $size { + @left[($pos - 1) % $size] = @left[$pos]; + $pos = ($pos + 1) % $size; + } + + # We put the saved letter in the nadir position + @left[$nadir] = $tmp; + + # Store the alphabet + $left = @left.join; + } + + # Permeate right wheel + { + # We put the plaintext letter at the zenith + while @right[$zenith] ne $pletter { + @right.append: @right.shift; + } + + # Move the wheel one more position left + @right.append: @right.shift; + + # We note the letter in the zenith + 2 position + my $tmp = @right[($zenith + 2) % $size]; + + # We move all the letters from the zenith + 3 to nadir left + my $pos = ($zenith + 3) % $size; + while $pos ≠ ($nadir + 1) % $size { + @right[($pos - 1) % $size] = @right[$pos]; + $pos = ($pos + 1) % $size; + } + + # We put the saved letter in the nadir position + @right[$nadir] = $tmp; + + # Store the alphabet + $right = @right.join; + } + } + + return @output.join; +} + + + |