Add Perl solution

6 files changed, 168 insertions, 2 deletions

diff --git a/challenge-198/paulo-custodio/perl/ch-1.pl b/challenge-198/paulo-custodio/perl/ch-1.pl
index 058b53b538..4c2ff16f3e 100644
--- a/challenge-198/paulo-custodio/perl/ch-1.pl
+++ b/challenge-198/paulo-custodio/perl/ch-1.pl
@@ -44,5 +44,3 @@ sub max_gap {
 @ARGV or die "usage: ch-1.pl nums\n";
 my @n=@ARGV;
 say max_gap(@n);
-
-
diff --git a/challenge-209/paulo-custodio/Makefile b/challenge-209/paulo-custodio/Makefile
new file mode 100644
index 0000000000..c3c762d746
--- /dev/null
+++ b/challenge-209/paulo-custodio/Makefile
@@ -0,0 +1,2 @@
+all:
+	perl ../../challenge-001/paulo-custodio/test.pl
diff --git a/challenge-209/paulo-custodio/perl/ch-1.pl b/challenge-209/paulo-custodio/perl/ch-1.pl
new file mode 100644
index 0000000000..15ed8e20b1
--- /dev/null
+++ b/challenge-209/paulo-custodio/perl/ch-1.pl
@@ -0,0 +1,52 @@
+#!/usr/bin/perl
+
+# Challenge 209
+#
+# Task 1: Special Bit Characters
+# Submitted by: Mohammad S Anwar
+#
+# You are given an array of binary bits that ends with 0.
+#
+# Valid sequences in the bit string are:
+#
+# [0] -decodes-to-> "a"
+# [1, 0] -> "b"
+# [1, 1] -> "c"
+#
+# Write a script to print 1 if the last character is an “a” otherwise print 0.
+# Example 1
+#
+# Input: @bits = (1, 0, 0)
+# Output: 1
+#
+# The given array bits can be decoded as 2-bits character (10) followed by
+# 1-bit character (0).
+#
+# Example 2
+#
+# Input: @bits = (1, 1, 1, 0)
+# Output: 0
+#
+# Possible decode can be 2-bits character (11) followed by 2-bits character
+# (10) i.e. the last character is not 1-bit character.
+
+use Modern::Perl;
+
+sub decode {
+    my($in) = @_;
+    my $out = "";
+    for ($in) {
+        while ($_ ne '') {
+            if    (s/^0//)  { $out .= "a"; }
+            elsif (s/^10//) { $out .= "b"; }
+            elsif (s/^11//) { $out .= "c"; }
+            else { die "invalid coded input: $in\n"; }
+        }
+    }
+    return $out;
+}
+
+@ARGV==1 or die "usage: ch-1.pl bits\n";
+my $in = shift;
+my $out = decode($in);
+say $out =~ /a$/ ? 1 : 0;
diff --git a/challenge-209/paulo-custodio/perl/ch-2.pl b/challenge-209/paulo-custodio/perl/ch-2.pl
new file mode 100644
index 0000000000..f034278adf
--- /dev/null
+++ b/challenge-209/paulo-custodio/perl/ch-2.pl
@@ -0,0 +1,89 @@
+#!/usr/bin/perl
+
+# Challenge 209
+#
+# Task 2: Merge Account
+# Submitted by: Mohammad S Anwar
+#
+# You are given an array of accounts i.e. name with list of email addresses.
+#
+# Write a script to merge the accounts where possible. The accounts can only
+# be merged if they have at least one email address in common.
+#
+# Example 1:
+#
+# Input: @accounts = [ ["A", "a1@a.com", "a2@a.com"],
+#                      ["B", "b1@b.com"],
+#                      ["A", "a3@a.com", "a1@a.com"] ]
+#                    ]
+#
+# Output: [ ["A", "a1@a.com", "a2@a.com", "a3@a.com"],
+#           ["B", "b1@b.com"] ]
+#
+# Example 2:
+#
+# Input: @accounts = [ ["A", "a1@a.com", "a2@a.com"],
+#                      ["B", "b1@b.com"],
+#                      ["A", "a3@a.com"],
+#                      ["B", "b2@b.com", "b1@b.com"] ]
+#
+# Output: [ ["A", "a1@a.com", "a2@a.com"],
+#           ["A", "a3@a.com"],
+#           ["B", "b1@b.com", "b2@b.com"] ]
+
+use Modern::Perl;
+
+sub parse_input {
+    my(@argv) = @_;
+    my @accounts;
+    my $i=0;
+    while ($i < @argv) {
+        my $j=$i;
+        while ($j < @argv && $argv[$j] ne ',') {
+            $j++;
+        }
+        push @accounts, [@argv[$i..$j-1]];
+        $i=$j+1;
+    }
+    return @accounts;
+}
+
+sub common_email {
+    my(@accounts)=@_;
+    my %mails;
+    for my $i (0..$#accounts) {
+        for my $j (1..$#{$accounts[$i]}) {
+            my $mail = $accounts[$i][$j];
+            if (exists $mails{$mail}) {
+                return ($mails{$mail}, $i);
+            }
+            else {
+                $mails{$mail}=$i;
+            }
+        }
+    }
+    return;
+}
+
+sub merge_accounts {
+    my(@accounts)=@_;
+    while (my($a,$b)=common_email(@accounts)) {
+        # merge a and b
+        my %mails;
+        for my $i (1..$#{$accounts[$a]}) { $mails{$accounts[$a][$i]}=1; }
+        for my $i (1..$#{$accounts[$b]}) { $mails{$accounts[$b][$i]}=1; }
+        $accounts[$a]=[$accounts[$a][0], sort keys %mails];
+        splice(@accounts,$b,1);
+    }
+    return @accounts;
+}
+
+sub print_accounts {
+    my(@accounts) = @_;
+    for (@accounts) {
+        say join(" ", @$_);
+    }
+}
+
+my @accounts=merge_accounts(parse_input(@ARGV));
+print_accounts(@accounts);
diff --git a/challenge-209/paulo-custodio/t/test-1.yaml b/challenge-209/paulo-custodio/t/test-1.yaml
new file mode 100644
index 0000000000..0cddc5dfde
--- /dev/null
+++ b/challenge-209/paulo-custodio/t/test-1.yaml
@@ -0,0 +1,10 @@
+- setup:
+  cleanup:
+  args:     100
+  input:
+  output:   1
+- setup:
+  cleanup:
+  args:     1110
+  input:
+  output:   0
diff --git a/challenge-209/paulo-custodio/t/test-2.yaml b/challenge-209/paulo-custodio/t/test-2.yaml
new file mode 100644
index 0000000000..fcdf5555f1
--- /dev/null
+++ b/challenge-209/paulo-custodio/t/test-2.yaml
@@ -0,0 +1,15 @@
+- setup:
+  cleanup:
+  args:     A a1@a.com a2@a.com , B b1@b.com , A a3@a.com a1@a.com
+  input:
+  output:   |
+            |A a1@a.com a2@a.com a3@a.com
+            |B b1@b.com
+- setup:
+  cleanup:
+  args:     A a1@a.com a2@a.com , B b1@b.com , A a3@a.com , B b2@b.com b1@b.com
+  input:
+  output:   |
+            |A a1@a.com a2@a.com
+            |B b1@b.com b2@b.com
+            |A a3@a.com