Week 341 solutions

3 files changed, 158 insertions, 3 deletions

diff --git a/challenge-341/bob-lied/README.md b/challenge-341/bob-lied/README.md
index ea96334263..e3e8ac2801 100644
--- a/challenge-341/bob-lied/README.md
+++ b/challenge-341/bob-lied/README.md
@@ -1,5 +1,5 @@
-# Solutions to weekly challenge 340 by Bob Lied
+# Solutions to weekly challenge 341 by Bob Lied
 
-## [PWC](https://perlweeklychallenge.org/blog/perl-weekly-challenge-340/)
-## [GitHub](https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-340/bob-lied)
+## [PWC](https://perlweeklychallenge.org/blog/perl-weekly-challenge-341/)
+## [GitHub](https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-341/bob-lied)
 [Blog](https://dev.to/boblied/)
diff --git a/challenge-341/bob-lied/perl/ch-1.pl b/challenge-341/bob-lied/perl/ch-1.pl
new file mode 100644
index 0000000000..9215b554a0
--- /dev/null
+++ b/challenge-341/bob-lied/perl/ch-1.pl
@@ -0,0 +1,80 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# Copyright (c) 2025, Bob Lied
+#=============================================================================
+# ch-1.pl Perl Weekly Challenge 341 Task 1  Broken Keyboard
+#=============================================================================
+# You are given a string containing English letters only and also you
+# are given broken keys. Write a script to return the total words in the
+# given sentence can be typed completely.
+# Example 1 Input: $str = 'Hello World', @keys = ('d')
+#           Output: 1
+# Example 2 Input: $str = 'apple banana cherry', @keys = ('a', 'e')
+#           Output: 0
+# Example 3 Input: $str = 'Coding is fun', @keys = ()
+#           Output: 3
+# Example 4 Input: $str = 'The Weekly Challenge', @keys = ('a','b')
+#           Output: 2
+# Example 5 Input: $str = 'Perl and Python', @keys = ('p')
+#           Output: 1
+#=============================================================================
+
+use v5.42;
+
+
+use Getopt::Long;
+my $Verbose = false;
+my $DoTest  = false;
+my $Benchmark = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose, "benchmark:i" => \$Benchmark);
+my $logger;
+{
+    use Log::Log4perl qw(:easy);
+    Log::Log4perl->easy_init({ level => ($Verbose ? $DEBUG : $INFO ),
+            layout => "%d{HH:mm:ss.SSS} %p{1} %m%n" });
+    $logger = Log::Log4perl->get_logger();
+}
+#=============================================================================
+
+exit(!runTest()) if $DoTest;
+exit( runBenchmark($Benchmark) ) if $Benchmark;
+
+say $_ for @ARGV;   # TODO command line processing here
+
+#=============================================================================
+sub broken($str, @keys)
+{
+    my $re = '[' . join("", @keys) . ']';
+    $re = '^$' if @keys == 0;
+    scalar grep !/$re/i, split(" ", $str);
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    my $str; my @keys;
+    $str = 'Hello World', @keys = ('d');
+    is( broken($str, @keys), 1, "Example 1");
+    $str = 'apple banana cherry', @keys = ('a', 'e');
+    is( broken($str, @keys), 0, "Example 2");
+    $str = 'Coding is fun', @keys = ();
+    is( broken($str, @keys), 3, "Example 3");
+    $str = 'The Weekly Challenge', @keys = ('a','b');
+    is( broken($str, @keys), 2, "Example 4");
+    $str = 'Perl and Python', @keys = ('p');
+    is( broken($str, @keys), 1, "Example 5");
+
+    done_testing;
+}
+
+sub runBenchmark($repeat)
+{
+    use Benchmark qw/cmpthese/;
+
+    cmpthese($repeat, {
+            label => sub { },
+        });
+}
diff --git a/challenge-341/bob-lied/perl/ch-2.pl b/challenge-341/bob-lied/perl/ch-2.pl
new file mode 100644
index 0000000000..e001c7b4cf
--- /dev/null
+++ b/challenge-341/bob-lied/perl/ch-2.pl
@@ -0,0 +1,75 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# Copyright (c) 2025, Bob Lied
+#=============================================================================
+# ch-2.pl Perl Weekly Challenge 341 Task 2  Reverse Prefix
+#=============================================================================
+# You are given a string, $str and a character in the given string, $char.
+# Write a script to reverse the prefix upto the first occurrence of the
+# given $char in the given string $str and return the new string.
+# Example 1 Input: $str = "programming", $char = "g"
+#           Output: "gorpramming"
+# Example 2 Input: $str = "hello", $char = "h"
+#           Output: "hello"
+# Example 3 Input: $str = "abcdefghij", $char = "h"
+#           Output: "hgfedcbaij"
+# Example 4 Input: $str = "reverse", $char = "s"
+#           Output: "srevere"
+# Example 5 Input: $str = "perl", $char = "r"
+#           Output: "repl"
+#=============================================================================
+
+use v5.42;
+
+
+use Getopt::Long;
+my $Verbose = false;
+my $DoTest  = false;
+my $Benchmark = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose, "benchmark:i" => \$Benchmark);
+my $logger;
+{
+    use Log::Log4perl qw(:easy);
+    Log::Log4perl->easy_init({ level => ($Verbose ? $DEBUG : $INFO ),
+            layout => "%d{HH:mm:ss.SSS} %p{1} %m%n" });
+    $logger = Log::Log4perl->get_logger();
+}
+#=============================================================================
+
+exit(!runTest()) if $DoTest;
+exit( runBenchmark($Benchmark) ) if $Benchmark;
+
+say $_ for @ARGV;   # TODO command line processing here
+
+#=============================================================================
+sub revPrefix($str, $char)
+{
+    my $upto = index($str, $char);
+    # my $prefix = substr($str, 0, 1+$upto);
+    # substr($str, 0, length($prefix)) = reverse($prefix);
+    return reverse( substr($str, 0, 1+$upto) ) . substr($str, $upto+1);
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( revPrefix("programming", "g"), 'gorpramming', "Example 1");
+    is( revPrefix("hello",       "h"), 'hello',       "Example 2");
+    is( revPrefix("abcdefghij",  "h"), 'hgfedcbaij',  "Example 3");
+    is( revPrefix("reverse",     "s"), 'srevere',     "Example 4");
+    is( revPrefix("perl",        "r"), 'repl',        "Example 5");
+
+    done_testing;
+}
+
+sub runBenchmark($repeat)
+{
+    use Benchmark qw/cmpthese/;
+
+    cmpthese($repeat, {
+            label => sub { },
+        });
+}