RogerBW's Blog

I've been doing the Perl Weekly Challenges. This one was to implement the Ackermann function and parse URLs.

The Ackermann function is famously prone to huge numbers, so I restricted my demonstration to the useful values. Even so, let's pretend we can do it properly:

use Memoize;
memoize('ackermann');
use Math::BigInt;

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));
  }
}

As a programming exercise, this is mostly a case of "be careful what you wish for". I didn't dig into further optimisations, because the results aren't actually useful for anything…

For the URL parser I decided to use named captures, since I haven't done much with them before.

sub urlparse {
  my ($url)=@_;
  my %match;

Most, but not all, URLs have a // to set off scheme from other content. I'm trying to be universal, so let's parse them first. Path, query and fragment are kept back unparsed for later consideration.

Note the double-parenthesising: an outer non-capturing pattern with the set-off characters (like the @ after userinfo), and an inner capturing pattern to catch the actual useful bits.

Note also that I have to catch the named patterns %+ into a normal hash before %+ goes out of scope at the end of the block.

  if ($url =~ m!//!) {
    $url =~ m!^(?<scheme>.*?)://(?:(?:(?<userinfo>.*)@)?(?<host>[-_a-z0-9]+)(?::(?<port>[0-9]+))?)?(?<pqf>.*)!;
    map {$match{$_}=$+{$_}} keys %+;

If there's no //, break on the last colon: everything before is scheme, everything after is path/query/fragment. (I didn't even know this was valid, but apparently so.)

  } else {
    $url =~ m!^(?<scheme>.*):(?<pqf>[^:]*)!;
    map {$match{$_}=$+{$_}} keys %+;
  }

Then take the path-query-fragment, parse it into its component bits, and delete the raw data.

  $match{pqf} =~ m!(?<path>[^?#]*)(?:\?(?<query>[^#]*))?(?:\#(?<fragment>.*))?$!;
  map {$match{$_}=$+{$_}} keys %+;
  delete $match{pqf};
  return \%match;
}