Merge pull request #525 from jmaslak/joelle-21-2-1

Joelle's solutions to 21.2

2 files changed, 238 insertions, 0 deletions

diff --git a/challenge-021/joelle-maslak/perl5/ch-2.pl b/challenge-021/joelle-maslak/perl5/ch-2.pl
new file mode 100755
index 0000000000..89fe13f964
--- /dev/null
+++ b/challenge-021/joelle-maslak/perl5/ch-2.pl
@@ -0,0 +1,132 @@
+#!/usr/bin/env perl
+use v5.22;
+use strict;
+use warnings;
+
+# We only do the operations gauranteed to preserve semantics.
+
+# 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 );
+    die "Invalid URL" if ( ( $url ne '' ) or ( !defined $parse ) );
+
+    my $str = lc( $parse->{scheme} ) . ':';
+
+    $str .= '//'                                   if defined $parse->{host};
+    $str .= $parse->{userinfo}                     if defined $parse->{userinfo};
+    $str .= normalize_percent( lc $parse->{host} ) if defined $parse->{host};
+
+    if ( lc( $parse->{scheme} ) eq 'http' and defined $parse->{port} ) {
+        $str .= ':' . $parse->{port} if $parse->{port} != 80;
+    } elsif ( lc( $parse->{scheme} ) eq 'https' and defined $parse->{port} ) {
+        $str .= ':' . $parse->{port} if $parse->{port} != 443;
+    } elsif ( defined $parse->{port} ) {
+        $str .= ':' . $parse->{port};
+    }
+
+    $str .= normalize_percent( $parse->{path} )     if defined $parse->{path};
+    $str .= normalize_percent( $parse->{query} )    if defined $parse->{query};
+    $str .= normalize_percent( $parse->{fragment} ) if defined $parse->{fragment};
+
+    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>' );
+
+    say $str;
+}
+
+sub normalize_percent($part) {
+    my $remainder = $part;
+    my $output    = '';
+
+    while ( $remainder ne '' ) {
+        my $beginning = $remainder;
+        my $end       = $remainder;
+
+        $beginning =~ s/([^%]*).*$/$1/;
+        $end       =~ s/[^%]*//;
+
+        $output .= $beginning;
+
+        if ( $end ne '' ) {
+            if ( $end !~ m/^\%[a-f0-9][a-f0-9]/i ) {
+                say $end;
+                die("Invalid percent_encoding");
+            }
+            my $encoding = hex( substr( $end, 1, 2 ) );
+            if ( $encoding >= 0x41 and $encoding <= 0x5a ) {    # Upper case
+                $output .= chr($encoding);
+            } elsif ( $encoding >= 0x61 and $encoding <= 0x79 ) {    # Lower case
+                $output .= chr($encoding);
+            } elsif ( $encoding >= 0x30 and $encoding <= 0x39 ) {    # Digits
+                $output .= chr($encoding);
+            } elsif ( $encoding == 0x2d ) {                          # Hyphen
+                $output .= chr($encoding);
+            } elsif ( $encoding == 0x2e ) {                          # Period
+                $output .= chr($encoding);
+            } elsif ( $encoding == 0x5f ) {                          # Underscore
+                $output .= chr($encoding);
+            } elsif ( $encoding == 0x7e ) {                          # Tilde
+                $output .= chr($encoding);
+            } else {
+                $output .= '%' . sprintf( "%02x", $encoding );
+            }
+
+            $remainder = substr( $end, 3 );
+        } else {
+            # No defined end
+            $remainder = '';
+        }
+    }
+
+    return $output;
+}
+
diff --git a/challenge-021/joelle-maslak/perl6/ch-2.p6 b/challenge-021/joelle-maslak/perl6/ch-2.p6
new file mode 100755
index 0000000000..557cb83983
--- /dev/null
+++ b/challenge-021/joelle-maslak/perl6/ch-2.p6
@@ -0,0 +1,106 @@
+#!/usr/bin/env perl6
+use v6;
+
+# We only do the opertions gauranteed to preserve semantics.
+
+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 $normalized = normalize($url);
+
+    say $normalized;
+}
+
+sub normalize($url -->Str:D) {
+    my $parse = URL.parse($url);
+    die "Invalid URL" unless $parse.defined;
+
+    my $str = $parse<scheme>.lc ~ ":";
+
+    $str ~= "//" if $parse<host>:exists;
+    $str ~= $parse<userinfo> ~ '@' if $parse<userinfo>:exists ;
+    $str ~= normalize-percent($parse<host>.lc) if $parse<host>:exists;
+
+    if $parse<scheme>.lc eq 'http' and $parse<port>:exists {
+        $str ~= ":" ~ $parse<port> if $parse<port> ≠ 80;
+    } elsif $parse<scheme>.lc eq 'https' and $parse<port>:exists {
+        $str ~= ":" ~ $parse<port> if $parse<port> ≠ 443;
+    } elsif $parse<port>:exists {
+        $str ~= ":" ~ $parse<port>;
+    }
+
+    $str ~= normalize-percent($parse<path>) if $parse<path>:exists;
+    $str ~= normalize-percent($parse<query>) if $parse<query>:exists;
+    $str ~= normalize-percent($parse<fragment>) if $parse<fragment>:exists;
+
+    return $str;
+}
+
+sub normalize-percent($part) {
+    my $remainder = $part;
+    my $output    = '';
+
+    while $remainder.chars {
+        my $beginning = S/ ( <-[ % ]>* ) .*$/$0/ with $remainder;
+        my $end       = S/ <-[ % ]>*//           with $remainder;
+
+        $output ~= $beginning // '';
+
+        if ($end // '').chars {
+            if $end !~~ m:i/^ '%' ( <[ a..f 0..9 ]> ** 2..2 )/ {
+                die("Invalid percent encoding");
+            }
+            my $encoding = :16($end.substr(1, 2));
+            if 0x41 ≤ $encoding ≤ 0x5a { # Upper case
+                $output ~= $encoding.chr;
+            } elsif 0x61 ≤ $encoding ≤ 0x7a { # Lower case
+                $output ~= $encoding.chr;
+            } elsif 0x30 ≤ $encoding ≤ 0x39 { # Digits
+                $output ~= $encoding.chr;
+            } elsif $encoding == 0x2d { # Hyphen
+                $output ~= $encoding.chr;
+            } elsif $encoding == 0x2e { # Period
+                $output ~= $encoding.chr;
+            } elsif $encoding == 0x5f { # Underscore
+                $output ~= $encoding.chr;
+            } elsif $encoding == 0x7e { # Tilde
+                $output ~= $encoding.chr;
+            } else {
+                $output ~= "%" ~ $encoding.fmt("%02x");
+            }
+
+            $remainder = $end.substr(3);
+        } else {
+            # No defined end
+            $remainder = '';
+        }
+    }
+
+    return $output;
+}
+