Perl Weekly Challenge 017

ch-1.pl

use strict;
use warnings;
##
# Create a script to demonstrate Ackermann function.
##

sub A{
    my($m, $n) = @_;
    return $n + 1 if($m == 0);
    return A($m - 1, 1) if($m > 0 && $n == 0);
    return A($m - 1, A($m, $n - 1)) if ($m > 0 && $n > 0); 
}

MAIN:{
    my $ackermann = A(1,2);
    print "$ackermann\n"; 
}  

ch-2.pl

use strict;
use warnings;
##
# Create a script to parse URL and print the components of URL.
##
use UrlParser;
use constant URL => q|jdbc://user:password@localhost:3306/pwc?profile=true#h1|; 

MAIN:{
    my $parser = new UrlParser();
    $parser->parse(URL);
}  

ch-3.pl

use strict;
use warnings;
##
# Write a script to use Bhagavad Gita API.
##
use JSON; 
use REST::Client;
use constant ACCESS_TOKEN_URL => "https://bhagavadgita.io/auth/oauth/token"; 
use constant API_URL => "https://bhagavadgita.io/api/v1/chapters/CHAPTER/verses/VERSE?access_token=ACCESS_TOKEN"; 

sub get_access_token{
    my($client) = @_;
    my $body = "client_id=<CLIENT_ID>&client_secret=<CLIENT_SECRET>&grant_type=client_credentials&scope=verse%20chapter";
    $$client->addHeader("accept", "application/json"); 
    $$client->addHeader("content-type", "application/x-www-form-urlencoded"); 
    $$client->POST(ACCESS_TOKEN_URL, $body);
    my $json = $$client->responseContent(); 
    $json = decode_json($json);
    return $json->{access_token}; 
}

sub get_sloka{
    my($client, $chapter, $verse, $access_token) = @_;
    my $url = API_URL;
    $url =~ s/CHAPTER/$chapter/; 
    $url =~ s/VERSE/$verse/; 
    $url =~ s/ACCESS_TOKEN/$access_token/; 
    $$client->addHeader("accept", "application/json"); 
    $$client->addHeader("content-type", "application/x-www-form-urlencoded"); 
    $$client->GET($url);
    my $json = $$client->responseContent(); 
    $json = decode_json($json);
    return $json->{meaning};  
}

MAIN:{
    my($chapter, $verse) = @ARGV[0 .. 1];  
    my $client = new REST::Client;
    my $access_token = get_access_token(\$client); 
    my $translation = get_sloka(\$client, $chapter, $verse, $access_token); 
    print "$translation\n"; 
}

url_viz.pl

use GraphViz::Parse::Yapp;

# Pass in a file generated via yapp -v
my $g = GraphViz::Parse::Yapp->new("perl5/UrlGrammar.output");
print $g->as_png;

UrlGrammar.yp

%token '://' SCHEME USERPASSWORD HOST PORT PATH QUERY FRAGMENT 
%%
url: scheme colondoubleslash userpassword host port path query fragment 
   | scheme colondoubleslash host path query fragment 
   | scheme colondoubleslash host path fragment 
   | scheme colondoubleslash host path  
   | scheme colondoubleslash host  
;

colondoubleslash: '://'
;
 
scheme: SCHEME { print "SCHEME:\t\t" . $_[1] . "\n" } 
;

userpassword: USERPASSWORD { my @a = split(/:/, $_[1]); print "USER:\t\t" . $a[0]  . "\nPASSWORD:\t" . $a[1] . "\n" }  
;

host: HOST { $_[1] =~ s/@//; print "HOST:\t\t" . $_[1] . "\n" }   
;

port: PORT { $_[1] =~ s/://; print "PORT:\t\t" . $_[1] . "\n" }
;

path: PATH { print "PATH:\t\t" . $_[1] . "\n" }
;

query: QUERY { my $query = substr($_[1], 1); print "QUERY:\t\t$query\n" } 
;

fragment: FRAGMENT { my $fragment = substr($_[1], 1); print "FRAGMENT:\t$fragment\n" }  
;

%%

sub lexer{
    my($parser) = @_;
    $parser->YYData->{INPUT} or return('', undef);
    $parser->YYData->{INPUT} =~ s/^[ \t]//;
    ##
    # send tokens to parser
    ##
    for($parser->YYData->{INPUT}){
        s/^(http|https|ftp|jdbc)// and return ("SCHEME", $1); 
        s/^(:\/\/)// and return ("://", $1);
        s/^(:[0-9]*)// and return ("PORT", $1);
        s/^([a-zA-Z]*:[a-zA-Z]*)// and return ("USERPASSWORD", $1); 
        s/^(\/[\/a-zA-Z]*)// and return ("PATH", $1);
        s/^(\?{1}[a-zA-z=a-zA-Z]*)// and return ("QUERY", $1);
        s/^(#{1}[a-zA-Z]*[0-9]*)// and return ("FRAGMENT", $1); 
        s/^(@?\/{0}[a-zA-z]*)// and return ("HOST", $1);
    }  
}

sub error{
    exists $_[0]->YYData->{ERRMSG}
    and do{
        print $_[0]->YYData->{ERRMSG};
            return;
    };
    print "syntax error\n"; 
}

sub parse{
    my($self, $input) = @_;
    $self->YYData->{INPUT} = $input;
    my $result = $self->YYParse(yylex => \&lexer, yyerror => \&error);
    return $result;  
}