2 files changed, 166 insertions, 0 deletions
diff --git a/challenge-203/peter-meszaros/perl/ch-1.pl b/challenge-203/peter-meszaros/perl/ch-1.pl
new file mode 100755
index 0000000000..04896d328c
--- /dev/null
+++ b/challenge-203/peter-meszaros/perl/ch-1.pl
@@ -0,0 +1,71 @@
+#!/usr/bin/env perl
+#
+=head1 Task 1: Special Quadruplets
+
+Submitted by: Mohammad S Anwar
+
+You are given an array of integers.
+
+Write a script to find out the total special quadruplets for the given array.
+
+Special Quadruplets are such that satisfies the following 2 rules.
+
+    1) nums[a] + nums[b] + nums[c] == nums[d]
+    2) a < b < c < d
+
+=head2 Example 1
+
+    Input: @nums = (1,2,3,6)
+    Output: 1
+
+    Since the only special quadruplets found is
+    $nums[0] + $nums[1] + $nums[2] == $nums[3].
+
+=head2 Example 2
+
+    Input: @nums = (1,1,1,3,5)
+    Output: 4
+
+    $nums[0] + $nums[1] + $nums[2] == $nums[3]
+    $nums[0] + $nums[1] + $nums[3] == $nums[4]
+    $nums[0] + $nums[2] + $nums[3] == $nums[4]
+    $nums[1] + $nums[2] + $nums[3] == $nums[4]
+
+=head2 Example 3
+
+    Input: @nums = (3,3,6,4,5)
+    Output: 0
+
+=cut
+
+use strict;
+use warnings;
+use Test2::V0 -no_srand => 1;
+use Data::Dumper;
+use Algorithm::Combinatorics qw/combinations/;
+
+
+my $cases = [
+    [[1, 2, 3, 6],    1, 'Example 1'],
+    [[1, 1, 1, 3, 5], 4, 'Example 2'],
+    [[3, 3, 6, 4, 5], 0, 'Example 3'],
+];
+
+sub special_quadruples
+{
+    my $l = shift;
+
+    my $cnt = 0;
+    my $iter = combinations($l, 4);
+    while (my $c = $iter->next) {
+        ++$cnt if ($c->[0] + $c->[1] + $c->[2]) == $c->[3];
+    }
+    return $cnt;
+}
+
+for (@$cases) {
+    is(special_quadruples($_->[0]), $_->[1], $_->[2]);
+}
+done_testing();
+
+exit 0;
diff --git a/challenge-203/peter-meszaros/perl/ch-2.pl b/challenge-203/peter-meszaros/perl/ch-2.pl
new file mode 100755
index 0000000000..40df6363d6
--- /dev/null
+++ b/challenge-203/peter-meszaros/perl/ch-2.pl
@@ -0,0 +1,95 @@
+#!/usr/bin/env perl
+#
+=head1 Task 2: Copy Directory
+
+Submitted by: Julien Fiegehenn
+
+You are given path to two folders, $source and $target.
+
+Write a script that recursively copy the directory from $source to $target
+except any files.
+
+=head2 Example
+
+    Input: $source = '/a/b/c' and $target = '/x/y'
+
+    Source directory structure:
+
+    +-- a
+    |   +-- b
+    |       +-- c
+    |           |-- 1
+    |           |   +-- 1.txt
+    |           |-- 2
+    |           |   +-- 2.txt
+    |           |-- 3
+    |           |   +-- 3.txt
+    |           |-- 4
+    |           |-- 5
+    |               +-- 5.txt
+
+    Target directory structure:
+
+    +-- x
+    |   +-- y
+
+    Expected Result:
+
+    +-- x
+    |   +-- y
+    |       |-- 1
+    |       |-- 2
+    |       |-- 3
+    |       |-- 4
+    |       |-- 5
+
+=cut
+
+use strict;
+use warnings;
+use Test2::V0 -no_srand => 1;
+use Data::Dumper;
+use File::Find;
+use File::Path qw/make_path/;
+use Cwd qw/cwd/;
+
+my $cases = [
+    [['/a/b/c', '/x/y'], 1, 'Example 1'],
+];
+
+sub copy_directory
+{
+    my $source = '.' . $_[0]->[0];
+    my $target = '.' . $_[0]->[1];
+
+    my $dir = cwd;
+    find(sub 
+        {
+           my $path = $File::Find::name;
+           if (-d) {
+               $path =~ s!^$source!$target!;
+               $path = "$dir/$path";
+               make_path($path) || die "mkdir $path failed: $!\n";;
+           }
+        },
+        $source);
+
+    print `find $target`, "\n";
+    return 1;
+}
+
+`rm -rf x a`;
+`mkdir -p a/b/c/1 a/b/c/2 a/b/c/3 a/b/c/4 a/b/c/5/8`;
+`touch a/b/c/1/1.txt`;
+`touch a/b/c/2/2.txt`;
+`touch a/b/c/3/3.txt`;
+`touch a/b/c/5/5.txt`;
+
+for (@$cases) {
+    is(copy_directory($_->[0]), $_->[1], $_->[2]);
+}
+done_testing();
+
+`rm -rf x a`;
+
+exit 0;