Merge pull request #13021 from robbie-hatley/rh347

Robbie Hatley's solutions, in Perl, for The Weekly Challenge #347.

3 files changed, 194 insertions, 0 deletions

diff --git a/challenge-347/robbie-hatley/blog.txt b/challenge-347/robbie-hatley/blog.txt
new file mode 100644
index 0000000000..05254ff4d4
--- /dev/null
+++ b/challenge-347/robbie-hatley/blog.txt
@@ -0,0 +1 @@
+https://hatley-software.blogspot.com/2025/11/robbie-hatleys-solutions-in-perl-for.html
\ No newline at end of file
diff --git a/challenge-347/robbie-hatley/perl/ch-1.pl b/challenge-347/robbie-hatley/perl/ch-1.pl
new file mode 100755
index 0000000000..72436abca0
--- /dev/null
+++ b/challenge-347/robbie-hatley/perl/ch-1.pl
@@ -0,0 +1,89 @@
+#!/usr/bin/env perl
+
+=pod
+
+--------------------------------------------------------------------------------------------------------------
+TITLE AND ATTRIBUTION:
+Solutions in Perl for The Weekly Challenge 347-1,
+written by Robbie Hatley on Tue Nov 11, 2025.
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM DESCRIPTION:
+Task 347-1: Format Date
+Submitted by: Mohammad Sajid Anwar
+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:  "1st Jan 2025"
+Output: "2025-01-01"
+
+Example #2:
+Input:  "22nd Feb 2025"
+Output: "2025-02-22"
+
+Example #3:
+Input:  "15th Apr 2025"
+Output: "2025-04-15"
+
+Example #4:
+Input:  "23rd Oct 2025"
+Output: "2025-10-23"
+
+Example #5:
+Input:  "31st Dec 2025"
+Output: "2025-12-31"
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM NOTES:
+To solve this problem, I use a "month map" to map month names back to numbers.
+
+--------------------------------------------------------------------------------------------------------------
+IO NOTES:
+Input is via either built-in variables or via @ARGV. If using @ARGV, provide one argument which must be a
+single-quoted array of double-quoted strings, in proper Perl syntax, like so:
+
+./ch-1.pl '("37th Jan 2027", "18th Aug 2456")'
+
+Output is to STDOUT and will be each input followed by the corresponding output.
+
+=cut
+
+# ------------------------------------------------------------------------------------------------------------
+# PRAGMAS, MODULES, AND SUBS:
+
+   use v5.36;
+   use utf8::all;
+
+   # Convert date format:
+   sub format_date ( $s ) {
+      my ($d1, $m1, $y) = split /\s+/, $s;
+      my $d2 = $d1 =~ s/\D+//gr;
+      if (length($d2) < 2) {$d2 .= '0'}
+      my %mth_map =
+      ('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 $m2 = $mth_map{$m1};
+      $y.'-'.$m2.'-'.$d2}
+
+# ------------------------------------------------------------------------------------------------------------
+# INPUTS:
+my @dates =  @ARGV ? eval($ARGV[0])
+                   : ('1st Jan 2025', '22nd Feb 2025', '15th Apr 2025', '23rd Oct 2025', '31st Dec 2025');
+# Expected outputs :  '2025-01-01'    '2025-02-22'     '2025-04-15'     '2025-10-23'     '2025-12-31'
+
+# ------------------------------------------------------------------------------------------------------------
+# MAIN BODY OF PROGRAM:
+$"=', ';
+for my $d1 (@dates) {
+   say '';
+   say "Long  date = $d1";
+   my $d2 = format_date $d1;
+   say "Short date = $d2";
+}
diff --git a/challenge-347/robbie-hatley/perl/ch-2.pl b/challenge-347/robbie-hatley/perl/ch-2.pl
new file mode 100755
index 0000000000..ccc94b676b
--- /dev/null
+++ b/challenge-347/robbie-hatley/perl/ch-2.pl
@@ -0,0 +1,104 @@
+#!/usr/bin/env perl
+
+=pod
+
+--------------------------------------------------------------------------------------------------------------
+TITLE AND ATTRIBUTION:
+Solutions in Perl for The Weekly Challenge 347-2,
+written by Robbie Hatley on Tue Nov 11, 2025.
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM DESCRIPTION:
+Task 347-2: Format Phone Number
+Submitted by: Mohammad Sajid Anwar
+You are given a phone number as a string. Write a script to
+format the given phone number using these rules:
+1. Remove all non-digit characters.
+2. Group digits into blocks of length 3 from left to right.
+3. Handle the final digits (4 or fewer) specially:
+   - 0 digits: zero blocks
+   - 1 digits: one block of length 1
+   - 2 digits: one block of length 2
+   - 3 digits: one block of length 3
+   - 4 digits: two blocks of length 2
+4. Join all blocks with dashes.
+
+Example #1:
+Input:  "1-23-45-6"
+Output: "123-456"
+
+Example #2:
+Input:  "1234"
+Output: "12-34"
+
+Example #3:
+Input:  "12 345-6789"
+Output: "123-456-789"
+
+Example #4:
+Input:  "123 4567"
+Output: "123-45-67"
+
+Example #5:
+Input:  "123 456-78"
+Output: "123-456-78"
+
+Example #6:
+Input:  "42"
+Output: "42"
+
+Example #7:
+Input:  ""
+Output: ""
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM NOTES:
+To solve this problem, I'll use Perl's "substr" function to splice-off chunks of size 3 from the left while
+the size of the remainder is greater than 4, then handle the final 0-to-4 digits as described.
+
+--------------------------------------------------------------------------------------------------------------
+IO NOTES:
+Input is via either built-in variables or via @ARGV. If using @ARGV, provide one argument which must be a
+single-quoted array of double-quoted strings, in proper Perl syntax, like so:
+
+./ch-2.pl '("1973 20393-382-2-34833", "2043-3946 G 2845-3950", "47", "8", "")'
+
+Output is to STDOUT and will be each input followed by the corresponding output.
+
+=cut
+
+# ------------------------------------------------------------------------------------------------------------
+# PRAGMAS, MODULES, AND SUBS:
+
+   use v5.36;
+   use utf8::all;
+
+   # Convert phone format:
+   sub format_phone ( $s ) {
+      $s =~ s/\D//g;
+      my @nums = ();
+      while ( 1 ) {
+            if ( length($s) > 4  ) {push @nums, substr $s, 0, 3, ''}
+         elsif ( 4 == length($s) ) {push @nums, substr $s, 0, 2, '';
+                                    push @nums, substr $s, 0, 2, ''}
+         elsif ( 3 == length($s) ) {push @nums, substr $s, 0, 3, ''}
+         elsif ( 2 == length($s) ) {push @nums, substr $s, 0, 2, ''}
+         elsif ( 1 == length($s) ) {push @nums, substr $s, 0, 1, ''}
+         else {last}}
+      join '-', @nums}
+
+# ------------------------------------------------------------------------------------------------------------
+# INPUTS:
+my @phones = @ARGV ? eval($ARGV[0])
+                   : ("1-23-45-6", "1234", "12 345-6789", "123 4567", "123 456-78");
+# Expected outputs:   "123-456"    "12-34" "123-456-789"  "123-45-67" "123-456-78"
+
+# ------------------------------------------------------------------------------------------------------------
+# MAIN BODY OF PROGRAM:
+$"=', ';
+for my $p1 (@phones) {
+   say '';
+   say "Old phone = $p1";
+   my $p2 = format_phone $p1;
+   say "New phone = $p2";
+}