2 files changed, 77 insertions, 0 deletions
diff --git a/challenge-017/roger-bell-west/perl5/1.pl b/challenge-017/roger-bell-west/perl5/1.pl
new file mode 100755
index 0000000000..16a32c8a8b
--- /dev/null
+++ b/challenge-017/roger-bell-west/perl5/1.pl
@@ -0,0 +1,51 @@
+#! /usr/bin/perl
+
+use strict;
+use warnings;
+
+use Memoize;
+memoize('ackermann');
+use Math::BigInt;
+
+my @r;
+$r[0][0]='m/n';
+foreach my $m (0..3) {
+  $r[$m+1][0]=$m;
+  foreach my $n (0..4) {
+    $r[0][$n+1]||=$n;
+    $r[$m+1][$n+1]=ackermann(Math::BigInt->new($m),Math::BigInt->new($n));
+  }
+}
+
+print tabular(\@r);
+
+sub ackermann {
+  no warnings 'recursion';
+  my ($m,$n)=@_;
+  if ($m==0) {
+    return $n+1;
+  } elsif ($n==0) {
+    return ackermann($m-1,1);
+  } else {
+    return ackermann($m-1,ackermann($m,$n-1));
+  }
+}
+
+sub tabular {
+  my $d=shift;
+  my @columnlength;
+  foreach my $row (@{$d}) {
+    foreach my $colno (0..$#{$row}) {
+      if (!defined($columnlength[$colno]) ||
+          $columnlength[$colno] < length($row->[$colno])) {
+        $columnlength[$colno]=length($row->[$colno]);
+      }
+    }
+  }
+  my $format=join('  ',map {"%${_}s"} @columnlength);
+  my $result='';
+  foreach my $row (@{$d}) {
+    $result .= sprintf($format,@{$row})."\n";
+  }
+  return $result;
+}
diff --git a/challenge-017/roger-bell-west/perl5/2.pl b/challenge-017/roger-bell-west/perl5/2.pl
new file mode 100755
index 0000000000..9d0e3ab989
--- /dev/null
+++ b/challenge-017/roger-bell-west/perl5/2.pl
@@ -0,0 +1,26 @@
+#! /usr/bin/perl
+
+use strict;
+use warnings;
+use YAML::XS qw(Dump);
+
+foreach my $url (@ARGV) {
+  print Dump(urlparse($url));
+}
+
+sub urlparse {
+  my ($url)=@_;
+  my %match;
+  if ($url =~ m!//!) {
+    $url =~ m!^(?<scheme>.*?)://(?:(?:(?<userinfo>.*)@)?(?<host>[-_a-z0-9]+)(?::(?<port>[0-9]+))?)?(?<pqf>.*)!;
+    map {$match{$_}=$+{$_}} keys %+;
+  } else { # if no userinfo-host-port component, split on the last colon
+    $url =~ m!^(?<scheme>.*):(?<pqf>[^:]*)!;
+    map {$match{$_}=$+{$_}} keys %+;
+  }
+  $match{pqf} =~ m!(?<path>[^?#]*)(?:\?(?<query>[^#]*))?(?:\#(?<fragment>.*))?$!;
+  map {$match{$_}=$+{$_}} keys %+;
+  delete $match{pqf};
+  return \%match;
+}
+