2 files changed, 107 insertions, 0 deletions
diff --git a/challenge-190/perlboy1967/perl/ch-1.pl b/challenge-190/perlboy1967/perl/ch-1.pl
new file mode 100755
index 0000000000..4ad4b816f0
--- /dev/null
+++ b/challenge-190/perlboy1967/perl/ch-1.pl
@@ -0,0 +1,38 @@
+#!/bin/perl
+
+=pod
+
+The Weekly Challenge - 190
+ - https://theweeklychallenge.org/blog/perl-weekly-challenge-190/#TASK1
+
+Author: Niels 'PerlBoy' van Dijke
+
+Task 1: Capital Detection
+Submitted by: Mohammad S Anwar
+
+You are given a string with alphabetic characters only: A..Z and a..z.
+
+Write a script to find out if the usage of Capital is appropriate if it satisfies
+at least one of the following rules:
+
+1) Only first letter is capital and all others are small.
+2) Every letter is small.
+3) Every letter is capital.
+
+=cut
+
+use v5.16;
+use warnings;
+
+use Test::More;
+
+sub captitalDetection ($) {
+  return ($_[0] =~ m#^([A-Z][a-z]+|[a-z]+|[A-Z]+)$# ? 1 : 0);
+}
+
+is(captitalDetection('Perl'),1);
+is(captitalDetection('TPF'),1);
+is(captitalDetection('PyThon'),0);
+is(captitalDetection('raku'),1);
+
+done_testing;
diff --git a/challenge-190/perlboy1967/perl/ch-2.pl b/challenge-190/perlboy1967/perl/ch-2.pl
new file mode 100755
index 0000000000..7e9a4fc2c1
--- /dev/null
+++ b/challenge-190/perlboy1967/perl/ch-2.pl
@@ -0,0 +1,69 @@
+#!/bin/perl
+
+=pod
+
+The Weekly Challenge - 190
+ - https://theweeklychallenge.org/blog/perl-weekly-challenge-190/#TASK2
+
+Author: Niels 'PerlBoy' van Dijke
+
+Task 2: Decoded List
+Submitted by: Mohammad S Anwar
+
+You are given an encoded string consisting of a sequence of numeric
+characters: 0..9, $s.
+
+Write a script to find the all valid different decodings in sorted order.
+
+|| Encoding is simply done by mapping A,B,C,D,... to 1,2,3,4,... etc.
+
+=cut
+
+use v5.16;
+use warnings;
+
+use Test::More;
+use Test::Deep qw(cmp_deeply);
+
+use List::MoreUtils qw(all firstidx);
+use Algorithm::Permute;
+
+
+
+sub decodedList ($) {
+  state $d = {map { (ord($_) - ord('A') + 1, $_) } 'A' .. 'Z'};
+
+  my %res;
+  my $len = length($_[0]);
+
+  # Create substring length list of lists
+  my @l = ([(2) x ($len >> 1), (1) x ($len % 2)]);
+  while (1) {
+    my @a = @{$l[-1]};
+    my $i = firstidx {$_ == 2} @a;
+    last if $i == -1;
+
+    splice(@a,$i,1,1,1); 
+    push(@l,[@a]);
+  }
+
+  # Find and decode the digits
+  for (@l) {
+    Algorithm::Permute::permute {
+      my @p = unpack(join(' ',map { "a$_" } @$_),$_[0]);
+      if (all { defined $d->{$_} } @p) {
+        $res{join('',map { $d->{$_} } @p)}++;
+      }
+    } @$_;
+  }
+
+  return [sort keys %res];
+}
+
+
+
+cmp_deeply(decodedList('11'),[qw(AA K)]);
+cmp_deeply(decodedList('1115'),[qw(AAAE AAO AKE KAE KO)]);
+cmp_deeply(decodedList('127'),[qw(ABG LG)]);
+
+done_testing;