4 files changed, 50 insertions, 0 deletions
diff --git a/challenge-046/e-choroba/perl/ch-1.pl b/challenge-046/e-choroba/perl/ch-1.pl
new file mode 100755
index 0000000000..affc81b7fe
--- /dev/null
+++ b/challenge-046/e-choroba/perl/ch-1.pl
@@ -0,0 +1,22 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+
+use List::Util qw{ max };
+
+my @message_sets = (['Hxl4!', 'ce-lo', 'ze6lg', 'HWlvR', 'q9m#o'],
+                    ['P+2l!ato', '1e80R$4u', '5-r]+a>/', 'Pxwlb3k\\',
+                     '2e35R8yu', '<!r^()k0']);
+
+for my $messages (@message_sets) {
+    my @frequency;
+    for my $message (@$messages) {
+        ++$frequency[$_]{ substr $message, $_, 1 }
+            for 0 .. length($message) - 1;
+    }
+    for my $position (@frequency) {
+        my $max = max(values %$position);
+        $position->{$_} == $max and print for keys %$position;
+    }
+    print "\n";
+}
diff --git a/challenge-046/e-choroba/perl/ch-2.pl b/challenge-046/e-choroba/perl/ch-2.pl
new file mode 100755
index 0000000000..372ad3cc19
--- /dev/null
+++ b/challenge-046/e-choroba/perl/ch-2.pl
@@ -0,0 +1,13 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use feature qw{ say };
+
+my $MAX = 500;
+
+my @doors = (0) x $MAX;  # All closed.
+for my $employee (0 .. $MAX - 1) {
+    $doors[$_] = ! $doors[$_]
+        for grep 0 == (1 + $_) % (1 + $employee), 0 .. $MAX - 1;
+}
+say join ' ', map 1 + $_, grep $doors[$_], 0 .. $MAX;
diff --git a/challenge-046/e-choroba/perl/ch-2a.pl b/challenge-046/e-choroba/perl/ch-2a.pl
new file mode 100755
index 0000000000..38ff9a103a
--- /dev/null
+++ b/challenge-046/e-choroba/perl/ch-2a.pl
@@ -0,0 +1,9 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use feature qw{ say };
+
+say join ' ', grep {
+    my $door = $_;
+    1 == (grep 0 == $door % $_, 1 .. 500) % 2
+} 1 .. 500;
diff --git a/challenge-046/e-choroba/perl/ch-2b.pl b/challenge-046/e-choroba/perl/ch-2b.pl
new file mode 100755
index 0000000000..0b60d23608
--- /dev/null
+++ b/challenge-046/e-choroba/perl/ch-2b.pl
@@ -0,0 +1,6 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use feature qw{ say };
+
+say join ' ', map $_ ** 2, 1 .. sqrt 500;