Week 259 solutions

3 files changed, 205 insertions, 3 deletions

diff --git a/challenge-259/bob-lied/README b/challenge-259/bob-lied/README
index ebf80a337a..0353728dfd 100644
--- a/challenge-259/bob-lied/README
+++ b/challenge-259/bob-lied/README
@@ -1,4 +1,4 @@
-Solutions to weekly challenge 258 by Bob Lied
+Solutions to weekly challenge 259 by Bob Lied
 
-https://perlweeklychallenge.org/blog/perl-weekly-challenge-258/
-https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-258/bob-lied
+https://perlweeklychallenge.org/blog/perl-weekly-challenge-259/
+https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-259/bob-lied
diff --git a/challenge-259/bob-lied/perl/ch-1.pl b/challenge-259/bob-lied/perl/ch-1.pl
new file mode 100644
index 0000000000..2abf361780
--- /dev/null
+++ b/challenge-259/bob-lied/perl/ch-1.pl
@@ -0,0 +1,63 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# Copyright (c) 2024, Bob Lied
+#=============================================================================
+#  
+# ch-1.pl Perl Weekly Challenge 259 Task 1 Banking Day Offset
+#=============================================================================
+# You are given a start date and offset counter. Optionally you also get bank
+# holiday date list.  Given a number (of days) and a start date, return the
+# number (of days) adjusted to take into account non-banking days. In other
+# words: convert a banking day offset to a calendar day offset.
+# Non-banking days are: a) Weekends b) Bank holidays
+# Example 1
+# Input: $start_date = '2018-06-28', $offset = 3, $bank_holidays = ['2018-07-03']
+# Output: '2018-07-04'
+#   Thursday bumped to Wednesday (3 day offset, with Monday a bank holiday)
+# Example 2
+# Input: $start_date = '2018-06-28', $offset = 3
+# Output: '2018-07-03'
+#=============================================================================
+#=============================================================================
+
+use v5.38;
+
+use builtin qw/true false/; no warnings "experimental::builtin";
+
+use Getopt::Long;
+my $Verbose = 0;
+my $DoTest  = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose);
+exit(!runTest()) if $DoTest;
+
+sub bdo($startDate, $offset, $holiday = [])
+{
+    use DateTime::Format::ISO8601;
+
+    my $day = DateTime::Format::ISO8601->parse_datetime($startDate);
+
+    # Convert holday list into a hash for easy lookup
+    my %bh = map { $_ => 1 } $holiday->@*;
+
+    while ( $offset > 0 )
+    {
+        $day->add(days => 1);
+        $offset-- if ! ( $day->day_of_week == 6
+                      || $day->day_of_week == 7 
+                      || $bh{$day->ymd}
+                    );
+    }
+    return $day->ymd;
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( bdo('2018-06-28', 3, ['2018-07-03'] ), '2018-07-04', "Example 1");
+    is( bdo('2018-06-28', 3                 ), '2018-07-03', "Example 1");
+
+    done_testing;
+}
diff --git a/challenge-259/bob-lied/perl/ch-2.pl b/challenge-259/bob-lied/perl/ch-2.pl
new file mode 100644
index 0000000000..2a737f8867
--- /dev/null
+++ b/challenge-259/bob-lied/perl/ch-2.pl
@@ -0,0 +1,139 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# Copyright (c) 2024, Bob Lied
+#=============================================================================
+# ch-2.pl Perl Weekly Challenge 259 Task 2 Line Parser
+#=============================================================================
+# You are given a line like below:
+# {%  id   field1="value1"    field2="value2"  field3=42 %}
+# Where
+#   a) "id" can be \w+.
+#   b) There can be 0  or more field-value pairs.
+#   c) The name of the fields are \w+.
+#   b) The values are either number in which case we don't need double
+#      quotes or string in which case we need double quotes around them.
+# The line parser should return structure like below:
+# {
+#      name => id,
+#      fields => {
+#          field1 => value1,
+#          field2 => value2,
+#          field3 => value3,
+#      }
+# }
+# It should be able to parse the following edge cases too:
+# {%  youtube title="Title \"quoted\" done" %}
+# and
+# {%  youtube title="Title with escaped backslash \\" %}
+# BONUS: Extend it to be able to handle multiline tags:
+# {% id  field1="value1" ... %}
+# LINES
+# {% endid %}
+#
+# You should expect the following structure from your line parser:
+# {
+#      name => id,
+#      fields => {
+#          field1 => value1,
+#          field2 => value2,
+#          field3 => value3,
+#      }
+#      text => LINES
+# }
+#=============================================================================
+
+use v5.38;
+
+use builtin qw/true false trim/; no warnings "experimental::builtin";
+
+use Getopt::Long;
+my $Verbose = 0;
+my $DoTest  = 0;
+
+use Text::Balanced qw/extract_quotelike/;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose);
+exit(!runTest()) if $DoTest;
+
+sub parse($input)
+{
+    my %record;
+    my ($id, $fields) = ($input =~ m/{%\s+(\w+)\s+(.*)\s*%}/);
+    $record{name} = $id;
+
+    while ( $fields =~ m/(\w+)=("?[^"\\]*(\\.[^"\\]*)*"?)/g )
+    {
+        my $k = trim($1);
+        my $v = trim($2);
+        $v =~ s/\A["[:space:]]+|["[:space:]]+\z//g;
+
+        $v =~ s/\\"/"/g;
+        $v =~ s/\\\\/\\/g;
+
+        say "[$k]=[$v]" if $Verbose;
+        $record{fields}{$k} = $v;
+    }
+
+    if ( $input =~ m/{%\s+end$id\s+%}/ )
+    {
+        for ( split(/^/, $input) )
+        {
+            my $rc;
+            $record{text} .= $_ 
+                if $rc = /%}/ ... /{%\s+end$id\s+%}/
+                    and $rc !~ /(^1|E0)$/;
+        }
+    }
+    return \%record;
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( parse( q/{%  id   field1="value1"    field2="value2"  field3=42 %}/ ),
+        { name => "id",
+            fields => {
+                field1 => "value1",
+                field2 => "value2",
+                field3 => 42,
+            }
+        },
+        "Example 1");
+
+    is( parse( q/{%  youtube title="Title \"quoted\" done" %}/ ),
+            {
+                name => "youtube",
+                fields => {
+                    title => qq(Title "quoted" done),
+                }
+            },
+            "Example 2");
+
+    is( parse( q/{%  youtube title="Title with escaped backslash \\\\" %}/ ),
+            {
+                name => "youtube",
+                fields => {
+                    title => q/Title with escaped backslash \\/
+                }
+            },
+            "Example 3");
+    
+    my $input = <<'_INPUT_';
+{% bonus k="v" %}
+Here's some block
+paragraph text.
+{% endbonus %}
+_INPUT_
+
+    is( parse($input),
+            {
+                name => "bonus",
+                fields => { k => "v" },
+                text => "Here's some block\nparagraph text.\n"
+            },
+        "Bonus test");
+
+    done_testing;
+}