- Added solutions by Fabio Valeri.

2 files changed, 168 insertions, 0 deletions

diff --git a/challenge-331/fabio-valeri/perl/ch-1.pl b/challenge-331/fabio-valeri/perl/ch-1.pl
new file mode 100644
index 0000000000..74e5680134
--- /dev/null
+++ b/challenge-331/fabio-valeri/perl/ch-1.pl
@@ -0,0 +1,57 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use feature 'say';
+
+# Task 1: Last Word
+# Submitted by: Mohammad Sajid Anwar
+#
+# 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
+
+
+# Function to count the number of letters of the last word
+sub last_word {
+    my $input = shift;
+
+    # Read last word considering empty spaces
+    $input =~ /(\S+)\s*$/;
+    # compute length
+    return length($1);
+
+}
+
+# Test cases
+my @test_strings = (
+                     "The Weekly Challenge"
+                    , "Hello   World    "
+                    , "Let's begin the fun"
+);
+
+# Test the function with all test cases
+say "Testing last_word function:\n";
+
+foreach my $test (@test_strings) {
+    my $result = last_word($test);
+    printf "Input:  %-25s => Output: %s\n", "\"$test\"", "\"$result\"";
+}
+
+# Also allow command line testing
+if (@ARGV) {
+    say "\nCommand line input:";
+    my $result = last_word($ARGV[0]);
+    say "Input:  \"$ARGV[0]\" => Output: \"$result\"";
+  }
diff --git a/challenge-331/fabio-valeri/perl/ch-2.pl b/challenge-331/fabio-valeri/perl/ch-2.pl
new file mode 100644
index 0000000000..e7d389f33b
--- /dev/null
+++ b/challenge-331/fabio-valeri/perl/ch-2.pl
@@ -0,0 +1,111 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use feature 'say';
+
+
+# Task 2: Buddy Strings
+# Submitted by: Mohammad Sajid Anwar
+#
+# 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
+
+
+# Function to check if two strings are buddy strings
+sub are_buddy_strings {
+    my ($source, $target) = @_;
+
+    # Must be same length
+    return 0 if length($source) != length($target);
+
+    # Find differences
+    my @diff_positions = ();
+    for my $i (0 .. length($source) - 1) {
+        if (substr($source, $i, 1) ne substr($target, $i, 1)) {
+            push @diff_positions, $i;
+        }
+    }
+
+    # Case 1: No differences - strings are identical
+    if (@diff_positions == 0) {
+        # Check if source has duplicate characters (can swap identical chars)
+        my %char_count = ();
+        for my $char (split //, $source) {
+            $char_count{$char}++;
+            return 1 if $char_count{$char} >= 2;  # Found duplicate
+        }
+        return 0;  # No duplicates, can't swap
+    }
+
+    # Case 2: Exactly 2 differences
+    elsif (@diff_positions == 2) {
+        my ($pos1, $pos2) = @diff_positions;
+        # Check if swapping these positions makes strings equal
+        return (substr($source, $pos1, 1) eq substr($target, $pos2, 1) &&
+                substr($source, $pos2, 1) eq substr($target, $pos1, 1));
+    }
+
+    # Case 3: More than 2 differences - impossible with single swap
+    else {
+        return 0;
+    }
+}
+
+# Test cases from the problem
+my @test_cases = (
+              ["fuck", "fcuk", 1, "Swapping 'u' with 'c'"]
+             ,["love", "love", 0, "Identical with no duplicates"]
+             ,["fodo", "food", 1, "Swapping 'd' with 'o'"]
+             ,["feed", "feed", 1, "Identical with duplicate 'e'"]
+             ,["abc" , "def" , 0, "Completely different"]
+             ,["abcd", "abc" , 0, "Different lengths"]
+             ,["ab"  , "ba"  , 1, "Simple swap"]
+             ,["aa"  , "aa"  , 1, "Identical with duplicates"]
+             ,["abc" , "acb" , 1, "Swap b and c"]
+             ,["abcd", "badc", 0, "Too many differences"]
+);
+
+say "Testing Buddy Strings:\n";
+
+foreach my $test (@test_cases) {
+    my ($source, $target, $expected, $description) = @$test;
+    my $result = are_buddy_strings($source, $target);
+    my $status = ($result == $expected) ? "OK" : "ERROR";
+
+    printf "%s Source: %-6s Target: %-6s => %s (Expected: %s)  %s\n"
+           , $status, "\"$source\"", "\"$target\""
+           , $result ? "true" : "false"
+           , $expected ? "true" : "false"
+           , $description
+           f;
+}
+
+# Command line testing
+if (@ARGV >= 2) {
+    say "\nCommand line test:";
+    my $result = are_buddy_strings($ARGV[0], $ARGV[1]);
+    say "Source: \"$ARGV[0]\", Target: \"$ARGV[1]\" => " . ($result ? "true" : "false");
+}