2 files changed, 93 insertions, 0 deletions
diff --git a/challenge-015/roger-bell-west/perl5/ch1.pl b/challenge-015/roger-bell-west/perl5/ch1.pl
new file mode 100755
index 0000000000..0bae3b6389
--- /dev/null
+++ b/challenge-015/roger-bell-west/perl5/ch1.pl
@@ -0,0 +1,39 @@
+#! /usr/bin/perl
+
+use strict;
+use warnings;
+
+# Arbitrary cap
+my $cap=110;
+
+my $limit=10;
+
+# Sieve of Eratosthenes to give us a prime list
+my %n=map {$_ => 1} (2..$cap);
+foreach my $f (2..int(sqrt($cap))) {
+  map {($f<$_ && $_%$f == 0)?delete $n{$_}:0} keys %n;
+}
+my @p=sort {$a <=> $b} (keys %n);
+
+# Double difference finds the ones closer to prime above than to prime below
+my @d1=map {$p[$_+1]-$p[$_]} (0..$#p-1);
+my @d2=map {$d1[$_+1]-$d1[$_]} (0..$#d1-1);
+
+my @res;
+foreach my $k (0..$#d2) {
+  my $i=1;
+  if ($d2[$k]<0) {
+    $i=0;
+  }
+  push @{$res[$i]},$p[$k+1];
+}
+
+my @l=qw(Strong Weak);
+if (scalar @{$res[0]} >= $limit && scalar @{$res[1]} >= $limit) {
+  foreach my $m (0,1) {
+    splice @{$res[$m]},$limit;
+    print $l[$m],': ',join(', ',@{$res[$m]}),"\n";
+  }
+} else {
+  warn "Re-run with a higher cap value\n";
+}
diff --git a/challenge-015/roger-bell-west/perl5/ch2.pl b/challenge-015/roger-bell-west/perl5/ch2.pl
new file mode 100755
index 0000000000..59cad40c96
--- /dev/null
+++ b/challenge-015/roger-bell-west/perl5/ch2.pl
@@ -0,0 +1,54 @@
+#! /usr/bin/perl
+
+use strict;
+use warnings;
+
+use Getopt::Std;
+
+my %o;
+
+getopts('dk:h',\%o);
+
+# Ensure we have a key
+unless ($o{k}) {
+  $o{h}=1;
+}
+if ($o{h}) {
+  print STDERR <<EOF;
+Usage: $0 -k KEY (-d)
+Use -d to decrypt.
+Encryption/decryption is from stdin to stdout.
+EOF
+  exit 0;
+}
+
+my @alphabet=('A'..'Z');
+my %tonumber=map {$alphabet[$_] => $_} (0..$#alphabet);
+
+$o{k}=strip($o{k});
+my %ak=map {$_=>1} @alphabet;
+my @k;
+foreach my $kl (split '',$o{k}) {
+  if (exists $ak{$kl}) {
+    push @k,($o{d}?-1:1)*$tonumber{$kl};
+    delete $ak{$kl}
+  }
+}
+my $keylen=scalar @k;
+
+while (<>) {
+  chomp;
+  my @pt=map {$tonumber{$_}} split '',strip($_);
+  my @ct;
+  foreach my $n (0..$#pt) {
+    push @ct,$alphabet[($pt[$n]+$k[$n%$keylen])%26];
+  }
+  print join('',@ct),"\n";
+}
+
+sub strip {
+  my $r=shift @_;
+  $r=uc($r);
+  $r =~ s/[^A-Z]//g;
+  return $r;
+}