aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoelle Maslak <jmaslak@antelope.net>2019-07-21 12:14:09 -0600
committerJoelle Maslak <jmaslak@antelope.net>2019-07-21 12:14:09 -0600
commitc121e70ec6d3fb3211d2f3d94e3c5fa01c6bf2e1 (patch)
tree52f401fbd8777252c7af6ff7aacc48377e51c713
parent2a0b12495163fcd0f3f0d0e1bb0a7d0af82bcdd0 (diff)
downloadperlweeklychallenge-club-c121e70ec6d3fb3211d2f3d94e3c5fa01c6bf2e1.tar.gz
perlweeklychallenge-club-c121e70ec6d3fb3211d2f3d94e3c5fa01c6bf2e1.tar.bz2
perlweeklychallenge-club-c121e70ec6d3fb3211d2f3d94e3c5fa01c6bf2e1.zip
Solution for 17.2
-rwxr-xr-xchallenge-017/joelle-maslak/perl5/ch-2.pl64
-rwxr-xr-xchallenge-017/joelle-maslak/perl6/ch-2.p647
2 files changed, 111 insertions, 0 deletions
diff --git a/challenge-017/joelle-maslak/perl5/ch-2.pl b/challenge-017/joelle-maslak/perl5/ch-2.pl
new file mode 100755
index 0000000000..d3a7057aeb
--- /dev/null
+++ b/challenge-017/joelle-maslak/perl5/ch-2.pl
@@ -0,0 +1,64 @@
+#!/usr/bin/env perl
+use v5.22;
+use strict;
+use warnings;
+
+# Turn on method signatures
+use feature 'signatures';
+no warnings 'experimental::signatures';
+
+use Parse::RecDescent 1.511;
+
+my $urlparser = Parse::RecDescent->new(q{
+ TOP :
+ <skip:''>
+ scheme authority(?) path ('?' query)(?) ('#' fragment)(?)
+ {
+ {
+ scheme => $item[2],
+ userinfo => $item[3][0]{'userinfo'},
+ host => $item[3][0]{'host'},
+ port => $item[3][0]{'port'},
+ path => $item[4],
+ query => $item[5][0],
+ fragment => $item[6][0],
+ }
+ }
+ scheme : /[A-Za-z]+ [A-Za-z\.\+\- ]+/x ':' { $item[1] }
+
+ authority : '//' userinfo(?) host (':' port)(?)
+ { { userinfo => $item[2][0], host => $item[3], port => $item[4][0] } }
+
+ userinfo : username ':' password '@' { $item[1] . $item[2] . $item[3] }
+
+ path : /( \/ [^\s\?\#]* )?/x
+
+ query : /[^\s\#]*/
+
+ fragment : /[^\s]*/
+
+ host : /[^\s\:\?\/\#]+/
+ port : /[^\s\?\/\#]+/
+ username : /[^\s\:]+/
+ password : /[^\s\@]*/
+});
+
+MAIN: {
+ die "Usage: $0 <url>" if @ARGV != 1;
+
+ my $url = $ARGV[0];
+ my $parse = $urlparser->TOP(\$url);
+ if (($url ne '') or (!defined $parse)) {
+ say "Invalid URL";
+ exit;
+ }
+
+ say "Scheme: " . ($parse->{scheme} // '<not defined>');
+ say "Userinfo: " . ($parse->{userinfo} // '<not defined>');
+ say "Host: " . ($parse->{host} // '<not defined>');
+ say "Port: " . ($parse->{port} // '<not defined>');
+ say "Path: " . ($parse->{path} // '<not defined>');
+ say "Query: " . ($parse->{query} // '<not defined>');
+ say "Fragment: " . ($parse->{fragment} // '<not defined>');
+}
+
diff --git a/challenge-017/joelle-maslak/perl6/ch-2.p6 b/challenge-017/joelle-maslak/perl6/ch-2.p6
new file mode 100755
index 0000000000..1a33c66eaa
--- /dev/null
+++ b/challenge-017/joelle-maslak/perl6/ch-2.p6
@@ -0,0 +1,47 @@
+#!/usr/bin/env perl6
+use v6;
+
+grammar URL {
+ token TOP {
+ ^
+ <scheme> ':'
+ [
+ '//'
+ [ <userinfo> '@' ]?
+ <host>
+ [ ':' <port> ]?
+ ]?
+ <path>
+ [ '?' <query> ]?
+ [ '#' <fragment> ]?
+ $
+ }
+ token scheme { <[A .. Z a .. z ]> <[ A .. Z a .. z 0 .. 9 . + - ]>* }
+ token userinfo { <username> ':' <password> }
+ token username { <[ \S ] - [ : ]>+ }
+ token password { <[ \S ] - [ @ ]>* }
+ token host { <[ \S ] - [ : ? / \# ]>+ }
+ token port { <[ \S ] - [ ? / \# ]>+ }
+ token path { [ '/' <[ \S ] - [ ? \# ]>* ]? }
+ token query { <[ \S ] - [ \# ]>* }
+ token fragment { \S* }
+}
+
+
+sub MAIN(Str:D $url) {
+ my $parse = URL.parse($url);
+
+ if ! $parse.defined {
+ say "Invalid URL";
+ exit;
+ }
+
+ say "Scheme: " ~ ($parse<scheme> // '<not defined>');
+ say "Userinfo: " ~ ($parse<userinfo> // '<not defined>');
+ say "Host: " ~ ($parse<host> // '<not defined>');
+ say "Port: " ~ ($parse<port> // '<not defined>');
+ say "Path: " ~ ($parse<path> // '<not defined>');
+ say "Query: " ~ ($parse<query> // '<not defined>');
+ say "Fragment: " ~ ($parse<fragment> // '<not defined>');
+}
+