From 316021fab4f5d5da9fd5894541f934779ac20a2e Mon Sep 17 00:00:00 2001 From: Ryan Thompson Date: Fri, 8 Mar 2024 16:19:41 -0600 Subject: rjt's week 259 solutions --- challenge-259/ryan-thompson/README.md | 10 +- challenge-259/ryan-thompson/blog.txt | 1 + challenge-259/ryan-thompson/perl/ch-1.pl | 24 +++++ challenge-259/ryan-thompson/perl/ch-2.pl | 163 +++++++++++++++++++++++++++++++ 4 files changed, 192 insertions(+), 6 deletions(-) create mode 100644 challenge-259/ryan-thompson/blog.txt create mode 100644 challenge-259/ryan-thompson/perl/ch-1.pl create mode 100644 challenge-259/ryan-thompson/perl/ch-2.pl 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 () { + chomp; + + if ($id) { + if (/${O}end$id${C}/) { + $id{$id}{text} = @text > 1 ? [ @text ] : $text[0]; + @text = (); + $id = undef; + } else { + push @text, $_ + } + } + elsif (/${O}(?\w+)\s+(?.+?)${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' %} -- cgit