Perl Weekly Challenge 259.

My solutions (task 1 and task 2 ) to the The Weekly Challenge - 259.

Task 1: Banking Day Offset

Submitted by: Lee Johnson
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'

Dates are somewhat complicated due to the different month lengths and the leap years. Though not terribly difficult, there are packages available that deal with dates. I use below the DateTime packages. I assume that @ARGV contains the starting date, the offset and the possibly empty list of banking days. I assume no default banking days. I use parse_datetime from DateTime::Format::DateParse to convert the input strings representing dates to an internal representation. I skip a day or two if the starting date is Sunday or Saturday. Then I add a full 7 day week for each 5 day working week. I add the remaining days to complete the offset and skip the weekend if I end at or beyond the weekend. Finally I test the banking days and add an additional day and possibly a weekend for each unique banking day within the interval between the starting and ending date. As the interval grows, I first sort the banking days. The resulting code is the following:

 1  # Perl weekly challenge 259
 2  # Task 1:  Banking Day Offset
 3  #
 4  # See https://wlmb.github.io/2024/03/04/PWC259/#task-1-banking-day-offset
 5  use v5.36;
 6  use DateTime;
 7  use DateTime::Format::DateParse qw(parse_datetime);
 8  use List::AllUtils qw(uniq_by);
 9  use POSIX qw(floor);
10  die <<~"FIN" unless @ARGV >= 2;
11      Usage ch-1.pl S D [B1 B2...]
12      to bump daye S by D days skipping weekends and
13      the (optional) bank holidays B1 B2...
14      FIN
15  my ($start_str, $offset, @bank_str)=@ARGV;
16  my ($start, @bank)=  # convert to dates
17      map
18      {DateTime::Format::DateParse->parse_datetime($_)->truncate(to=>'day')}
19      ($start_str, @bank_str);
20  my $fullweeks=floor($offset/5);
21  my $remaining=$offset%5;
22  my $end=$start->clone;
23  my $weekday=$end->day_of_week;
24  $end->add(days=>8-$weekday), $weekday=1 if $weekday>5;
25  $end->add(days=>7*$fullweeks+$remaining);
26  skip_weekend($end);
27  bank_adjust($_,$start,$end) for
28      sort {DateTime->compare($a, $b)} uniq_by {"".$_} @bank; # remove duplicate dates and sort
29  say "Start: $start_str. Offset $offset. Holidays: @bank_str -> ", $end->ymd;
30  sub skip_weekend($date){
31      my $weekday=$date->day_of_week;
32      $date->add(days=>2) if $weekday>5;
33  }
34  sub bank_adjust($date, $start, $end){
35      return if $date->day_of_week >5 ||
36  	DateTime->compare($date, $start) < 0 || DateTime->compare($date, $end) > 0;
37      $end->add(days=>1);
38      $end->add(days=>2) if $end->day_of_week>5; # skip weekend
39  }

Example 1:

./ch-1.pl 2018-06-28 3 2018-07-03

Results:

Start: 2018-06-28. Offset 3. Holidays: 2018-07-03 -> 2018-07-04

Example 2

./ch-1.pl 2018-06-28 3

Results:

Start: 2018-06-28. Offset 3. Holidays:  -> 2018-07-03

Other examples:

./ch-1.pl 2024-03-2 7 # skip two weekends
./ch-1.pl 2024-03-2 7 "March 4, 2024" 2024-03-04 # and duplicate holiday
./ch-1.pl 2024-03-2 7 2024-03-09  # holiday on weekend

Results:

start: 2024-03-2. Offset 7. Holidays:  -> 2024-03-13
start: 2024-03-2. Offset 7. Holidays: March 4, 2024 2024-03-04 -> 2024-03-14
start: 2024-03-2. Offset 7. Holidays: 2024-03-09 -> 2024-03-13

Task 2: Line Parser

Submitted by: Gabor Szabo
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  filed1="value1" ... %}
LINES
{% endid %}
You should expect the following structure from your line parser:

{
       name => id,
       fields => {
           field1 => value1,
           field2 => value2,
           field3 => value3,
       }
       text => LINES
}

I took this as an oportunity to learn about the package Parse::RecDescent. I make a grammar to describe the input above, i.e. a collection of records. A record is either of the form

{% id  filed1="value1" ... %}

i.e., a single structure with a name and key-value pairs, or of the form

{% id  filed1="value1" ... %}
LINES
{% endid %}

where the structure is followed by arbitrary lines and an end of record marker. Some care is required to interpret as text lines that have the control markers {%...%}. As the input is parsed I build a structure: an array of records, where each record is a hash with a name, a hash of fields and optionally, the text. I use Data::Dumper to print the resulting structure.

 1  # Perl weekly challenge 259
 2  # Task 2:  Line Parser
 3  #
 4  # See https://wlmb.github.io/2024/03/04/PWC259/#task-2-line-parser
 5  use v5.36;
 6  use Parse::RecDescent;
 7  use Data::Dumper;
 8  local $/;
 9  my $input=<>;
10  our @result;
11  my $grammar=q{
12    {my $id;}
13    startrule: record(s) eof
14        { $return = $item[1] }
15    record: single lines
16        { $return = {
17            %{$item[1]},
18          text => join " ", $item[2]->@* }
19        }
20    | single
21    single: '{%' id keyval(s) '%}'
22        { $return = { name => $item[2],  fields => { map {%$_} $item[3]->@*} };   }
23    id: /\w+/
24        { $id=$item[1]; }
25    lines: line(s) '{%' "end" "$id" '%}'
26       { $return = $item[1]; }
27    line: /.*/
28        { $return=$item[1]; $item[1]=~/^\{%/?undef:1; }
29    keyval: key "=" val
30        { $return = {$item[1]=>$item[3]} }
31    key: /\w+/
32    val: number | string
33    number: /\d+/
34    string: /"(?:[^"\n]|\\")*"/
35    eof: /^\Z/
36  };
37  my $parser=Parse::RecDescent->new($grammar);
38  my $parse=$parser->startrule($input);
39  say Dumper($parse);

Example:

./ch-2.pl <<FIN
    {​% id1   field1 = "value1"    field2 = "value2"  field3 = 42 %}
    {% id2 key1 = 123 key2 = "ab\"c\"" %}
    Some
    lines
    of
    text
    {% endid2 %}
    {% id3 key1 = 456 key2 = "def" %}
    FIN

Results:

$VAR1 = [
          {
            'fields' => {
                          'field1' => '"value1"    field2 = "value2"',
                          'field3' => '42'
                        },
            'name' => 'id1'
          },
          {
            'text' => 'Some lines of text',
            'fields' => {
                          'key2' => '"ab\\"c\\""',
                          'key1' => '123'
                        },
            'name' => 'id2'
          },
          {
            'fields' => {
                          'key1' => '456',
                          'key2' => '"def"'
                        },
            'name' => 'id3'
          }
        ];

So it seems to work, though I have much to learn yet about the Parse::RecDescent package and its efficient use.

Note: I had to use some zero width spaces for display purposes, as liquid was still being confused by the tags ‘{​% … %}’.

Written on March 4, 2024