Perl solutions for week 135

3 files changed, 70 insertions, 34 deletions

diff --git a/challenge-135/abigail/README.md b/challenge-135/abigail/README.md
index 701b285f17..aa835b7f1e 100644
--- a/challenge-135/abigail/README.md
+++ b/challenge-135/abigail/README.md
@@ -2,42 +2,8 @@
 
 ## Part 1
 
-* [AWK](awk/ch-1.awk)
-* [Bash](bash/ch-1.sh)
-* [Basic](basic/ch-1.bas)
-* [bc](bc/ch-1.bc)
-* [Befunge-93](befunge-93/ch-1.bf93)
-* [C](c/ch-1.c)
-* [csh](csh/ch-1.csh)
-* [Erlang](erlang/ch-1.erl)
-* [Go](go/ch-1.go)
-* [Java](java/ch-1.java)
-* [Lua](lua/ch-1.lua)
-* [m4](m4/ch-1.m4)
-* [Node.js](node/ch-1.js)
-* [Pascal](pascal/ch-1.p)
 * [Perl](perl/ch-1.pl)
-* [PHP](php/ch-1.php)
-* [Python](python/ch-1.py)
-* [R](r/ch-1.r)
-* [Ruby](ruby/ch-1.rb)
-* [Scheme](scheme/ch-1.scm)
-* [Tcl](tcl/ch-1.tcl)
 
 ## Part 2
 
-* [AWK](awk/ch-2.awk)
-* [Bash](bash/ch-2.sh)
-* [bc](bc/ch-2.bc)
-* [C](c/ch-2.c)
-* [Go](go/ch-2.go)
-* [Java](java/ch-2.java)
-* [Lua](lua/ch-2.lua)
-* [Node.js](node/ch-2.js)
-* [Pascal](pascal/ch-2.p)
 * [Perl](perl/ch-2.pl)
-* [Python](python/ch-2.py)
-* [R](r/ch-2.r)
-* [Ruby](ruby/ch-2.rb)
-* [Scheme](scheme/ch-2.scm)
-* [Tcl](tcl/ch-2.tcl)
diff --git a/challenge-135/abigail/perl/ch-1.pl b/challenge-135/abigail/perl/ch-1.pl
new file mode 100644
index 0000000000..a74d8655a5
--- /dev/null
+++ b/challenge-135/abigail/perl/ch-1.pl
@@ -0,0 +1,28 @@
+#!/opt/perl/bin/perl
+
+use 5.032;
+
+use strict;
+use warnings;
+no  warnings 'syntax';
+
+use experimental 'signatures';
+use experimental 'lexical_subs';
+
+#
+# See ../README.md
+#
+
+#
+# Run as: perl ch-1.pl < input-file
+#
+
+while (<>) {
+    s/^[-+]\s*//g;  # We don't care about signs.
+    say /^([0-9]*)([0-9]{3})([0-9]*)$
+        (??{length ($1) == length ($3) ? "" : "(*FAIL)"})/x
+                      ? $2
+      : length () % 2 ? "even number of digits"
+      : length () < 4 ? "too short"
+      :                 "not an integer";
+}
diff --git a/challenge-135/abigail/perl/ch-2.pl b/challenge-135/abigail/perl/ch-2.pl
new file mode 100644
index 0000000000..8fda269604
--- /dev/null
+++ b/challenge-135/abigail/perl/ch-2.pl
@@ -0,0 +1,42 @@
+#!/opt/perl/bin/perl
+
+use 5.032;
+
+use strict;
+use warnings;
+no  warnings 'syntax';
+
+use experimental 'signatures';
+use experimental 'lexical_subs';
+use experimental 'regex_sets';
+
+#
+# See ../README.md
+#
+
+#
+# Run as: perl ch-2.pl < input-file
+#
+
+#
+# Map characters to their value.
+#
+my %c = do {my $c = 0; map {$_ => $c ++} 0 .. 9, 'A' .. 'Z'};
+
+#
+# Perform the following checks:
+#   - All characters are either digits, or capital letters, excluding vowels
+#         + ASCII digits and letters
+#         + Y is not a vowel
+#   - We have exactly 7 of them.
+#   - We have the correct check digit
+#
+# ((?[[0-9A-Z]-[AEIOU]])) matches any digit or upper case ASCII character,
+#                         except vowels; this is capture group 1.
+#     ((?1)):             use the same subpattern as capture group 1,
+#                         and capture it.
+# @{["((?1))" x 6]}:      repeat the above 6 times.
+#
+say /^((?[[0-9A-Z]-[AEIOU]]))@{["((?1))" x 6]}/x &&
+($c {$1} + 3 * $c {$2} + $c {$3} + 7 * $c {$4} + 3 * $c {$5} + 9 * $c {$6} +
+ $c {$7}) % 10 == 0 || 0 while <>;