Week 331 touchup

3 files changed, 177 insertions, 3 deletions

diff --git a/challenge-331/bob-lied/README.md b/challenge-331/bob-lied/README.md
index b995ebc8b4..0ba4a1bc6d 100644
--- a/challenge-331/bob-lied/README.md
+++ b/challenge-331/bob-lied/README.md
@@ -1,4 +1,4 @@
-# Solutions to weekly challenge 330 by Bob Lied
+# Solutions to weekly challenge 331 by Bob Lied
 
-## [PWC](https://perlweeklychallenge.org/blog/perl-weekly-challenge-330/)
-## [GitHub](https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-330/bob-lied)
+## [PWC](https://perlweeklychallenge.org/blog/perl-weekly-challenge-331/)
+## [GitHub](https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-331/bob-lied)
diff --git a/challenge-331/bob-lied/perl/ch-1.pl b/challenge-331/bob-lied/perl/ch-1.pl
new file mode 100644
index 0000000000..a72b9d6e0c
--- /dev/null
+++ b/challenge-331/bob-lied/perl/ch-1.pl
@@ -0,0 +1,74 @@
+#!/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 331 Task 1  Last Word
+#=============================================================================
+# You are given a string.
+# Write a script to find the length of last word in the given string.
+# Example 1 Input: $str = "The Weekly Challenge"
+#           Output: 9
+# Example 2 Input: $str = "   Hello   World    "
+#           Output: 5
+# Example 3 Input: $str = "Let's begin the fun"
+#           Output: 3
+#=============================================================================
+
+use v5.40;
+
+
+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 lastWord("@ARGV");
+
+#=============================================================================
+sub lastWord($str)
+{
+    my $last = (split(/ /, $str))[-1] // "";
+    $last =~ s/[[:punct:]]+$//;
+    $last =~ s/^[[:punct:]]+//;
+    return length($last);
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( lastWord("The Weekly Challenge"), 9, "Example 1");
+    is( lastWord("   Hello   World    "), 5, "Example 2");
+    is( lastWord("Let's begin the fun"),  3, "Example 3");
+
+    is( lastWord(""), 0, "Empty string");
+    is( lastWord("word"), 4, "One word");
+
+    is( lastWord("Is this a ('word)'?"), 4, "Surrounded by punctation");
+    is( lastWord("What about the dog's"), 5, "Possessive/contraction");
+
+    done_testing;
+}
+
+sub runBenchmark($repeat)
+{
+    use Benchmark qw/cmpthese/;
+
+    cmpthese($repeat, {
+            label => sub { },
+        });
+}
diff --git a/challenge-331/bob-lied/perl/ch-2.pl b/challenge-331/bob-lied/perl/ch-2.pl
new file mode 100644
index 0000000000..e5e03df421
--- /dev/null
+++ b/challenge-331/bob-lied/perl/ch-2.pl
@@ -0,0 +1,100 @@
+#!/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 331 Task 2  Buddy Strings
+#=============================================================================
+# You are given two strings, source and target.
+# Write a script to find out if the given strings are Buddy Strings.
+# If swapping of a letter in one string make them same as the other
+# then they are `Buddy Strings`.
+# Example 1 Input: $source = "fuck" $target = "fcuk"
+#           Output: true
+#   The swapping of 'u' with 'c' makes it buddy strings.
+# 
+# Example 2 Input: $source = "love" $target = "love"
+#           Output: false
+# Example 3 Input: $source = "fodo" $target = "food"
+#           Output: true
+# Example 4 Input: $source = "feed" $target = "feed"
+#           Output: true
+#=============================================================================
+
+use v5.40;
+
+
+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;
+
+for my ($src, $targ) ( @ARGV )
+{
+    say (isBuddy($src, $targ) ? "true" : "false");
+}
+
+#=============================================================================
+
+sub isBuddy($source, $target)
+{
+    return false if length($source) != length($target);
+
+    my @s = split(//, $source);
+    my @t = split(//, $target);
+
+    for my $i ( 0 .. $#s - 1 )
+    {
+        for my $j ( $i+1 .. $#s )
+        {
+            if ( $s[$i] eq $t[$j] && $s[$j] eq $t[$i] )
+            {
+                # We have a swappable pair. Do the rest of the
+                # strings match?
+                my @src = @s;
+                ( $src[$i], $src[$j] ) = ( $t[$i], $t[$j] );
+                return true if "@src" eq "@t";
+            }
+        }
+    }
+    return false;
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( isBuddy("fuck", "fcuk"),  true, "Example 1");
+    is( isBuddy("love", "love"), false, "Example 2");
+    is( isBuddy("fodo", "food"),  true, "Example 3");
+    is( isBuddy("feed", "feed"),  true, "Example 4");
+
+    is( isBuddy("hamster", "ramsteh"),  true, "Non-consecutive pair");
+    is( isBuddy("short", "srohter"), false, "Different lengths");
+
+    is( isBuddy("bcxxxb", "cbxxxb"), true, "Multiple possible pairs");
+
+    done_testing;
+}
+
+sub runBenchmark($repeat)
+{
+    use Benchmark qw/cmpthese/;
+
+    cmpthese($repeat, {
+            label => sub { },
+        });
+}