Merge branch 'master' of https://github.com/manwar/perlweeklychallenge-club

2 files changed, 128 insertions, 0 deletions

diff --git a/challenge-017/daniel-mantovani/perl5/ch-1.pl b/challenge-017/daniel-mantovani/perl5/ch-1.pl
new file mode 100644
index 0000000000..98dec8c756
--- /dev/null
+++ b/challenge-017/daniel-mantovani/perl5/ch-1.pl
@@ -0,0 +1,58 @@
+# Create a script to demonstrate Ackermann function.
+# The Ackermann function is defined as below, m and n are positive number:
+
+#   A(m, n) = n + 1                  if m = 0
+#   A(m, n) = A(m - 1, 1)            if m > 0 and n = 0
+#   A(m, n) = A(m - 1, A(m, n - 1))  if m > 0 and n > 0
+# Example expansions as shown in wiki page.
+
+#  A(1, 2) = A(0, A(1, 1))
+#          = A(0, A(0, A(1, 0)))
+#          = A(0, A(0, A(0, 1)))
+#          = A(0, A(0, 2))
+#          = A(0, 3)
+#          = 4
+
+use strict;
+use warnings;
+use v5.10;
+
+# pretty straightforward, we can just translate definitions to a (recursive)
+# perl function:
+
+# sub A {
+#     my ( $m, $n ) = @_;
+#     if ( $m == 0 ) { return $n + 1 }
+#     elsif ( $m > 0 && $n == 0 ) { return A( $m - 1, 1 ) }
+#     elsif ( $m > 0 && $n > 0 ) { return A( $m - 1, A( $m, $n - 1 ) ) }
+#     else {
+#         die "m ($m) and n ($n) are not a valid input for Ackermann function";
+#     }
+# }
+
+# if we assume m and n are valid values, you can optimize a bit like this:
+
+sub A {
+    my ( $m, $n ) = @_;
+    return $n + 1 unless $m;
+    return A( $m - 1, 1 ) unless $n;
+    return A( $m - 1, A( $m, $n - 1 ) );
+}
+
+my ( $m, $n ) = @ARGV;
+
+die "Usage: perl $0 <m> <n>\nwith <n> and <n> 0 or positive integers"
+  unless defined $m
+  && $m =~ /^\d+$/
+  && defined $n
+  && $n =~ /^\d+$/;
+
+say A( $m, $n );
+
+# note that Ackermann function is higly recursive, and even for small m & n numbers
+# will make perl default configuration for recursive functions fail
+# for example, A(3,4) is known to be 125 (2 ^ 7 - 3), and in my
+# computer it gives a "Deep recursion" warning, despite getting the
+# correct (125) value at the end.
+#
+# This proposed solution is valid to answer corresponding perl weekly's challenge only
diff --git a/challenge-017/daniel-mantovani/perl5/ch-2.pl b/challenge-017/daniel-mantovani/perl5/ch-2.pl
new file mode 100644
index 0000000000..da1efc32ac
--- /dev/null
+++ b/challenge-017/daniel-mantovani/perl5/ch-2.pl
@@ -0,0 +1,70 @@
+# Create a script to parse URL and print the components of URL.
+# According to Wiki page, the URL syntax is as below:
+
+# scheme:[//[userinfo@]host[:port]]path[?query][#fragment]
+
+# For example: jdbc://user:password@localhost:3306/pwc?profile=true#h1
+
+#   scheme:   jdbc
+#   userinfo: user:password
+#   host:     localhost
+#   port:     3306
+#   path:     /pwc
+#   query:    profile=true
+#   fragment: h1
+
+use strict;
+use warnings;
+use v5.10;
+
+my $url = shift;
+die "Usage: perl $0 <url>" unless $url;
+
+my ( $scheme, $userinfo, $host, $port, $path, $query, $fragment );
+
+# instead of using a big regex, we will try to match every part of
+# URIs definition in https://en.wikipedia.org/wiki/URL
+#
+my $remaining = $url;
+
+# first we extract the scheme part:
+
+die "missing scheme in $url" unless $remaining =~ s/^([a-z][a-z\d+\.\-]*)://;
+$scheme = $1;
+
+# note that $remaining here will not have the scheme part anymore
+
+# now we extract the optional authority component preceded by
+# two slashes (//), and followed by an optional slash (/):
+# so we capture all consecutive non slash characters on $1,
+# and then extract userinfo, host and port:
+
+if ( $remaining =~ s/^\/\/([^\/]*)// ) {
+    my $remaining_authority = $1;
+    $userinfo = $1 if $remaining_authority =~ s/(.*?)\@//;
+    ( $host, $port ) = split /:/, $remaining_authority;
+}
+
+# now we extract path as all consecutive non '?' nor '#' character
+# starting at begining of $remaining:
+
+$path = $1 if ( $remaining =~ s/^([^\?#]*)// );
+
+# now we extract query as all consecutive non '#' chars starting after
+# initial "?" char
+
+$query = $1 if ( $remaining =~ s/^\?([^#]*)// );
+
+# and the rest (excluding initial '#' char if any), is fragment:
+
+$fragment = $1 if $remaining =~ /^#(.*)/;
+
+# now we just print every existing component:
+
+say "scheme: $scheme";
+say "userinfo: $userinfo" if $userinfo;
+say "host: $host"         if $host;
+say "port: $port"         if $port;
+say "path: $path"         if $path;
+say "query: $query"       if $query;
+say "fragment: $fragment" if $fragment;