diff options
| -rwxr-xr-x | challenge-021/joelle-maslak/perl5/ch-2.pl | 132 | ||||
| -rwxr-xr-x | challenge-021/joelle-maslak/perl6/ch-2.p6 | 106 |
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; +} + |