2 files changed, 103 insertions, 0 deletions
diff --git a/challenge-166/e-choroba/perl/ch-1.pl b/challenge-166/e-choroba/perl/ch-1.pl
new file mode 100755
index 0000000000..fb20e61180
--- /dev/null
+++ b/challenge-166/e-choroba/perl/ch-1.pl
@@ -0,0 +1,59 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use feature qw{ say };
+
+use Syntax::Construct qw( /r );
+
+my $goal = shift;
+die "Use perldoc $0 to get the usage.\n" if $goal !~ /^[123]$/;
+
+=head1 Arguments
+
+ch-1.pl Goal /path/to/dictionary
+
+where Goal is:
+
+=over 4
+
+=item 1
+
+Show all the possible words.
+
+=item 2
+
+Limit the number of special substitutions.
+
+=item 3
+
+Find 8 letter phrases.
+
+=back
+
+=cut
+
+my @hexadecimal_words;
+my %by_length;
+while (<>) {
+    chomp;
+    next unless /^[a-folist]+$/i;
+    next if 2 == $goal && /^[olist]+$/i;
+    my $word = ucfirst(lc =~ tr/olist/01157/r);
+    if ($goal != 3) {
+        push @hexadecimal_words, $word;
+    } elsif (8 >= length $word) {
+        push @{ $by_length{ length $word } }, $word;
+    }
+}
+
+if ($goal != 3) {
+    say for @hexadecimal_words;
+} else {
+    for my $l (3 .. 5) {
+        for my $first (@{ $by_length{$l} }) {
+            for my $rest (@{ $by_length{ 8 - $l } }) {
+                say "$first$rest" unless $first eq $rest;
+            }
+        }
+    }
+}
diff --git a/challenge-166/e-choroba/perl/ch-2.pl b/challenge-166/e-choroba/perl/ch-2.pl
new file mode 100755
index 0000000000..7b181423dc
--- /dev/null
+++ b/challenge-166/e-choroba/perl/ch-2.pl
@@ -0,0 +1,44 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+
+use Path::Tiny qw{ path };
+use Text::Table;
+
+my @dirs = @ARGV;
+my %files_in;
+for my $dirname (@dirs) {
+    my $dir = path($dirname);
+    for my $child (sort $dir->children) {
+        push @{ $files_in{$dirname} },
+            $child->basename . ($child->is_dir ? '/' : "");
+    }
+}
+
+my $table = 'Text::Table'->new(\'|', map { $_, \'|' } @dirs);
+
+while (grep @$_, values %files_in) {
+    my %count;
+    ++$count{$_->[0]} for grep defined $_->[0], values %files_in;
+
+    if (1 == keys %count && (values %count)[0] == @dirs) {
+        shift @$_ for values %files_in;
+        next
+    }
+
+    my $first = (sort keys %count)[0];
+    my @row;
+    for my $dir (@dirs) {
+        if (($files_in{$dir}[0] // "") eq $first) {
+            push @row, shift @{ $files_in{$dir} };
+        } else {
+            push @row, "";
+        }
+    }
+    $table->add(@row);
+}
+
+print $table->title,
+      $table->rule('-'),
+      $table->body;
+