2 files changed, 143 insertions, 0 deletions
diff --git a/challenge-333/wanderdoc/perl/ch-1.pl b/challenge-333/wanderdoc/perl/ch-1.pl
new file mode 100644
index 0000000000..90077baddc
--- /dev/null
+++ b/challenge-333/wanderdoc/perl/ch-1.pl
@@ -0,0 +1,68 @@
+#!perl
+use strict;
+use warnings FATAL => qw(all);
+
+=prompt
+You are given a list of co-ordinates.
+Write a script to find out if the given points make a straight line.
+
+Example 1
+
+Input: @list = ([2, 1], [2, 3], [2, 5])
+Output: true
+
+
+Example 2
+
+Input: @list = ([1, 4], [3, 4], [10, 4])
+Output: true
+
+
+Example 3
+
+Input: @list = ([0, 0], [1, 1], [2, 3])
+Output: false
+
+
+Example 4
+
+Input: @list = ([1, 1], [1, 1], [1, 1])
+Output: true
+
+
+Example 5
+
+Input: @list = ([1000000, 1000000], [2000000, 2000000], [3000000, 3000000])
+Output: true
+=cut
+
+
+
+use constant { true => 1, false => 0 };
+use Test2::V0 -no_srand => 1;
+
+is(is_straight_line([2, 1], [2, 3], [2, 6]), true, 'Example 1');
+is(is_straight_line([1, 4], [3, 4], [10, 4]), true, 'Example 2');
+is(is_straight_line([0, 0], [1, 1], [2, 3]), false, 'Example 3');
+is(is_straight_line([1, 1], [1, 1], [1, 1]), true, 'Example 4');
+is(is_straight_line([1000000, 1000000], [2000000, 2000000], [3000000, 3000000]), true, 'Example 5');
+done_testing();
+
+sub is_straight_line
+{
+     my @arr = @_;
+     return 
+          (
+               ($arr[0][0] == $arr[1][0] and $arr[0][0] == $arr[2][0])
+               or
+               ($arr[0][1] == $arr[1][1] and $arr[0][1] == $arr[2][1])
+               or
+               (
+               (($arr[1][0] - $arr[0][0]) == ($arr[2][0] - $arr[1][0]))
+                    and
+               (($arr[1][1] - $arr[0][1]) == ($arr[2][1] - $arr[1][1]))
+               )
+          )
+          ? true
+          : false;
+}
diff --git a/challenge-333/wanderdoc/perl/ch-2.pl b/challenge-333/wanderdoc/perl/ch-2.pl
new file mode 100644
index 0000000000..00e3311b0d
--- /dev/null
+++ b/challenge-333/wanderdoc/perl/ch-2.pl
@@ -0,0 +1,75 @@
+#!perl
+use strict;
+use warnings FATAL => qw(all);
+
+=prompt
+You are given an array of integers.
+Write a script to duplicate each occurrence of zero, shifting the remaining elements to the right. The elements beyond the length of the original array are not written.
+
+Example 1
+
+Input: @ints = (1, 0, 2, 3, 0, 4, 5, 0)
+Output: (1, 0, 0, 2, 3, 0, 0, 4)
+
+Each zero is duplicated.
+Elements beyond the original length (like 5 and last 0) are discarded.
+
+
+Example 2
+
+Input: @ints = (1, 2, 3)
+Output: (1, 2, 3)
+
+No zeros exist, so the array remains unchanged.
+
+
+Example 3
+
+Input: @ints = (1, 2, 3, 0)
+Output: (1, 2, 3, 0)
+
+
+Example 4
+
+Input: @ints = (0, 0, 1, 2)
+Output: (0, 0, 0, 0)
+
+
+Example 5
+
+Input: @ints = (1, 2, 0, 3, 4)
+Output: (1, 2, 0, 0, 3)
+=cut
+
+use Test2::V0 -no_srand => 1;
+is([duplicate_zeroes(1, 0, 2, 3, 0, 4, 5, 0)], [1, 0, 0, 2, 3, 0, 0, 4], 'Example 1');
+is([duplicate_zeroes(1, 2, 3)], [1, 2, 3], 'Example 2');
+is([duplicate_zeroes(1, 2, 3, 0)], [1, 2, 3, 0], 'Example 3');
+is([duplicate_zeroes(0, 0, 1, 2)], [0, 0, 0, 0], 'Example 4');
+is([duplicate_zeroes(1, 2, 0, 3, 4)], [1, 2, 0, 0, 3], 'Example 1');
+done_testing();
+
+
+# use Data::Dump;
+
+sub duplicate_zeroes
+{
+     my @arr = @_;
+     my $cursor = 0;
+     my $last_elm = $#arr;
+     
+     while ( $cursor <= $last_elm )
+     {
+          if ($arr[$cursor] != 0)
+          {
+               $cursor++;
+          }
+     
+          else
+          {
+               splice(@arr, $cursor, 0, 0);
+               $cursor += 2;
+          }
+     }
+     return @arr[0 .. $last_elm];
+}