Add Perl solution

5 files changed, 132 insertions, 0 deletions

diff --git a/challenge-215/paulo-custodio/Makefile b/challenge-215/paulo-custodio/Makefile
new file mode 100644
index 0000000000..c3c762d746
--- /dev/null
+++ b/challenge-215/paulo-custodio/Makefile
@@ -0,0 +1,2 @@
+all:
+	perl ../../challenge-001/paulo-custodio/test.pl
diff --git a/challenge-215/paulo-custodio/perl/ch-1.pl b/challenge-215/paulo-custodio/perl/ch-1.pl
new file mode 100644
index 0000000000..04e13da339
--- /dev/null
+++ b/challenge-215/paulo-custodio/perl/ch-1.pl
@@ -0,0 +1,47 @@
+#!/usr/bin/perl
+
+# Challenge 215
+#
+# Task 1: Odd one Out
+# Submitted by: Mohammad S Anwar
+#
+# You are given a list of words (alphabetic characters only) of same size.
+#
+# Write a script to remove all words not sorted alphabetically and print
+# the number of words in the list that are not alphabetically sorted.
+#
+# Example 1
+#
+# Input: @words = ('abc', 'xyz', 'tsu')
+# Output: 1
+#
+# The words 'abc' and 'xyz' are sorted and can't be removed.
+# The word 'tsu' is not sorted and hence can be removed.
+#
+# Example 2
+#
+# Input: @words = ('rat', 'cab', 'dad')
+# Output: 3
+#
+# None of the words in the given list are sorted.
+# Therefore all three needs to be removed.
+#
+# Example 3
+#
+# Input: @words = ('x', 'y', 'z')
+# Output: 0
+
+use Modern::Perl;
+
+sub is_sorted {
+    my($str) = @_;
+    my $sorted = join '', sort {$a cmp $b} split //, $str;
+    return $str eq $sorted;
+}
+
+sub odd_out {
+    my(@in) = @_;
+    return scalar(grep {!is_sorted($_)} @in);
+}
+
+say odd_out(@ARGV);
diff --git a/challenge-215/paulo-custodio/perl/ch-2.pl b/challenge-215/paulo-custodio/perl/ch-2.pl
new file mode 100644
index 0000000000..9a55f27be1
--- /dev/null
+++ b/challenge-215/paulo-custodio/perl/ch-2.pl
@@ -0,0 +1,53 @@
+#!/usr/bin/perl
+
+# Challenge 215
+#
+# Task 2: Number Placement
+# Submitted by: Mohammad S Anwar
+#
+# You are given a list of numbers having just 0 and 1. You are also given
+# placement count (>=1).
+#
+# Write a script to find out if it is possible to replace 0 with 1 in the
+# given list. The only condition is that you can only replace when there
+# is no 1 on either side. Print 1 if it is possible otherwise 0.
+# Example 1:
+#
+# Input: @numbers = (1,0,0,0,1), $count = 1
+# Output: 1
+#
+# You are asked to replace only one 0 as given count is 1.
+# We can easily replace middle 0 in the list i.e. (1,0,1,0,1).
+#
+# Example 2:
+#
+# Input: @numbers = (1,0,0,0,1), $count = 2
+# Output: 0
+#
+# You are asked to replace two 0's as given count is 2.
+# It is impossible to replace two 0's.
+#
+# Example 3:
+#
+# Input: @numbers = (1,0,0,0,0,0,0,0,1), $count = 3
+# Output: 1
+
+use Modern::Perl;
+
+sub can_place {
+    my($nums, $count) = @_;
+    my $str = join '', @$nums;
+    for (1 .. $count) {
+        if (!($str =~ s/000/010/)) {
+            return 0;
+        }
+    }
+    return 1;
+}
+
+@ARGV==2 or die "usage: ch-2.pl 1,0,... n\n";
+my @nums = split /,/, shift;
+my $count = shift;
+say can_place(\@nums, $count);
+
+
diff --git a/challenge-215/paulo-custodio/t/test-1.yaml b/challenge-215/paulo-custodio/t/test-1.yaml
new file mode 100644
index 0000000000..6c78cec738
--- /dev/null
+++ b/challenge-215/paulo-custodio/t/test-1.yaml
@@ -0,0 +1,15 @@
+- setup:
+  cleanup:
+  args:     abc xyz tsu
+  input:
+  output:   1
+- setup:
+  cleanup:
+  args:     rat cab dad
+  input:
+  output:   3
+- setup:
+  cleanup:
+  args:     x y z
+  input:
+  output:   0
diff --git a/challenge-215/paulo-custodio/t/test-2.yaml b/challenge-215/paulo-custodio/t/test-2.yaml
new file mode 100644
index 0000000000..b3a794a3b1
--- /dev/null
+++ b/challenge-215/paulo-custodio/t/test-2.yaml
@@ -0,0 +1,15 @@
+- setup:
+  cleanup:
+  args:     1,0,0,0,1  1
+  input:
+  output:   1
+- setup:
+  cleanup:
+  args:     1,0,0,0,1  2
+  input:
+  output:   0
+- setup:
+  cleanup:
+  args:     1,0,0,0,0,0,0,0,1  3
+  input:
+  output:   1