2 files changed, 103 insertions, 0 deletions
diff --git a/challenge-112/e-choroba/perl/ch-1.pl b/challenge-112/e-choroba/perl/ch-1.pl
new file mode 100755
index 0000000000..e36c9e60bb
--- /dev/null
+++ b/challenge-112/e-choroba/perl/ch-1.pl
@@ -0,0 +1,50 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+
+sub canonical_path {
+    my ($path) = @_;
+    my @steps = grep length && $_ ne '.', split m{/}, $path;
+    for (my $pos = 0; $pos <= $#steps; ++$pos) {
+        if ('..' eq $steps[$pos]) {
+            if ($pos > 0) {
+                splice @steps, $pos - 1, 2;
+                $pos -= 2;
+            } else {
+                splice @steps, $pos--, 1;
+            }
+        }
+    }
+    return '/' . join '/', @steps
+}
+
+use Test::More;
+
+is canonical_path('/a/'), '/a', 'Example 1';
+is canonical_path('/a/b//c/'), '/a/b/c', 'Example 2';
+is canonical_path('/a/b/c/../..'), '/a', 'Example 3';
+
+is canonical_path('/a/./b/./c/.'), '/a/b/c', 'Single dots';
+is canonical_path('/a/b/../c/../d'), '/a/d', 'Double dots';
+is canonical_path('/a/b/../../../../c'), '/c', 'Too many double dots';  # (*)
+is canonical_path('/../a'), '/a', 'Double dots at the beginning';
+is canonical_path('/../..'), '/', 'Only double dots at the beginning';
+
+done_testing();
+
+=heading1 COMMENTS
+
+(*) This test and the following ones mimic the shell's behaviour for
+existing paths only, e.g. /usr/share/../../../bin resolves to /bin,
+but /usr/NONEXISTENT/../../../bin fails.
+
+In fact, on *nix with symlinks involved, you can't resolve .. without
+checking the actual file system. For example,
+
+ $ mkdir 1 2
+ $ ln -s ../1 2/0
+ $ ls 2/0/../1
+
+The last command lists 1, not 2/1 (which doesn't exist).
+
+=cut
diff --git a/challenge-112/e-choroba/perl/ch-2.pl b/challenge-112/e-choroba/perl/ch-2.pl
new file mode 100755
index 0000000000..039a0af4b8
--- /dev/null
+++ b/challenge-112/e-choroba/perl/ch-2.pl
@@ -0,0 +1,53 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+
+sub climb_stairs {
+    my ($n) = @_;
+    return 0 if 0 == $n;
+
+    my @s = (1, 2);
+    push @s, $s[1] + shift @s for 2 .. $n;
+    return $s[0]
+}
+
+sub climb_stairs_options {
+    my ($n) = @_;
+    return [] if 0 == $n;
+
+    my @s = ([[1]], [[1, 1], [2]]);
+    push @s, [(map [1, @$_], @{ $s[1] }),
+              (map [2, @$_], @{ shift @s })]
+        for 2 .. $n;
+    return $s[0]
+}
+
+use Test::More;
+use Test::Deep;
+
+is climb_stairs(0), 0;
+is climb_stairs(1), 1;
+is climb_stairs(2), 2;
+is climb_stairs(3), 3;
+is climb_stairs(4), 5;
+is climb_stairs(5), 8;
+is climb_stairs(6), 13;
+
+#                   ^
+#                   |
+# Hmm, looks almost like the Fibonacci sequence!
+# The difference is the element 0, it depends on whether we allow no
+# steps as being a solution or not.
+
+cmp_deeply climb_stairs_options(1), [[1]];
+cmp_deeply climb_stairs_options(2), [[1, 1], [2]];
+cmp_deeply climb_stairs_options(3), [[1, 1, 1], [1, 2], [2, 1]];
+cmp_deeply climb_stairs_options(4), bag([1, 1, 1, 1],
+                                        [1, 1, 2], [1, 2, 1], [2, 1, 1],
+                                        [2, 2]);
+cmp_deeply climb_stairs_options(5),
+    bag([1, 1, 1, 1, 1],
+        [1, 1, 1, 2], [1, 1, 2, 1], [1, 2, 1, 1], [2, 1, 1, 1],
+        [1, 2, 2], [2, 1, 2], [2, 2, 1]);
+
+done_testing();