2 files changed, 75 insertions, 0 deletions
diff --git a/challenge-347/e-choroba/perl/ch-1.pl b/challenge-347/e-choroba/perl/ch-1.pl
new file mode 100755
index 0000000000..ded2291a0c
--- /dev/null
+++ b/challenge-347/e-choroba/perl/ch-1.pl
@@ -0,0 +1,53 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use experimental qw( signatures );
+
+{
+    my @DAYS   = map +(s/(?<!1)1$/1st/r
+                       =~ s/(?<!1)2$/2nd/r
+                       =~ s/(?<!1)3$/3rd/r
+                       =~ s/(?<=\d)$/th/r),
+                 1 .. 31;
+    my @MONTHS = qw( Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec );
+    my @YEARS  = 1900 .. 2100;
+
+    my %DAYS;
+    @DAYS{@DAYS} = ();
+    my $m = 1;
+    my %MONTHS = map +($_ => $m++), @MONTHS;
+    my %YEARS;
+    @YEARS{@YEARS} = ();
+
+    sub format_date($str) {
+        my ($day, $month, $year) = split / /, $str;
+        if (   exists $DAYS{$day}
+            && exists $MONTHS{$month}
+            && exists $YEARS{$year}
+        ) {
+            return sprintf '%s-%02d-%02d', $year,
+                                           $MONTHS{$month},
+                                           $day =~ /([0-9]+)/
+        }
+        die "Date invalid or out of range: $str.\n"
+    }
+}
+
+use Test2::V0;
+plan(5 + 1 + 5);
+
+is format_date('1st Jan 2025'), '2025-01-01', 'Example 1';
+is format_date('22nd Feb 2025'), '2025-02-22', 'Example 2';
+is format_date('15th Apr 2025'), '2025-04-15', 'Example 3';
+is format_date('23rd Oct 2025'), '2025-10-23', 'Example 4';
+is format_date('31st Dec 2025'), '2025-12-31', 'Example 5';
+
+is format_date('12th Dec 1900'), '1900-12-12', 'No 12nd';
+
+for my $invalid ('11st Apr 2020', '12nd Apr 2020', '0th Apr 2000',
+                 '1st Jan 2101', '31st Dec 1899'
+) {
+    is dies { format_date($invalid) },
+        "Date invalid or out of range: $invalid.\n",
+        "Invalid $invalid";
+}
diff --git a/challenge-347/e-choroba/perl/ch-2.pl b/challenge-347/e-choroba/perl/ch-2.pl
new file mode 100755
index 0000000000..8b1240d150
--- /dev/null
+++ b/challenge-347/e-choroba/perl/ch-2.pl
@@ -0,0 +1,22 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use experimental qw( signatures );
+
+sub format_phone_number($phone) {
+    s/[- ]//g,                              # Remove spaces and dashes.
+    s/(...)/$1-/g,                          # Groups of 3.
+    s/-(.?)$/$1/,                           # - or -1 at the end.
+    s/(^|-)([0-9]{2})([0-9]{2})$/$1$2-$3/   # Split groups of 4 at the end.
+        for $phone;
+
+    return $phone
+}
+
+use Test::More tests => 5;
+
+is format_phone_number('1-23-45-6'), '123-456', 'Example 1';
+is format_phone_number('1234'), '12-34', 'Example 2';
+is format_phone_number('12 345-6789'), '123-456-789', 'Example 3';
+is format_phone_number('123 4567'), '123-45-67', 'Example 4';
+is format_phone_number('123 456-78'), '123-456-78', 'Example 5';