2 files changed, 140 insertions, 0 deletions
diff --git a/challenge-341/spadacciniweb/perl/ch-1.pl b/challenge-341/spadacciniweb/perl/ch-1.pl
new file mode 100644
index 0000000000..083096b089
--- /dev/null
+++ b/challenge-341/spadacciniweb/perl/ch-1.pl
@@ -0,0 +1,72 @@
+#!/usr/bin/env perl
+
+# Task 1: Broken Keyboard
+# Submitted by: Mohammad Sajid Anwar
+# 
+# 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
+# 
+# With broken key 'd', we can only type the word 'Hello'.
+# 
+# Example 2
+# Input: $str = 'apple banana cherry', @keys = ('a', 'e')
+# Output: 0
+# 
+# Example 3
+# Input: $str = 'Coding is fun', @keys = ()
+# Output: 3
+# 
+# No keys broken.
+# 
+# Example 4
+# Input: $str = 'The Weekly Challenge', @keys = ('a','b')
+# Output: 3
+# 
+# Example 5
+# Input: $str = 'Perl and Python', @keys = ('p')
+# Output: 1
+
+use strict;
+use warnings;
+
+my $str = 'Hello World'; my @keys = ('d');
+broken_keyboard($str, \@keys);
+
+$str = 'apple banana cherry'; @keys = ('a', 'e');
+broken_keyboard($str, \@keys);
+# 
+$str = 'Coding is fun'; @keys = ();
+broken_keyboard($str, \@keys);
+
+$str = 'The Weekly Challenge'; @keys = ('a','b');
+broken_keyboard($str, \@keys);
+
+$str = 'Perl and Python'; @keys = ('p');
+broken_keyboard($str, \@keys);
+
+exit 0;
+
+sub broken_keyboard {
+    my $str = shift;
+    my $keys = shift;
+
+    my %words = map { $_ => 0 }
+                  split / /, $str;
+    foreach my $word (%words) {
+        next if $words{ $word };
+        foreach my $key (@$keys) {
+            if ($word =~ /$key/i) {
+                $words{ $word } += 1;
+                last;
+            }
+        }
+    }
+
+    printf "'%s' (%s) -> %d\n", $str,
+                                (join ', ', map { sprintf "'$_'" } @$keys),
+                                (scalar keys %words) - (scalar grep { $_ } values %words);
+}
diff --git a/challenge-341/spadacciniweb/perl/ch-2.pl b/challenge-341/spadacciniweb/perl/ch-2.pl
new file mode 100644
index 0000000000..f0886bd5cb
--- /dev/null
+++ b/challenge-341/spadacciniweb/perl/ch-2.pl
@@ -0,0 +1,68 @@
+#!/usr/bin/env perl
+
+# Task 2: Reverse Prefix
+# Submitted by: Mohammad Sajid Anwar
+# 
+# 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: "gorpmming"
+# 
+# Reverse of prefix "prog" is "gorp".
+# 
+# Example 2
+# Input: $str = "hello", $char = "h"
+# Output: "hello"
+# 
+# Example 3
+# Input: $str = "abcdefghij", $char = "h"
+# Output: "hgfedcbaj"
+# 
+# Example 4
+# Input: $str = "reverse", $char = "s"
+# Output: "srevere"
+# 
+# Example 5
+# Input: $str = "perl", $char = "r"
+# Output: "repl"
+
+use strict;
+use warnings;
+
+my $str = "programming"; my $char = "g";
+reverse_prefix( $str, $char );
+
+$str = "hello", $char = "h";
+reverse_prefix( $str, $char );
+
+$str = "abcdefghij"; $char = "h";
+reverse_prefix( $str, $char );
+
+$str = "reverse"; $char = "s";
+reverse_prefix( $str, $char );
+
+$str = "perl"; $char = "r";
+reverse_prefix( $str, $char );
+
+exit 0;
+
+sub reverse_prefix {
+    my $str = shift;
+    my $char = shift;
+
+    my @str = split //, $str;
+    my $new_str = '';
+    foreach (1 .. length($str)) {
+        my $letter = shift @str;
+        $new_str .= $letter;
+        if ($letter eq $char) {
+            $new_str = reverse $new_str;
+            last;
+        }
+    }
+    $new_str .= join '', @str;
+
+    printf "'%s' '%s' -> '%s'\n", $str, $char, $new_str;
+}