Merge pull request #398 from yzhernand/ch-017-yozen

Added solutions by Yozen Hernandez for challenges 1 and 2 for week 17

4 files changed, 229 insertions, 0 deletions

diff --git a/challenge-017/yozen-hernandez/blog.txt b/challenge-017/yozen-hernandez/blog.txt
new file mode 100644
index 0000000000..2714fc8129
--- /dev/null
+++ b/challenge-017/yozen-hernandez/blog.txt
@@ -0,0 +1 @@
+https://yzhernand.github.io/posts/perl-weekly-challenge-17-1/
diff --git a/challenge-017/yozen-hernandez/blog1.txt b/challenge-017/yozen-hernandez/blog1.txt
new file mode 100644
index 0000000000..a9c6f5165d
--- /dev/null
+++ b/challenge-017/yozen-hernandez/blog1.txt
@@ -0,0 +1 @@
+https://dev.to/yzhernand/perl-weekly-challenge-17-writing-our-own-url-parser-in-perl-but-should-we-20mm
diff --git a/challenge-017/yozen-hernandez/perl5/ch-1.pl b/challenge-017/yozen-hernandez/perl5/ch-1.pl
new file mode 100755
index 0000000000..ce754a4672
--- /dev/null
+++ b/challenge-017/yozen-hernandez/perl5/ch-1.pl
@@ -0,0 +1,70 @@
+#!/usr/bin/env perl
+
+use v5.24;
+use strict;
+use warnings;
+use feature qw(signatures);
+no warnings "experimental::signatures";
+use Carp;
+use Benchmark::Forking qw(cmpthese);
+use Memoize;
+
+=for comment
+
+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
+
+=cut
+
+memoize("A");
+
+sub A ( $m = 3, $n = 3) {
+    croak "Error: function only defined for nonnegative integers."
+        . "(got: m = $m, n = $n)"
+        if ( $m < 0 && $n < 0 );
+
+    # A(m, n) = n + 1                  if m = 0
+    return $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
+    return A( $m - 1, ($n == 0) ? 1 : A($m, $n-1) );
+}
+
+sub A_no_memo ( $m = 3, $n = 3 ) {
+    croak "Error: function only defined for nonnegative integers."
+        . "(got: m = $m, n = $n)"
+        if ( $m < 0 && $n < 0 );
+
+    # A(m, n) = n + 1                  if m = 0
+    return $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
+    return A( $m - 1, ($n == 0) ? 1 : A($m, $n-1) );
+}
+
+use Test::More tests => 5;
+ok(A(1,2) == 4, "A(1,2) == 4");
+ok(A(2,2) == 7, "A(2,2) == 7");
+ok(A(2,4) == 11, "A(2,4) == 11");
+ok(A(3,3) == 61, "A(3,3) == 61");
+ok(A(3,4) == 125, "A(3,4) == 125");
+
+=for comment
+
+cmpthese(
+    -10,
+    {   'memo'  => \&A,
+        'no_memo' => \&A_no_memo
+    }
+);
+
+            Rate no_memo    memo
+no_memo 269501/s      --    -68%
+memo    850801/s    216%      --
+
+=cut
\ No newline at end of file
diff --git a/challenge-017/yozen-hernandez/perl5/ch-2.pl b/challenge-017/yozen-hernandez/perl5/ch-2.pl
new file mode 100755
index 0000000000..c67d976456
--- /dev/null
+++ b/challenge-017/yozen-hernandez/perl5/ch-2.pl
@@ -0,0 +1,157 @@
+#!/usr/bin/env perl
+
+use v5.24;
+use strict;
+use warnings;
+use feature qw(signatures);
+no warnings "experimental::signatures";
+use Carp;
+use utf8;
+use open ':std', ':encoding(UTF-8)';
+
+=for comment
+
+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:mysql://user:password@localhost:3306/pwc?profile=true#h1
+
+  scheme:   jdbc:mysql
+  userinfo: user:password
+  host:     localhost
+  port:     3306
+  path:     /pwc
+  query:    profile=true
+  fragment: h1
+
+=cut
+
+sub parse_url_regex($url) {
+    my %parsed;
+
+    while ($url) {
+        if ( !exists $parsed{scheme} ) {
+            $url =~ s!^((?:[[:alnum:]]+:)?[[:alnum:]]+):!!;
+
+            # MUST start with the scheme, format: "scheme:"
+            croak "Invalid format: url must start with scheme." unless $1;
+            $parsed{scheme} = $1;
+
+            return \%parsed unless $url =~ s!^//!!;
+        }
+        elsif ( !exists( $parsed{host} )
+            && $url
+            =~ s!^(?:((?:[\d\w]+:)?(?:[\d\w]+)?)@)?([\d\w\.]+)(?::([\d]+))?!!u
+            )
+        {
+            $parsed{userinfo} = $1 // "";
+            $parsed{host} = $2 // "";
+            $parsed{port} = $3 // "";
+        }
+        elsif ( !exists( $parsed{path} )
+            && $url =~ s!^/((?:[\d\w\.\/]*)+)!!u )
+        {
+            $parsed{path} = "/" . ( $1 // "" );
+        }
+        elsif ( !exists( $parsed{query} )
+            && $url =~ s!^\?((?:[\d\w\[\]%\"\']+)=(?:[\d\w\[\]%\"\']+))*!!u )
+        {
+            $parsed{query} = $1 // "";
+        }
+        elsif ( !exists( $parsed{fragment} )
+            && $url =~ s!^#([\d\w\[\]%\"\']+)!!u )
+        {
+            $parsed{fragment} = $1 // "";
+        }
+        else {
+            croak "Error: Invalid URL? $url";
+        }
+    }
+
+    return \%parsed;
+}
+
+sub print_parsed ($url_hash_ref) {
+    for my $part (qw(scheme userinfo host port path query fragment)) {
+        say "$part:\t" . $url_hash_ref->{$part}
+            if exists $url_hash_ref->{$part}
+            && defined $url_hash_ref->{$part};
+    }
+    say "";
+}
+
+print_parsed(
+    parse_url_regex(
+        q"jdbc:mysql://user:password@localhost:3306/pwc?profile=true#h1")
+);
+print_parsed(
+    parse_url_regex(q"http://sri:foo@example.com:3000/foo?foo=bar#23") );
+print_parsed( parse_url_regex(q"https://example.com/") );
+print_parsed(
+    parse_url_regex(
+        q"http://JP納豆.例.jp:80/dir1/引き割り.html?q=クエリ#メイン"
+    )
+);
+
+use Mojo::URL;
+use Mojo::Util qw(decode url_unescape);
+
+use Test::More tests => 7;
+my $parsed_regex
+    = parse_url_regex(
+    q"http://JP納豆.例.jp:80/dir1/引き割り.html?q=クエリ#メイン"
+    );
+my $parsed_mojo
+    = Mojo::URL->new(
+    q"http://JP納豆.例.jp:80/dir1/引き割り.html?q=クエリ#メイン"
+    );
+is( $parsed_mojo->scheme,
+    $parsed_regex->{scheme},
+    "Mojo and regex sub agree on 'scheme'"
+);
+is( $parsed_mojo->userinfo // '',
+    $parsed_regex->{userinfo},
+    "Mojo and regex sub agree on 'userinfo'"
+);
+is( $parsed_mojo->host, $parsed_regex->{host},
+    "Mojo and regex sub agree on 'host'" );
+is( $parsed_mojo->port, $parsed_regex->{port},
+    "Mojo and regex sub agree on 'port'" );
+is( decode( 'UTF-8', url_unescape( $parsed_mojo->path ) ),
+    $parsed_regex->{path}, "Mojo and regex sub agree on 'path'" );
+is( decode( 'UTF-8', url_unescape( $parsed_mojo->query ) ),
+    $parsed_regex->{query},
+    "Mojo and regex sub agree on 'query'"
+);
+is( $parsed_mojo->fragment,
+    $parsed_regex->{fragment},
+    "Mojo and regex sub agree on 'fragment'"
+);
+
+use Benchmark::Forking qw(cmpthese);
+
+cmpthese(
+    -2,
+    {   from_scratch_regex => sub {
+            parse_url_regex(
+                q"http://JP納豆.例.jp:80/dir1/引き割り.html?q=クエリ#メイン"
+            );
+        },
+        mojo => sub {
+            Mojo::URL->new(
+                parse_url_regex(
+                    q"http://JP納豆.例.jp:80/dir1/引き割り.html?q=クエリ#メイン"
+                )
+            );
+        }
+    }
+);
+
+=for comment
+
+                       Rate               mojo from_scratch_regex
+mojo                31204/s                 --               -72%
+from_scratch_regex 110892/s               255%                 --
+
+=cut