Merge pull request #9706 from jo-37/contrib

Solutions to challenge 259

3 files changed, 207 insertions, 0 deletions

diff --git a/challenge-259/jo-37/blog.txt b/challenge-259/jo-37/blog.txt
new file mode 100644
index 0000000000..4e86e04a1d
--- /dev/null
+++ b/challenge-259/jo-37/blog.txt
@@ -0,0 +1 @@
+https://github.sommrey.de/the-bears-den/2024/03/08/ch-259.html
diff --git a/challenge-259/jo-37/perl/ch-1.pl b/challenge-259/jo-37/perl/ch-1.pl
new file mode 100755
index 0000000000..3b85253922
--- /dev/null
+++ b/challenge-259/jo-37/perl/ch-1.pl
@@ -0,0 +1,76 @@
+#!/usr/bin/perl -s
+
+use v5.24;
+use Test2::V0;
+use File::Temp 'tempfile';
+use Date::Manip::Date;
+use experimental 'signatures';
+
+our ($tests, $examples, $verbose);
+
+run_tests() if $tests || $examples;	# does not return
+
+die <<EOS unless @ARGV >= 2;
+usage: $0 [-examples] [-tests] [START OFFS [HOLIDAY...]]
+
+-examples
+    run the examples from the challenge
+ 
+-tests
+    run some tests
+
+START
+    start date in format YYYY-MM-DD
+
+OFFS
+    business days offset
+
+HOLIDAY...
+    list of bank holidays in format YYYY-MM-DD
+
+EOS
+
+
+### Input and Output
+
+say bdo(@ARGV[0, 1], [@ARGV[2..$#ARGV]]);
+
+
+### Implementation
+
+sub bdo ($start, $offs, $bank=[]) {
+    my ($fh, $fn) = tempfile();
+    print $fh "*HOLIDAYS\n";
+    print $fh "$_ =\n" for @$bank;
+    close $fh;
+
+    my $sd = Date::Manip::Date->new($start);
+    $sd->config(ConfigFile => $fn);
+    
+    $sd->next_business_day($offs);
+    $sd->printf('%Y-%m-%d');
+}
+
+
+### Examples and tests
+
+sub run_tests {
+    SKIP: {
+        skip "examples" unless $examples;
+
+        is bdo('2018-06-28', 3, ['2018-07-03']), '2018-07-04', 'example 1';
+        is bdo('2018-06-28', 3), '2018-07-03', 'example 2';
+    }
+
+    SKIP: {
+        skip "tests" unless $tests;
+
+        is bdo('2018-06-30', 1), '2018-07-03', 'start on weekend';
+        is bdo('2018-06-28', 2,
+            [qw(2018-07-03 2018-06-29 2018-07-01 2018-07-04)]), '2018-07-05',
+            'multiple holidays';
+	}
+
+    done_testing;
+    exit;
+}
diff --git a/challenge-259/jo-37/perl/ch-2.pl b/challenge-259/jo-37/perl/ch-2.pl
new file mode 100755
index 0000000000..49c825020c
--- /dev/null
+++ b/challenge-259/jo-37/perl/ch-2.pl
@@ -0,0 +1,130 @@
+#!/usr/bin/perl -s
+
+use v5.24;
+use Test2::V0;
+use Regexp::Common qw(number delimited);
+use Clone 'clone';
+use Data::Dump 'dd';
+
+our ($tests, $examples);
+
+run_tests() if $tests || $examples;	# does not return
+
+die <<EOS unless @ARGV;
+usage: $0 [-examples] [-tests] [STR]
+
+-examples
+    run the examples from the challenge
+ 
+-tests
+    run some tests
+
+STR
+    string to be parsed
+
+EOS
+
+
+### Input and Output
+
+dd line_parser(shift);
+
+
+### Implementation
+
+sub unescape {
+    shift =~ s{\\(.)}{$1}gr;
+}
+
+sub line_parser {
+    our %tmp;
+    our $val;
+    my $parsed;
+
+    shift =~ m{
+        (?{ local %tmp })
+        \{% \s*+
+        (?<NAME>\w++)
+        (?{ $tmp{name} = $+{NAME}; })
+        (?:
+            \s++
+            (?<KEY>\w++)=
+            (?{ local $val; })
+            (?:
+                (??{qr{$RE{num}{dec}{-keep}
+                        (?{ $val = 0 + $1; })
+                    }x
+                })
+                |
+                (??{qr{$RE{delimited}{-delim => q{'"}}{-esc => '\\'}{-keep}
+                        (?{ $val = unescape($3); })
+                    }x
+                })
+            )
+            (?{ $tmp{fields}{$+{KEY}} = $val; })
+        )*+
+        \s*+ %\}
+        (?:
+            \n
+            (?<LINES>.*?)
+            \n
+            (?{ $tmp{text} = $+{LINES}; })
+            \{% \s*+
+            end\g{NAME}
+            \s*+ %\}
+        )?
+        (?{ $parsed = clone \%tmp; })
+    }xs;
+
+    $parsed;
+}
+
+
+### Examples and tests
+
+sub run_tests {
+    SKIP: {
+        skip "examples" unless $examples;
+
+        is line_parser(
+            '{%  id   field1="value1"    field2="value2"  field3=42 %}'
+        ), {name => 'id',
+            fields => {field1 => 'value1', field2 => 'value2', field3 => 42}},
+            'example 1';
+        is line_parser('{%  youtube title="Title \"quoted\" done" %}'),
+            {name => 'youtube', fields => { title => q{Title "quoted" done}}},
+            'example 2';
+        is line_parser(
+            '{%  youtube title="Title with escaped backslash \\\\" %}'
+        ), {name => 'youtube',
+            fields => {title => q{Title with escaped backslash \\}}},
+            'example 3';
+        is line_parser(<<'EOD'),
+{% id  field1="value1" %}
+LINE1
+LINE2
+{% endid %}
+EOD
+            {name => 'id', fields => {field1 => 'value1'},
+                text => "LINE1\nLINE2"}, 'example 4';
+    }
+
+    SKIP: {
+        skip "tests" unless $tests;
+
+        is line_parser('{% no_fields %}'), {name => 'no_fields'}, 'no fields';
+        is line_parser('{% no_end'), F(), 'incomplete';
+        is line_parser('{% inval f1=abc %}'), F(), 'unquoted string';
+        like line_parser('{% numstr f1="042" f2=043 f3=44.0e0 f4="45.0" f5="aaa" %}'),
+            hash { field name => 'numstr'; field fields => hash {
+                    field f1 => qr/^042$/; field f2 => qr/^43$/;
+                    field f3 => qr/^44$/; field f4 => qr/^45\.0$/;
+                    field f5 => qr/^aaa$/;}},
+            'numbers';
+        is line_parser(q{{% single_quote f1='one' %}}),
+            {name => 'single_quote', fields => {f1 => 'one'}}, 'single quote';
+	}
+
+    done_testing;
+    exit;
+}