Merge pull request #9708 from rjt-pl/master

rjt's week 259 solutions

4 files changed, 192 insertions, 6 deletions

diff --git a/challenge-259/ryan-thompson/README.md b/challenge-259/ryan-thompson/README.md
index b3303d62c9..7a4e388b49 100644
--- a/challenge-259/ryan-thompson/README.md
+++ b/challenge-259/ryan-thompson/README.md
@@ -1,17 +1,15 @@
 # Ryan Thompson
 
-## Week 258 Solutions
+## Week 259 Solutions
 
-### Task 1 › Count Even Digits Number
+### Task 1 › Banking Day Offset
 
  * [Perl](perl/ch-1.pl)
- * [Raku](raku/ch-1.raku)
 
-### Task 2 › Sum of Values
+### Task 2 › Line Parser
 
  * [Perl](perl/ch-2.pl)
- * [Raku](raku/ch-2.raku)
 
 ## Blog
 
- * [Counting Digits and Summing Values](https://ry.ca/2024/02/pwc-258-counting-digits-and-summing-values/)
+ * [Bank Holidays and Line Parser](https://ry.ca/2024/03/pwc-259-bank-holidays-and-line-parser/)
diff --git a/challenge-259/ryan-thompson/blog.txt b/challenge-259/ryan-thompson/blog.txt
new file mode 100644
index 0000000000..d2de007ca5
--- /dev/null
+++ b/challenge-259/ryan-thompson/blog.txt
@@ -0,0 +1 @@
+https://ry.ca/2024/03/pwc-259-bank-holidays-and-line-parser/
diff --git a/challenge-259/ryan-thompson/perl/ch-1.pl b/challenge-259/ryan-thompson/perl/ch-1.pl
new file mode 100644
index 0000000000..9af52cc981
--- /dev/null
+++ b/challenge-259/ryan-thompson/perl/ch-1.pl
@@ -0,0 +1,24 @@
+use 5.010;
+use Time::Piece; # Easy weekday + math
+
+my $date_fmt = '%Y-%m-%d'; # Per task description
+
+sub bank_holiday_ofs {
+    my ($start_date, $offset, @holidays) = @_;
+
+    my $t = Time::Piece->strptime($start_date => $date_fmt) - 86400;
+
+    my %holiday = map { $_ => 1 } @holidays;
+    $offset++; # Account for today
+    
+    while ($offset) {
+        $t += 86400; # Advance day
+        $offset-- unless $t->wday == 1 or $t->wday == 7 
+                      or $holiday{ $t->strftime($date_fmt) };
+    }
+
+    $t->strftime($date_fmt);
+}
+
+#say bank_holiday_ofs('2018-06-28', 3);               # 2018-07-03
+#say bank_holiday_ofs('2018-06-28', 3, '2018-07-03'); # 2018-07-04
diff --git a/challenge-259/ryan-thompson/perl/ch-2.pl b/challenge-259/ryan-thompson/perl/ch-2.pl
new file mode 100644
index 0000000000..10ef473802
--- /dev/null
+++ b/challenge-259/ryan-thompson/perl/ch-2.pl
@@ -0,0 +1,163 @@
+use 5.010;
+use warnings;
+use strict;
+use autodie;
+no warnings 'uninitialized';
+
+my ($O, $C) = (qr/^\s*\{\%\s*/, qr/\s*\%\}\s*$/); # Tokens gobble whitespace
+my @text;   # Text lines for multi-line ids
+my %id;     # Result hash of ids and their associated data structures
+my $id;     # Current ID
+
+for (<DATA>) {
+    chomp;
+
+    if ($id) {
+        if (/${O}end$id${C}/) {
+            $id{$id}{text} = @text > 1 ? [ @text ] : $text[0];
+            @text = ();
+            $id = undef;
+        } else {
+            push @text, $_
+        }
+    } 
+    elsif (/${O}(?<id>\w+)\s+(?<fields>.+?)${C}/) {
+        die "No end token found for <$id>" if $id and @text;
+        $id = $+{id};
+        die "Duplicate id <$id>" if exists $id{$id};
+        $id{$id} = { name => $id, fields => parse_fields($+{fields}) };
+    }
+    else {
+        die "Invalid line: <$_>";
+    }
+}
+
+die "No end token found for <$id>" if $id and @text;
+
+pretty(\%id); # Pretty print the result
+
+exit;
+
+
+# Parse name=value fields, and return a hash of kv pairs
+# This is the harder part, due to escape sequences
+sub parse_fields {
+    # State machine, going char by char
+    my %fields;         # Result hash of kv pairs
+    my $state = 'out';  # Outside of kv pair
+    my $backslash = 0;  # Substate for whether we're backslashed
+    my $name;           # Field name
+    my $value;          # Field value
+    my $expected_closing_quote; # If defined, value must end with this
+
+    for (split //, "$_[0] ") { # Extra space simplifies parsing
+
+        # Backslash handling
+        $backslash = 0 if $backslash == 2;
+        if ($backslash) {
+            $_ = eval "\$_"; # safe
+            $backslash = 2;
+        } elsif (/\\/) {
+            $backslash = 1;
+            next;
+        }
+
+        # Ready for next key/value pair
+        if ($state eq 'out') {
+            next if /\s/;
+            $expected_closing_quote = undef;
+            die "Invalid character `$_' in ID" unless /\w/;
+            $state = 'field_name';
+            $name = $_;
+        }
+        # Expecting a comma and optional whitespace
+        elsif ($state eq 'comma') {
+            next if /\s/;
+            $state = 'out' if $_ eq ',';
+        }
+
+        # Field name states
+        elsif ($state eq 'field_name') {
+            if (/\s/) {
+                $state = 'equal';
+                next;
+            }
+            if (/=/) {
+                $state = 'value_start';
+                next;
+            }
+            die "Invalid character in ID" unless /\w/;
+            $name .= $_;
+        }
+
+        # Expecting equal sign and optional whitespace
+        elsif ($state eq 'equal') {
+            next if /\s/;
+            $state = 'value_start';
+        }
+
+        # Handle the value, with optional quotes and escape sequences
+        elsif ($state eq 'value_start') {
+            next if /\s/;
+            if (/['"]/ and not $backslash) {
+                $expected_closing_quote = $_;
+                $state = 'value';
+                $value = '';
+                next;
+            }
+            $value = $_;
+            $state = 'value';
+        }
+
+
+        elsif ($state eq 'value') {
+            if (($_ eq $expected_closing_quote && !$backslash)
+                    or (/[ ,]/ and not defined $expected_closing_quote))
+            {
+                $state = $_ eq ',' ? 'out' : 'comma';
+                $fields{$name} = $value;
+                next;
+            }
+            $value .= $_;
+        }
+    }
+
+    \%fields;
+}
+
+sub val {
+    local $_ = shift;
+    defined ? "`$_'" : "(undef)";
+}
+
+# Pretty printer. Prefer Data::Printer, or fall back to Data::Dumper (core)
+sub pretty {
+    my ($ref) = @_;
+
+    my $res;
+    $res = eval {
+        require Data::Printer;
+        Data::Printer->import;
+        1;
+    };
+
+    if ($res) {
+        p($ref)
+    }
+    else {
+        use Data::Dumper qw< Dumper >;
+        print Dumper $ref
+    }
+
+}
+
+__DATA__
+{% id1 field1="value1", field2="value2" %}
+    Line of text.
+    {% id1.5 desc="This line should NOT be parsed!" %}
+    Another line of text.
+{% endid1 %}
+{% id2 label=plain, in='middle', number=43 %}
+    Single line text.
+{% endid2 %}
+{% id3 embedded="That's the \"plan\"", single='Single "quotes" are OK' %}