aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--challenge-017/athanasius/perl5/ch-1.pl83
-rw-r--r--challenge-017/athanasius/perl5/ch-2.pl156
-rw-r--r--challenge-017/athanasius/perl6/ch-1.p671
-rw-r--r--challenge-017/athanasius/perl6/ch-2.p6157
4 files changed, 467 insertions, 0 deletions
diff --git a/challenge-017/athanasius/perl5/ch-1.pl b/challenge-017/athanasius/perl5/ch-1.pl
new file mode 100644
index 0000000000..797da48cd4
--- /dev/null
+++ b/challenge-017/athanasius/perl5/ch-1.pl
@@ -0,0 +1,83 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 017
+=========================
+
+Task #1
+-------
+
+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
+[ https://en.wikipedia.org/wiki/Ackermann_function |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
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2019 PerlMonk Athanasius #
+#--------------------------------------#
+
+use strict;
+use warnings;
+use Const::Fast;
+use Getopt::Long;
+use Memoize;
+
+const my @DEFAULT => (1, 2);
+
+my $recs;
+
+MAIN:
+{
+ $recs = 0;
+ my ($m, $n) = @DEFAULT;
+ my $mem = 0;
+
+ GetOptions
+ (
+ 'm=i' => \$m,
+ 'n=i' => \$n,
+ memoize => \$mem,
+
+ ) or die "\nError in command line arguments\n";
+
+ memoize('A') if $mem;
+
+ printf "\nA(%d, %d) = %d (recursions: %d with%s memoization)\n",
+ $m, $n, A($m, $n), $recs, $mem ? '' : 'out';
+}
+
+{
+ no warnings 'recursion';
+
+ sub A
+ {
+ my ($m, $n) = @_;
+
+ ++$recs;
+
+ return $n + 1 if $m == 0;
+
+ return A($m - 1, 1) if $n == 0;
+
+ return A($m - 1, A($m, $n - 1));
+ }
+}
+
+################################################################################
diff --git a/challenge-017/athanasius/perl5/ch-2.pl b/challenge-017/athanasius/perl5/ch-2.pl
new file mode 100644
index 0000000000..44db92368e
--- /dev/null
+++ b/challenge-017/athanasius/perl5/ch-2.pl
@@ -0,0 +1,156 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 017
+=========================
+
+Task #2
+-------
+
+Create a script to parse URL and print the components of URL. According to
+[ https://en.wikipedia.org/wiki/URL |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
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2019 PerlMonk Athanasius #
+#--------------------------------------#
+
+use strict;
+use warnings;
+use Const::Fast;
+use Try::Tiny;
+use URI::Split qw( uri_split );
+
+const my $DEFAULT_URL =>
+ 'jdbc://user:password@localhost:3306/pwc?profile=true#h1';
+
+MAIN:
+{
+ my $url = $ARGV[0] // $DEFAULT_URL;
+
+ try
+ {
+ my ($scheme, $authority, $path, $query, $fragment) = uri_split($url);
+
+ validate_scheme($scheme);
+
+ my ($userinfo, $host, $port) = parse_authority($authority);
+
+ display_url($url, $scheme, $authority, $userinfo, $host,
+ $port, $path, $query, $fragment);
+ }
+ catch
+ {
+ warn "\nError parsing URL \"$url\":\n$_";
+ }
+}
+
+# SCHEME: A non-empty scheme component followed by a colon (:), consisting of a
+# sequence of characters beginning with a letter and followed by any combination
+# of letters, digits, plus (+), period (.), or hyphen (-).
+
+sub validate_scheme
+{
+ my ($scheme) = @_;
+
+ $scheme
+ or die "Empty scheme\n";
+
+ $scheme =~ / ^ ( [^A-Za-z] ) /x
+ and die "Invalid initial character \"$1\" in scheme \"$scheme\"\n";
+
+ $scheme =~ / ( [^A-Za-z0-9+.-] ) /x
+ and die "Invalid character \"$1\" in scheme \"$scheme\"\n";
+}
+
+# AUTHORITY: An optional authority component preceded by two slashes (//)...
+
+sub parse_authority
+{
+ my ($authority) = @_;
+ my ($userinfo, $host, $port);
+
+ if ($authority)
+ {
+ $authority =~ s{ ^ // }{}x;
+
+ # USERINFO: An optional userinfo subcomponent that may consist of a user
+ # name and an optional password preceded by a colon (:), followed by an
+ # at symbol (@). Use of the format username:password in the userinfo
+ # subcomponent is deprecated for security reasons. Applications should
+ # not render as clear text any data after the first colon (:) found
+ # within a userinfo subcomponent unless the data after the colon is the
+ # empty string (indicating no password).
+
+ if ($authority =~ /@/)
+ {
+ ($userinfo, $authority) = split /@/, $authority, 2;
+
+ if ($userinfo =~ /:/)
+ {
+ my ($username, $password) = split /:/, $userinfo, 2;
+
+ $userinfo = $username . ':' . '*' x length($password);
+ }
+ }
+
+ # PORT: An optional port subcomponent preceded by a colon (:).
+
+ if ($authority =~ /:/)
+ {
+ ($host, $port) = split /:/, $authority, 2;
+ }
+ else
+ {
+ $host = $authority;
+ }
+ }
+
+ return ($userinfo, $host, $port);
+}
+
+sub display_url
+{
+ my ($url, $scheme, $authority, $userinfo, $host,
+ $port, $path, $query, $fragment) = @_;
+
+ $_ //= '(none)' for ($userinfo, $host, $port, $query, $fragment);
+ $path ||= '(empty)';
+
+ print "\nURL: $url\n" .
+ "\nScheme: $scheme";
+
+ if ($authority)
+ {
+ print "\nAuthority:" .
+ "\n Userinfo: $userinfo" .
+ "\n Host: $host" .
+ "\n Port: $port";
+ }
+ else
+ {
+ print "\nAuthority: (none)";
+ }
+
+ print "\nPath: $path" .
+ "\nQuery: $query" .
+ "\nFragment: $fragment\n";
+}
+
+################################################################################
diff --git a/challenge-017/athanasius/perl6/ch-1.p6 b/challenge-017/athanasius/perl6/ch-1.p6
new file mode 100644
index 0000000000..fc9f24496a
--- /dev/null
+++ b/challenge-017/athanasius/perl6/ch-1.p6
@@ -0,0 +1,71 @@
+use v6;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 017
+=========================
+
+Task #1
+-------
+
+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
+[ https://en.wikipedia.org/wiki/Ackermann_function |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
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2019 PerlMonk Athanasius #
+#--------------------------------------#
+
+use Memoize;
+
+my UInt constant $DEFAULT-M = 1;
+my UInt constant $DEFAULT-N = 2;
+my UInt $recursions = 0;
+
+sub MAIN
+(
+ UInt:D :$m = $DEFAULT-M,
+ UInt:D :$n = $DEFAULT-N,
+ Bool:D :memoize(:$mem) = False,
+)
+{
+ memoize(&ackermann) if $mem;
+
+ say "\nA($m, $n) = { ackermann($m, $n) } (recursions: $recursions with",
+ $mem ?? '' !! 'out', ' memoization)';
+}
+
+sub ackermann
+(
+ UInt:D $m,
+ UInt:D $n,
+--> UInt:D
+)
+{
+ ++$recursions;
+
+ return $n + 1 if $m == 0;
+
+ return ackermann($m - 1, 1) if $n == 0;
+
+ return ackermann($m - 1, ackermann($m, $n - 1));
+}
+
+################################################################################
diff --git a/challenge-017/athanasius/perl6/ch-2.p6 b/challenge-017/athanasius/perl6/ch-2.p6
new file mode 100644
index 0000000000..ea8e988e5a
--- /dev/null
+++ b/challenge-017/athanasius/perl6/ch-2.p6
@@ -0,0 +1,157 @@
+use v6;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 017
+=========================
+
+Task #2
+-------
+
+Create a script to parse URL and print the components of URL. According to
+[ https://en.wikipedia.org/wiki/URL |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
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2019 PerlMonk Athanasius #
+#--------------------------------------#
+
+use URI::Split:from<Perl5> <uri_split>;
+
+my Sub $uri-split := &URI::Split::uri_split;
+
+my Str constant $DEFAULT-URL =
+ 'jdbc://user:password@localhost:3306/pwc?profile=true#h1';
+
+sub MAIN(Str:D $url = $DEFAULT-URL)
+{
+ my ($scheme, $authority, Str $path, $query, $fragment) = $uri-split($url);
+
+ die 'Empty scheme' unless $scheme;
+ validate-scheme($scheme);
+
+ my ($userinfo, $host, $port);
+ ($userinfo, $host, $port) = parse-authority($authority) if $authority;
+
+ $authority //= '';
+ $_ //= '(none)' for $userinfo, $host, $port, $query, $fragment;
+ $path ||= '(empty)';
+
+ display-url($url, $scheme, $authority, $userinfo, $host,
+ $port, $path, $query, $fragment);
+
+ CATCH
+ {
+ default
+ {
+ $*ERR.say: "\nError parsing URL \"$url\":";
+ $*ERR.say: .message;
+ }
+ }
+}
+
+sub validate-scheme(Str:D $scheme)
+{
+ if $scheme ~~ / ^ ( <-[A..Za..z]> ) /
+ {
+ die "Invalid initial character \"$0\" in scheme \"$scheme\"";
+ }
+
+ if $scheme ~~ / ( <-[A..Za..z0..9+.-]> ) /
+ {
+ die "Invalid character \"$0\" in scheme \"$scheme\"";
+ }
+}
+
+sub parse-authority(Str:D $authority is rw --> List)
+{
+ my ($userinfo, $host, $port);
+
+ if $authority
+ {
+ $authority ~~ s{ ^ \/\/ } = '';
+
+ # USERINFO: An optional userinfo subcomponent that may consist of a user
+ # name and an optional password preceded by a colon (:), followed by an
+ # at symbol (@). Use of the format username:password in the userinfo
+ # subcomponent is deprecated for security reasons. Applications should
+ # not render as clear text any data after the first colon (:) found
+ # within a userinfo subcomponent unless the data after the colon is the
+ # empty string (indicating no password).
+
+ if ($authority ~~ /\@/)
+ {
+ ($userinfo, $authority) = split /\@/, $authority, 2;
+
+ if ($userinfo ~~ /\:/)
+ {
+ my ($username, $password) = split /\:/, $userinfo, 2;
+
+ $userinfo = $username ~ ':' ~ '*' x $password.chars;
+ }
+ }
+
+ # PORT: An optional port subcomponent preceded by a colon (:).
+
+ if ($authority ~~ /\:/)
+ {
+ ($host, $port) = split /\:/, $authority, 2;
+ }
+ else
+ {
+ $host = $authority;
+ }
+ }
+
+ return ($userinfo, $host, $port);
+}
+
+sub display-url
+(
+ Str:D $url,
+ Str:D $scheme,
+ Str:D $authority,
+ Str:D $userinfo,
+ Str:D $host,
+ Str:D $port,
+ Str:D $path,
+ Str:D $query,
+ Str:D $fragment
+)
+{
+ say "\nURL: $url\n" ~
+ "\nScheme: $scheme";
+
+ if ($authority)
+ {
+ say "Authority:\n" ~
+ " Userinfo: $userinfo\n" ~
+ " Host: $host\n" ~
+ " Port: $port";
+ }
+ else
+ {
+ say "Authority: (none)";
+ }
+
+ say "Path: $path\n" ~
+ "Query: $query\n" ~
+ "Fragment: $fragment";
+}
+
+################################################################################
generated by cgit (git 2.34.1) at 2026-07-01 16:23:27 +0000