Add Perl solution to challenge 012

4 files changed, 129 insertions, 0 deletions

diff --git a/challenge-012/paulo-custodio/README b/challenge-012/paulo-custodio/README
new file mode 100644
index 0000000000..87dc0b2fbd
--- /dev/null
+++ b/challenge-012/paulo-custodio/README
@@ -0,0 +1 @@
+Solution by Paulo Custodio
diff --git a/challenge-012/paulo-custodio/perl/ch-1.pl b/challenge-012/paulo-custodio/perl/ch-1.pl
new file mode 100644
index 0000000000..0bd11f659d
--- /dev/null
+++ b/challenge-012/paulo-custodio/perl/ch-1.pl
@@ -0,0 +1,30 @@
+#!/usr/bin/env perl
+
+# Challenge 012
+#
+# Challenge #1
+# The numbers formed by adding one to the products of the smallest primes are
+# called the Euclid Numbers (see wiki). Write a script that finds the smallest
+# Euclid Number that is not prime. This challenge was proposed by 
+# Laurent Rosenfeld.
+
+use strict;
+use warnings;
+use 5.030;
+use Math::Prime::Util 'next_prime', 'is_prime';
+
+sub euclid_iter {
+	my $prime = 1;
+	my $prime_prod = 1;
+	return sub {
+		$prime = next_prime($prime);
+		$prime_prod *= $prime;
+		return $prime_prod+1;
+	};
+}
+
+my $iter = euclid_iter();
+my $p;
+1 while (is_prime($p = $iter->()));
+say $p;
+
diff --git a/challenge-012/paulo-custodio/perl/ch-2.pl b/challenge-012/paulo-custodio/perl/ch-2.pl
new file mode 100644
index 0000000000..c95573cecb
--- /dev/null
+++ b/challenge-012/paulo-custodio/perl/ch-2.pl
@@ -0,0 +1,61 @@
+#!/usr/bin/env perl
+
+# Challenge 012
+#
+# Challenge #2
+# Write a script that finds the common directory path, given a collection of
+# paths and directory separator. For example, if the following paths are
+# supplied.
+# /a/b/c/d
+# /a/b/cd
+# /a/b/cc
+# /a/b/c/d/e
+# and the path separator is /. Your script should return /a/b as common 
+# directory path.
+
+use strict;
+use warnings;
+use 5.030;
+
+use Data::Dump 'dump';
+
+# extract a common prefix, if one exists
+sub extract_common_prefix {
+	my($paths) = @_;
+	
+	# check if all paths have the same prefix
+	my $dir;
+	for my $i (0 .. $#{$paths}) {
+		return unless @{$paths->[$i]};				# path empty
+		if ($i == 0) {
+			$dir = $paths->[$i][0];					# first path
+		}
+		else {
+			return unless $dir eq $paths->[$i][0];	# not same prefix
+		}
+	}
+	
+	# all have $dir prefix, shift if out
+	shift @$_ for (@$paths);
+	
+	return $dir;
+}	
+			
+sub common_prefix {
+	my($sep, @paths) = @_;
+	
+	# split paths by separator
+	@paths = map {$_ = [split($sep, $_)]} @paths;
+
+	# find common prefix
+	my @prefix;
+	while (defined(my $dir = extract_common_prefix(\@paths))) {
+		push @prefix, $dir;
+	}
+	
+	return join($sep, @prefix);
+}
+
+			
+my($sep, @paths) = @ARGV;
+say common_prefix($sep, @paths);
diff --git a/challenge-012/paulo-custodio/test.pl b/challenge-012/paulo-custodio/test.pl
new file mode 100644
index 0000000000..764f4bf5b1
--- /dev/null
+++ b/challenge-012/paulo-custodio/test.pl
@@ -0,0 +1,37 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use 5.030;
+use Test::More;
+
+is capture("perl perl/ch-1.pl"), "30031\n";
+
+is capture("perl perl/ch-2.pl /          ".
+							" /a/b/c/d   ".
+							" /a/b/cd    ".
+							" /a/b/cc    ".
+							" /a/b/c/d/e "), "/a/b\n";
+
+is capture("perl perl/ch-2.pl :          ".
+							" :a:b:c:d   ".
+							" :a:b:cd    ".
+							" :a:b:cc    ".
+							" :a:b:c:d:e "), ":a:b\n";
+
+is capture("perl perl/ch-2.pl /          ".
+							" /b/c/d     ".
+							" /a/b/c/d   ".
+							" /a/b/cd    ".
+							" /a/b/cc    ".
+							" /a/b/c/d/e "), "\n";
+
+done_testing;
+
+
+sub capture {
+	my($cmd) = @_;
+	my $out = `$cmd`;
+	$out =~ s/[ \r\t]*\n/\n/g;
+	return $out;
+}