Solve PWC341

3 files changed, 49 insertions, 0 deletions

diff --git a/challenge-341/wlmb/blog.txt b/challenge-341/wlmb/blog.txt
new file mode 100644
index 0000000000..f8906811c9
--- /dev/null
+++ b/challenge-341/wlmb/blog.txt
@@ -0,0 +1 @@
+https://wlmb.github.io/2025/09/29/PWC341/
diff --git a/challenge-341/wlmb/perl/ch-1.pl b/challenge-341/wlmb/perl/ch-1.pl
new file mode 100755
index 0000000000..78eeba4b3c
--- /dev/null
+++ b/challenge-341/wlmb/perl/ch-1.pl
@@ -0,0 +1,25 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 341
+# Task 1:  Broken Keyboard
+#
+# See https://wlmb.github.io/2025/09/29/PWC341/#task-1-broken-keyboard
+use v5.36;
+use feature qw(try);
+die <<~"FIN" unless @ARGV and @ARGV%2==0;
+    Usage: $0 S1 K1 S2 K2...
+    to count how many words in string Si are free of the broken keys
+    that make string Ki.
+    FIN
+for my ($string, $keys)(@ARGV){
+    try {
+	die "Broken keys should correspond to word chars: $keys"
+	    unless $keys=~/^\w*$/;
+	my $result =                          # count filtered words (convert to scalar)
+	    grep {$keys eq "" || !/[$keys]/i} # no broken keys, or don't match them
+            	 split /\W+/, $string;        # split on non-word chars
+	say "String=$string; Broken keys=$keys -> $result";
+    }
+    catch($e){
+	warn $e;
+    }
+}
diff --git a/challenge-341/wlmb/perl/ch-2.pl b/challenge-341/wlmb/perl/ch-2.pl
new file mode 100755
index 0000000000..ac4d900686
--- /dev/null
+++ b/challenge-341/wlmb/perl/ch-2.pl
@@ -0,0 +1,23 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 341
+# Task 2:  Reverse Prefix
+#
+# See https://wlmb.github.io/2025/09/29/PWC341/#task-2-reverse-prefix
+use v5.36;
+use feature qw(try);
+die <<~"FIN" unless @ARGV && @ARGV%2==0;
+    Usage: $0 S1 C1 S2 C2...
+    to reverse the first characters of the string Si,
+    up to the character Ci.
+    FIN
+for my($string, $character)(@ARGV){
+    try{
+	die "Expected a single character: $character" unless length $character == 1;
+	my $original = $string;
+	$string =~ s/^(.*?$character)/reverse $1/e;
+	say"String=$original, character=$character -> $string";
+    }
+    catch($e){
+	warn $e;
+    }
+}