### Perl Weekly Challenge: Week 17

I returned from my trip this weekend but unfortunately I once again had to travel through my prime perl hacking time. Lucky for me, this weeks challenges were pretty easy so I was able to submit them on time. I even found time to do the optional API challenge.

#### Challenge 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 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
``````

This can be easily modeled by a recursive function with two special cases. (Plus an extra check to make sure the inputs are positive integers.) Here is the Perl5 version.

``````sub ackermann {
my (\$m, \$n) = @_;

if (\$m < 0 || \$n < 0) {
return undef;
}

if (\$m == 0) {
return \$n + 1;
}

if (\$n == 0) {
return ackermann(\$m - 1, 1);
}

return ackermann(\$m - 1, ackermann(\$m, \$n - 1));
}
``````

(Full code on Github.)

In Perl6 we can use the multi sub functionality for each case and parameter validation is built in.

``````multi sub ackermann (
Int \$m where { \$m == 0 },
Int \$n where { \$n >= 0 },
) {
return \$n + 1;
}

multi sub ackermann (
Int \$m where { \$m >= 0 },
Int \$n where { \$n == 0 },
) {
return ackermann(\$m - 1, 1);
}

multi sub ackermann (
Int \$m where { \$m >= 0 },
Int \$n where { \$n >= 0 },
) {
return ackermann(\$m - 1, ackermann(\$m, \$n - 1));
}
``````

(Full code on Github.)

#### Challenge 2:

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]

``````scheme:   jdbc
host:     localhost
port:     3306
path:     /pwc
query:    profile=true
fragment: h1
``````

This is my Perl5 version. I looked at RFC 3986 for the authoritative description of URL syntax. I think my code is pretty good at covering the spec. The biggest omission is support for IPv6 addresses. There are two regex features I made good use of. The `/x` flag let's you use whitespace in a regex which helps ease the "line noise" effect which is a common criticism of perl code. The `?<>` construct is another readability aid. It lets you give matches a name instead of having to refer to them as `\$1`, `\$2`, `\$3`... etc.

``````my \$dec_octet = qr / \d | [1-9]\d | 1\d\d | 2[0-4]\d | 25[0-5] /x;
my \$hex_octet = qr /  [ 0-9 A-F a-f ]{2} /x;
my \$pct_encoded = qr/ % \$hex_octet /x;
my \$sub_delim  = qr/ [ ! \$ & ' ( ) * + , ; = ] /x;
my \$scheme = qr/ [ A-Z a-z 0-9 + - . ] /x;
my \$unreserved = qr/ [ A-Z a-z 0-9 - . _ ~ ] /x;

my \$ipv4 = qr/\$dec_octet \. \$dec_octet \. \$dec_octet \. \$dec_octet /x;
my \$userinfo = qr/ \$unreserved | \$pct_encoded | \$sub_delim | : /x;
my \$pchar = qr/ \$userinfo | @ /x;
my \$path = qr / \$pchar | \/ /x;
my \$query_or_fragment = qr/ \$pchar | \/ | \? /x;

my \$url = shift;

\$url =~ /
(?<scheme>\$scheme+)
:
(?:
\/\/?
(?: (?<userinfo> \$userinfo+? ) @ )?
(?<host> \$ipv4 | \$unreserved+ )
(?: : (?<port> \d+ ) )?
)?
(?<path> \$path+ )?
(?: \? (?<query> \$query_or_fragment+ ) )?
(?: \# (?<fragment> \$query_or_fragment+ ) )?
/msx;

for my \$part (qw/ scheme userinfo host port path query fragment /) {
say "\$part: ", \$+{\$part} // q{};
}
``````

(Full code on Github.)

The Perl6 version uses that languages grammar feature to make the code even cleaner. I find I still trip over some of the changes made to regex syntax in Perl6 sometimes but I am steadily getting better.

``````grammar URL {
token TOP {
<Scheme>
':'
[
'//'?
[ <Userinfo> '@' ]?
<Host>
[ ':' <Port> ]?
]?
<Path>?
[ '?' <Query> ]?
[ '#' <Fragment> ]?
}

token Scheme { <SchemeChar>+ }
token Userinfo { <UserinfoChar>+ }
token Host { <IPv4> | <Unreserved>+ }
token Port { \d+ }
token Path { <PathChar>+ }
token Query { <QueryOrFragment>+ }
token Fragment { <QueryOrFragment>+ }

token SchemeChar { <[ A..Z a..z 0..9 + \- . ]> }
token DecOctet { \d | <[1..9]>\d | 1\d\d | 2<[0..4]>\d | 25<[0..5]> }
token HexOctet { <[ 0..9 A..F a..f ]> ** 2 }
token IPv4 { <DecOctet> \. <DecOctet> \. <DecOctet> \. <DecOctet> }
token PChar { <UserinfoChar> | '@' }
token PathChar { <PChar> | '/' }
token PctEncoded { \% <HexOctet> }
token QueryOrFragment { <PChar> | \/ | \? }
token SubDelim { <[ \! \$ & \' \( \) * \+ \, \; \= ]> }
token Unreserved { <[ A..Z a..z 0..9 \- . _ \~ ]> }
token UserinfoChar { <Unreserved> | <PctEncoded> | <SubDelim> | ':' }
}

class URLAction {

method Scheme(\$/) {
say 'Scheme: ', \$/.Str;
}

method Userinfo(\$/) {
say 'Userinfo: ', \$/.Str;
}

method Host(\$/) {
say 'Host: ', \$/.Str;
}

method Port(\$/) {
say 'Port: ', \$/.Str;
}

method Path(\$/) {
say 'Path: ', \$/.Str;
}

method Query(\$/) {
say 'Query: ', \$/.Str;
}

method Fragment(\$/) {
say 'Fragment: ', \$/.Str;
}

}
``````

(Full code on Github.)

#### Challenge 3:

Having finished the first two tasks quickly I found I had some extra time and a Bhagavadgita API is an irresistable target so I did the third challenge, a first for me. But only in Perl5; Networking in Perl6 is still a little beyond my knowledge for now.

I used `Moo` as the OOP framework. While Perl5's builtin features would have been adequate for this task, `Moo` is more systematic yet not as heavyweight as e.g. `Moose`.

The first two classes model the Chapters and Verses which are returned by Bhagavadgita API calls.

``````package WWW::Bhagavadgita::Chapter;

has [qw/
chapter_number
chapter_summary
name
name_meaning
name_translation
name_transliterated
verses_count
/] => (
is       => 'ro',
required => 1
);

has [qw/
meaning
text
transliteration
verse_number
word_meanings
/] => (
is       => 'ro',
required => 1
);
``````

The main class models the API calls themselves. I used the `LWP`, `HTTP::Request::Common` and `JSON` modules to handle the actual network back and forth.

``````package WWW::Bhagavadgita;
``````

`Moo` creates a constructor (`new()` method) for your class. By specifying `client_id` and `client_secret` as read-only (`is => 'ro'`) and required (`required => 1`) members, I require them to be specified as parameters to the constructor. You get the id and secret by from your API dashboard after you register with bhagavadgita.io

``````has [qw/ client_id  client_secret /] => (
is       => 'ro',
required => 1
);
``````

The Bhagavadgita API uses OAuth for authentication which means you have to acquire a special token before you can use any of the APIs. I store the token in a member because it can be used in multiple API calls providing they are made within 300 seconds after which the token expires and you have to get another one.

``````has token => (
is => 'rw',
);

sub _get_token {
my (\$self) = @_;

my \$request = POST(
[
client_id     => \$self->client_id,
client_secret => \$self->client_secret,
grant_type    => 'client_credentials',
scope         => 'verse chapter',
],
Content_Type  => 'application/x-www-form-urlencoded',
);

my \$response = \$self->ua->request(\$request);
if (\$response->is_success) {
my \$results = decode_json(\$response->decoded_content);
\$self->token(\$results->{access_token});
} else {
\$self->token(undef);
}
}
``````

Sometimes you might create a `WWW::Bhagavadgita` object but not use it straight away. In such a scenario it would not make sense to create heavyweight object members such as an `LWP::UserAgent` object until it was actually needed. `Moo` lets you delay construction of members by specifying them as `is => 'lazy'`. Also as creating these objects often requires more than just `->new()`, it lets you provide a `_build_*()` method where you can initialize the member in a more elaborate way. For instance in this code, we not only create a new `LWP::UserAgent` object but set its' user agent identification string and a default HTTP header. Usually I make user agent strings the scripts name and version number but it appears that bhagavadgita.io blocks user agents it doesn't recognize so instead this script pretends to be cUrl.

``````has ua => (
is  => 'lazy',
);

sub _build_ua {
my (\$self) = @_;

my \$ua = LWP::UserAgent->new(
agent => "curl/7.58.0",
);

return \$ua;
}
``````

The actual client-server communication is centralized in the `_call()` method.

``````sub _call {
my (\$self, @args) = @_;

if (scalar @args) {
\$url .= join(q{/}, @args);

} else {
return { error => "Not enough arguments." };

}

\$self->token // \$self->_get_token();
if (!defined \$self->token) {
return { error => "Couldn't get auth token." };
}

my \$request = GET(\$url,cauthorization => 'Bearer ' . \$self->token);

my \$response = \$self->ua->request(\$request);
if (\$response->is_success) {
return { data => \$response->decoded_content };
} else {
return { error => \$response->status_line };
}
}
``````

The API methods. One thing I definitely must fix is that I only return `undef` in the event of an error instead of a descriptive message.

``````=head2 chapters()

Get all the 18 Chapters of the Bhagavad Gita.

Returns an array of L<WWW::Bhagavadgita::Chapter> objects or undef if there
has been an error.

=cut

sub chapters {
my (\$self) = @_;

my \$result = \$self->_call('chapters');

if (defined \$result->{error}) {
return undef;
} else {
my @chapters;
for my \$chapter (@{ decode_json( \$result->{data} ) }) {
};
return @chapters;
}
}

Get a specific chapter from the Bhagavad Gita.

Returns a L<WWW::Bhagavadgita::Chapter> object or undef if there
has been an error.

=cut

sub chapter {
my (\$self, \$chapter_number) = @_;

my \$result = \$self->_call('chapters', \$chapter_number);

if (defined \$result->{error}) {
return undef;
} else {
}
}

Get all the verses in the Bhagavad Gita.

Returns an array of L<WWW::Bhagavadgita::Verse> objects or undef if there
has been an error.

=cut

sub verses {
my (\$self) = @_;

my \$result = \$self->_call('verses');

if (defined \$result->{error}) {
return undef;
} else {
my @verses;
for my \$verse (@{ decode_json( \$result->{data} ) }) {
};
return @verses;
}
}

Get a particular verse from a chapter.

Returns a L<WWW::Bhagavadgita::Verse> object or undef if there
has been an error.

=cut

sub verse {
my (\$self, \$chapter_number, \$verse_number) = @_;

my \$result =
\$self->_call('chapters', \$chapter_number, 'verses', \$verse_number);

if (defined \$result->{error}) {
return undef;
} else {
}
}

Get all the Verses from a Chapter.

Returns an array of L<WWW::Bhagavadgita::Verse> objects or undef if there
has been an error.

=cut

sub chapter_verses {
my (\$self, \$chapter_number, \$verse_number) = @_;

my \$result =
\$self->_call('chapters', \$chapter_number, 'verses');

if (defined \$result->{error}) {
return undef;
} else {
my @verses;
for my \$verse (@{ decode_json( \$result->{data} ) }) {