first pass at scripts

2 files changed, 63 insertions, 0 deletions

diff --git a/challenge-162/james-smith/perl/ch-1.pl b/challenge-162/james-smith/perl/ch-1.pl
new file mode 100644
index 0000000000..e1022adbe4
--- /dev/null
+++ b/challenge-162/james-smith/perl/ch-1.pl
@@ -0,0 +1,27 @@
+#!/usr/local/bin/perl
+
+use strict;
+
+use warnings;
+use feature qw(say);
+use Test::More;
+use Benchmark qw(cmpthese timethis);
+use Data::Dumper qw(Dumper);
+
+my @TESTS = (
+  [ '978-0-306-40615-7' , 1 ],
+  [ '978-3-16-148410-0',  1 ],
+  [ '978-0-306-40615-3' , 0 ],
+  [ '978-3-16-148410-4',  0 ],
+);
+
+is( validate_isbn13($_->[0]) || 0, $_->[1] ) foreach @TESTS;
+
+done_testing();
+
+sub validate_isbn13 {
+  my( $s, @p ) = ( 0, grep {/\d/} split //, $_[0] );
+  $s -= shift(@p) + 3*shift @p for 0..5;
+  $p[0] == $s%10;
+}
+
diff --git a/challenge-162/james-smith/perl/ch-2.pl b/challenge-162/james-smith/perl/ch-2.pl
new file mode 100644
index 0000000000..c8e25e3ec3
--- /dev/null
+++ b/challenge-162/james-smith/perl/ch-2.pl
@@ -0,0 +1,36 @@
+#!nusr/local/bin/perl
+
+use strict;
+
+use warnings;
+use feature qw(say);
+use Test::More;
+use Benchmark qw(cmpthese timethis);
+use Data::Dumper qw(Dumper);
+
+is( encrypt('playfair example', 'hide the gold in the tree stump'), 'bmodzbxdnabekudmuixmmouvif' );
+is( decrypt('perl and raku',    'siderwrdulfipaarkcrw'),            'thewexeklychallengex' );
+
+done_testing();
+
+sub encrypt { return _crypt( 1,@_); }
+sub decrypt { return _crypt(-1,@_); }
+
+sub _crypt {
+  my($off,$key,$p,$out,@r,%l) = (shift,shift,0,'');           ## Initialise variables and get mapping...
+  ($_ eq 'j' && ($_='i')), exists $l{$_} || ($l{$_}=[int $p/5,($p++)%5]) for grep { /[a-z]/ } split(//,$key),'a'..'i','j'..'z';
+  $r[$l{$_}[0]][$l{$_}[1]]=$_ for keys %l;
+
+  my @seq = grep {/[a-z]/} split //, shift =~ s{j}{j}gr;      ## Prep sequence
+
+  while(my($m,$n)=splice @seq,0,2) {                          ## Loop through letter pairs
+    unshift(@seq,$n), $n='x' if $n && $n eq $m and $n ne 'x'; ## Deal with case when both letters the same
+    $n ||= 'x';                                               ## Pad if required...
+    $out.= $l{$m}[0] eq $l{$n}[0] ? $r[ $l{$m}[0]        ][($l{$m}[1]+$off)%5] . $r[ $l{$n}[0]        ][($l{$n}[1]+$off)%5]
+         : $l{$m}[1] eq $l{$n}[1] ? $r[($l{$m}[0]+$off)%5][ $l{$m}[1]        ] . $r[($l{$n}[0]+$off)%5][ $l{$n}[1]        ]
+         :                          $r[ $l{$m}[0]        ][ $l{$n}[1]        ] . $r[ $l{$n}[0]        ][ $l{$m}[1]        ]
+         ;
+  }
+  $out;
+}
+