Merge pull request #13025 from boblied/w347

Week 347 solutions from Bob Lied

3 files changed, 166 insertions, 3 deletions

diff --git a/challenge-347/bob-lied/README.md b/challenge-347/bob-lied/README.md
index f38a58abd4..50f49b44c3 100644
--- a/challenge-347/bob-lied/README.md
+++ b/challenge-347/bob-lied/README.md
@@ -1,5 +1,5 @@
-# Solutions to weekly challenge 346 by Bob Lied
+# Solutions to weekly challenge 347 by Bob Lied
 
-## [PWC](https://perlweeklychallenge.org/blog/perl-weekly-challenge-346/)
-## [GitHub](https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-346/bob-lied)
+## [PWC](https://perlweeklychallenge.org/blog/perl-weekly-challenge-347/)
+## [GitHub](https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-347/bob-lied)
 [Blog](https://dev.to/boblied/)
diff --git a/challenge-347/bob-lied/perl/ch-1.pl b/challenge-347/bob-lied/perl/ch-1.pl
new file mode 100644
index 0000000000..6674f4120e
--- /dev/null
+++ b/challenge-347/bob-lied/perl/ch-1.pl
@@ -0,0 +1,73 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# Copyright (c) 2025, Bob Lied
+#=============================================================================
+# ch-1.pl Perl Weekly Challenge 347 Task 1  Format Date
+#=============================================================================
+# You are given a date in the form: 10th Nov 2025.  Write a script to format
+# the given date in the form: 2025-11-10 using the set below.
+# @DAYS   = ("1st", "2nd", "3rd", ....., "30th", "31st")
+# @MONTHS = ("Jan", "Feb", "Mar", ....., "Nov",  "Dec")
+# @YEARS  = (1900..2100)
+# Example 1 Input: $str = "1st Jan 2025"
+#           Output: "2025-01-01"
+# Example 2 Input: $str = "22nd Feb 2025"
+#           Output: "2025-02-22"
+# Example 3 Input: $str = "15th Apr 2025"
+#           Output: "2025-04-15"
+# Example 4 Input: $str = "23rd Oct 2025"
+#           Output: "2025-10-23"
+# Example 5 Input: $str = "31st Dec 2025"
+#           Output: "2025-12-31"
+# 
+#=============================================================================
+#=============================================================================
+
+use v5.42;
+
+
+use Getopt::Long;
+my $Verbose = false;
+my $DoTest  = false;
+my $Benchmark = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose, "benchmark:i" => \$Benchmark);
+my $logger;
+{
+    use Log::Log4perl qw(:easy);
+    Log::Log4perl->easy_init({ level => ($Verbose ? $DEBUG : $INFO ),
+            layout => "%d{HH:mm:ss.SSS} %p{1} %m%n" });
+    $logger = Log::Log4perl->get_logger();
+}
+#=============================================================================
+
+exit(!runTest()) if $DoTest;
+exit( runBenchmark($Benchmark) ) if $Benchmark;
+
+say fmtDate($_) for @ARGV;
+
+#=============================================================================
+sub fmtDate($str)
+{
+    state %MONTH = ( Jan => "01", Feb => "02", Mar => "03", Apr => "04",
+                     May => "05", Jun => "06", Jul => "07", Aug => "08",
+                     Sep => "09", Oct => "10", Nov => "11", Dec => "12");
+
+    my ($dd, $mmm, $yyyy) = $str =~ m/(\d+)(?:st|nd|rd|th) (\w+) (\d{4})/;
+
+    return sprintf("%4d-%02d-%02d", $yyyy, $MONTH{$mmm}, $dd);
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( fmtDate( "1st Jan 2025"), "2025-01-01", "Example 1");
+    is( fmtDate("22nd Feb 2025"), "2025-02-22", "Example 2");
+    is( fmtDate("15th Apr 2025"), "2025-04-15", "Example 3");
+    is( fmtDate("23rd Oct 2025"), "2025-10-23", "Example 4");
+    is( fmtDate("31st Dec 2025"), "2025-12-31", "Example 5");
+
+    done_testing;
+}
diff --git a/challenge-347/bob-lied/perl/ch-2.pl b/challenge-347/bob-lied/perl/ch-2.pl
new file mode 100644
index 0000000000..0b4082b07b
--- /dev/null
+++ b/challenge-347/bob-lied/perl/ch-2.pl
@@ -0,0 +1,90 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# Copyright (c) 2025, Bob Lied
+#=============================================================================
+# ch-2.pl Perl Weekly Challenge 347 Task 2  Format Phone Number
+#=============================================================================
+# You are given a phone number as a string containing digits, space and dash only.
+# Write a script to format the given phone number using the below rules:
+# 1. Removing all spaces and dashes
+# 2. Grouping digits into blocks of length 3 from left to right
+# 3. Handling the final digits (4 or fewer) specially:
+#    - 2 digits: one block of length 2
+#    - 3 digits: one block of length 3
+#    - 4 digits: two blocks of length 2
+# 4. Joining all blocks with dashes
+#
+# Example 1 Input: $phone = "1-23-45-6"
+#           Output: "123-456"
+# Example 2 Input: $phone = "1234"
+#           Output: "12-34"
+# Example 3 Input: $phone = "12 345-6789"
+#           Output: "123-456-789"
+# Example 4 Input: $phone = "123 4567"
+#           Output: "123-45-67"
+# Example 5 Input: $phone = "123 456-78"
+#           Output: "123-456-78"
+#=============================================================================
+
+use v5.42;
+
+
+use Getopt::Long;
+my $Verbose = false;
+my $DoTest  = false;
+my $Benchmark = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose, "benchmark:i" => \$Benchmark);
+my $logger;
+{
+    use Log::Log4perl qw(:easy);
+    Log::Log4perl->easy_init({ level => ($Verbose ? $DEBUG : $INFO ),
+            layout => "%d{HH:mm:ss.SSS} %p{1} %m%n" });
+    $logger = Log::Log4perl->get_logger();
+}
+#=============================================================================
+
+exit(!runTest()) if $DoTest;
+exit( runBenchmark($Benchmark) ) if $Benchmark;
+
+say fmtPhone($_) for @ARGV;
+
+#=============================================================================
+sub fmtPhone($phone)
+{
+    my $fmt = "";
+    $phone =~ s/[^0-9]//g;
+
+    my @p = $phone =~ m/(\d{1,3})/g;
+    if ( length($p[-1]) == 1 && @p > 1 )
+    {
+        (my $tail = "$p[-2]$p[-1]") =~ s/(..)(..)/$1-$2/;
+        splice(@p, -2, 2, $tail);
+    }
+    return join('-', @p);
+}
+
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( fmtPhone(  "1-23-45-6"), "123-456"     , "Example 1");
+    is( fmtPhone(       "1234"), "12-34"       , "Example 2");
+    is( fmtPhone("12 345-6789"), "123-456-789" , "Example 3");
+    is( fmtPhone(   "123 4567"), "123-45-67"   , "Example 4");
+    is( fmtPhone( "123 456-78"), "123-456-78"  , "Example 5");
+
+    done_testing;
+}
+
+sub runBenchmark($repeat)
+{
+    use Benchmark qw/cmpthese/;
+
+    cmpthese($repeat, {
+            label => sub { },
+        });
+}
+