Merge pull request #5058 from jacoby/master

135

3 files changed, 88 insertions, 0 deletions

diff --git a/challenge-135/dave-jacoby/blog.txt b/challenge-135/dave-jacoby/blog.txt
new file mode 100644
index 0000000000..51a018feab
--- /dev/null
+++ b/challenge-135/dave-jacoby/blog.txt
@@ -0,0 +1 @@
+https://jacoby.github.io/2021/10/18/middle-digits-to-validation-the-weekly-challenge-135.html
\ No newline at end of file
diff --git a/challenge-135/dave-jacoby/perl/ch-1.pl b/challenge-135/dave-jacoby/perl/ch-1.pl
new file mode 100644
index 0000000000..10f228a1c4
--- /dev/null
+++ b/challenge-135/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,33 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use feature qw{ say state postderef signatures };
+no warnings qw{ experimental };
+
+my @examples = qw{
+    1234567
+    -123
+    1
+    10
+};
+
+for my $i (@examples) {
+    my $o = middle_3($i);
+    say <<"END";
+    Input: \$n = $i
+    Output: $o
+END
+}
+
+sub middle_3 ( $n ) {
+    $n =~ s/\D//gmx;
+    my $s = length $n;
+    return 'even number of digits' if ( $s % 2 ) == 0;
+    return 'too short'             if $s < 3;
+    while ( length $n > 3 ) {
+        substr( $n, 0,  1 ) = '';
+        substr( $n, -1, 1 ) = '';
+    }
+    return $n;
+}
diff --git a/challenge-135/dave-jacoby/perl/ch-2.pl b/challenge-135/dave-jacoby/perl/ch-2.pl
new file mode 100644
index 0000000000..c810697bf9
--- /dev/null
+++ b/challenge-135/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,54 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use feature qw{ say postderef signatures };
+no warnings qw{ experimental };
+
+my @examples = qw{
+    2936921
+    1234567
+    B0YBKL9
+    A0YBKL9
+    0263494
+};
+
+for my $i (@examples) {
+    my $o = validate_sedol($i);
+    say <<"END";
+    Input: \$sedol = '$i'
+    Output: $o
+END
+}
+
+sub validate_sedol($n) {
+    my @weight = ( 1, 3, 1, 7, 3, 9, 1 );
+    my $sebol  = substr $n, 0,  6;
+    my $check  = substr $n, -1, 1;
+
+    # they can contain letters and numbers,
+    # but not vowels. Done with two regexes
+    # because otherwise is long and ugly.
+    if ( $sebol =~ /^[0-9A-Z]{6}$/mx && $sebol !~ /[AEIOU]/mx ) {
+        my $sum = 0;
+        for my $i ( 0 .. 5 ) {
+            my $w = $weight[$i];
+            my $s = substr $n, $i, 1;
+            my $c = to10($s);    # from base36 to base10
+            $sum += ( $w * $c );
+        }
+        my $end = ( 10 - $sum % 10 ) % 10;
+        return 1 if $end eq $check;
+    }
+    return 0;
+}
+
+sub to10 ( $b36 ) {
+    my @s = ( 0 .. 9, 'A' .. 'Z' );
+    for my $i ( 0 .. 35 ) {
+        if ( $s[$i] eq $b36 ) {
+            return $i;
+        }
+    }
+    return -1;
+}