From 1bd1dff6d449ab221e191679fd8ec516b7cc1d4e Mon Sep 17 00:00:00 2001 From: Patrick Spek Date: Mon, 8 Apr 2019 19:30:35 +0200 Subject: Initial commit --- .editorconfig | 16 ++++++ .gitignore | 14 +++++ .gitlab-ci.yml | 23 ++++++++ CHANGELOG.md | 9 ++++ META6.json | 27 ++++++++++ README.pod6 | 23 ++++++++ lib/URL.pm6 | 126 ++++++++++++++++++++++++++++++++++++++++++++ lib/URL/Grammar.pm6 | 48 +++++++++++++++++ lib/URL/Grammar/Actions.pm6 | 47 +++++++++++++++++ t/01-grammar.t | 61 +++++++++++++++++++++ t/02-actions.t.t | 77 +++++++++++++++++++++++++++ t/03-instantiation.t | 94 +++++++++++++++++++++++++++++++++ t/04-stringification.t | 38 +++++++++++++ 13 files changed, 603 insertions(+) create mode 100644 .editorconfig create mode 100644 .gitignore create mode 100644 .gitlab-ci.yml create mode 100644 CHANGELOG.md create mode 100644 META6.json create mode 100644 README.pod6 create mode 100644 lib/URL.pm6 create mode 100644 lib/URL/Grammar.pm6 create mode 100644 lib/URL/Grammar/Actions.pm6 create mode 100644 t/01-grammar.t create mode 100644 t/02-actions.t.t create mode 100644 t/03-instantiation.t create mode 100644 t/04-stringification.t diff --git a/.editorconfig b/.editorconfig new file mode 100644 index 0000000..74dde7f --- /dev/null +++ b/.editorconfig @@ -0,0 +1,16 @@ +[*] +charset = utf-8 +end_of_line = lf +insert_final_newline = true +indent_style = tab +indent_size = 4 + +[*.json] +indent_style = space +indent_size = 2 + +[*.yml] +indent_style = space +indent_size = 2 + +# vim: ft=dosini diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..93356c2 --- /dev/null +++ b/.gitignore @@ -0,0 +1,14 @@ +## Perl 6 precompilation files ## +.precomp + +## Editor files ## + +# emacs +*~ + +# vim +.*.sw? + +# comma +.idea +*.iml diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml new file mode 100644 index 0000000..361902e --- /dev/null +++ b/.gitlab-ci.yml @@ -0,0 +1,23 @@ +URL: + only: + - master + image: rakudo-star + before_script: + - zef install . --deps-only --test-depends --/test + script: AUTHOR_TESTING=1 prove -v -e "perl6 -Ilib" t + artifacts: + name: "perl6-URL" + paths: + - META6.json + - bin + - lib + - resources + - t + +test: + except: + - master + image: rakudo-star + before_script: + - zef install . --deps-only --test-depends --/test + script: AUTHOR_TESTING=1 prove -v -e "perl6 -Ilib" t diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 index 0000000..c073e0e --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,9 @@ +# Changelog +All notable changes to this project will be documented in this file. + +The format is based on [Keep a Changelog](http://keepachangelog.com/en/1.0.0/) +and this project adheres to [Semantic +Versioning](http://semver.org/spec/v2.0.0.html). + +## [0.1.0] - 2019-04-08 +- Initial release diff --git a/META6.json b/META6.json new file mode 100644 index 0000000..f938a5a --- /dev/null +++ b/META6.json @@ -0,0 +1,27 @@ +{ + "api": "0", + "authors": [ + "Patrick Spek " + ], + "depends": [ + + ], + "description": "A Perl 6 library to handle URLs", + "license": "AGPL-3.0", + "meta-version": 0, + "name": "URL", + "perl": "6.d", + "provides": { + "URL": "lib/URL.pm6", + "URL::Grammar": "lib/URL/Grammar.pm6", + "URL::Grammar::Actions": "lib/URL/Grammar/Actions.pm6" + }, + "resources": [ + + ], + "source-url": "https://git.tyil.nl/perl6/url", + "tags": [ + + ], + "version": "0.1.0" +} \ No newline at end of file diff --git a/README.pod6 b/README.pod6 new file mode 100644 index 0000000..625b63b --- /dev/null +++ b/README.pod6 @@ -0,0 +1,23 @@ +=begin pod + +=NAME URL +=AUTHOR Patrick Spek +=VERSION 0.0.0 + +=head1 Description + +A Perl 6 library to handle URLs + +=head1 Installation + +Install this module through L: + +=begin code :lang +zef install URL +=end code + +=head1 License + +This module is distributed under the terms of the AGPL-3.0. + +=end pod diff --git a/lib/URL.pm6 b/lib/URL.pm6 new file mode 100644 index 0000000..57235b4 --- /dev/null +++ b/lib/URL.pm6 @@ -0,0 +1,126 @@ +#! /usr/bin/env false + +use v6.d; + +use URL::Grammar; +use URL::Grammar::Actions; + +unit class URL; + +has Str $.scheme; +has Str $.username; +has Str $.password; +has Str $.hostname; +has Int $.port; +has @.path; +has %.query; +has Str $.fragment; + +multi method new ( + Str:D $url, +) { + my %match = URL::Grammar.parse($url, actions => URL::Grammar::Actions).made; + + die "'$url' failed to parse. Please report the URL you tried to p.spek+perl6@tyil.work." unless %match; + + samewith( + |%match, + path => %match.list + ); +} + +multi method new ( + Str :$scheme, + Str :$username, + Str :$password, + Str :$hostname, + Int :$port, + :@path = [], + :%query = {}, + Str :$fragment, +) { + self.bless( + :$scheme, + :$username, + :$password, + :$hostname, + :$port, + :@path, + :%query, + :$fragment, + ); +} + +method Hash ( + --> Hash +) { + { + :$!scheme, + :$!username, + :$!password, + :$!hostname, + :$!port, + :@!path, + :%!query, + :$!fragment, + } +} + +multi method Str ( + --> Str +) { + my $s = $!scheme ~ "://"; + + $s ~= "{self.Str(:userinfo)}@" if $!username; + $s ~= $!hostname; + $s ~= ":$!port" if $!port; + $s ~= "/{self.Str(:path)}" if @!path; + $s ~= "?{self.Str(:query)}" if %!query; + $s ~= "#$!fragment" if $!fragment; + + $s; +} + +multi method Str ( + :$path! where { $_ }, + + --> Str +) { + @!path.join("/"); +} + +multi method Str ( + :$query! where { $_ }, + + --> Str +) { + %!query.keys.sort.map({ "$_={%!query{$_}}" }).join("&") +} + +multi method Str ( + :$userinfo! where { $_ }, + + --> Str +) { + return "$!username:$!password" if $!password; + + $!username // ""; +} + +=begin pod + +=NAME URL +=AUTHOR Patrick Spek +=VERSION 0.1.0 + +=head1 Synopsis + +=head1 Description + +=head1 Examples + +=head1 See also + +=end pod + +# vim: ft=perl6 noet diff --git a/lib/URL/Grammar.pm6 b/lib/URL/Grammar.pm6 new file mode 100644 index 0000000..cc9f13c --- /dev/null +++ b/lib/URL/Grammar.pm6 @@ -0,0 +1,48 @@ +#! /usr/bin/env false + +use v6.d; + +unit grammar URL::Grammar; + +token TOP { + [ ":" ]? + "//"? + [ "@" ]? + ? + ? + [ "?" ]? + [ "#" ]? +} + +token scheme { <[ a..z ]> <[ a..z 0..9 . + - ]>* } +token userinfo { [ ":" ] } +token username { <-[ : @ ]>+ } +token password { <-[ @ ]>+ } +token host { [ ":" ]? } +token hostname { [ <-[ / : # ? \h ]>+ | "[" <-[ \] ]>+ "]" ] } +token port { \d ** 1..5 } +token path { "/" * % "/" } +token path-part { <-[ / ? # ]>+ } +token query { * % "&" } +token query-part { "=" } +token query-part-key { <-[ = # & ]>+ } +token query-part-value { <-[ # & ]>+ } +token fragment { <-[ \s ]>+ } + +=begin pod + +=NAME URL::Grammar +=AUTHOR Patrick Spek +=VERSION 0.1.0 + +=head1 Synopsis + +=head1 Description + +=head1 Examples + +=head1 See also + +=end pod + +# vim: ft=perl6 noet diff --git a/lib/URL/Grammar/Actions.pm6 b/lib/URL/Grammar/Actions.pm6 new file mode 100644 index 0000000..2015073 --- /dev/null +++ b/lib/URL/Grammar/Actions.pm6 @@ -0,0 +1,47 @@ +#! /usr/bin/env false + +use v6.d; + +unit class URL::Grammar::Actions; + +method TOP ($/) +{ + make { + scheme => $/.made // Str, + username => $/.made // Str, + password => $/.made // Str, + hostname => $/.made // Str, + port => $/.made // Int, + path => $/.made // [], + query => $/.made // {}, + fragment => $/.made // Str, + } +} + +method scheme ($/) { make ~$/ } +method username ($/) { make ~$/ } +method password ($/) { make ~$/ } +method hostname ($/) { make ~$/ } +method port ($/) { make +$/ } +method path ($/) { make $/».Str } +method query ($/) { make $/».made } +method query-part ($/) { make $/.Str => $/.Str } +method fragment ($/) { make ~$/ } + +=begin pod + +=NAME URL::Grammar::Actions +=AUTHOR Patrick Spek +=VERSION 0.1.0 + +=head1 Synopsis + +=head1 Description + +=head1 Examples + +=head1 See also + +=end pod + +# vim: ft=perl6 noet diff --git a/t/01-grammar.t b/t/01-grammar.t new file mode 100644 index 0000000..a84bf86 --- /dev/null +++ b/t/01-grammar.t @@ -0,0 +1,61 @@ +#! /usr/bin/env perl6 + +use v6.d; + +use URL::Grammar; +use Test; + +plan 2; + +subtest "https://www.tyil.nl", { + plan 8; + + my $match = URL::Grammar.parse("https://www.tyil.nl"); + + is ~$match, "https", "Scheme is 'https'"; + nok $match, "URL contains no username"; + nok $match, "URL contains no password"; + is ~$match, "www.tyil.nl", "Hostname is 'www.tyil.nl'"; + nok $match, "URL contains no port"; + nok $match, "URL contains no path"; + nok $match, "URL contains no query"; + nok $match, "URL contains no fragment"; +}; + +subtest "https://tyil:donthackme\@www.tyil.nl:8443/a/path/part?foo=bar&perl=6#module", { + plan 8; + + my $match = URL::Grammar.parse("https://tyil:donthackme\@www.tyil.nl:8443/a/path/part?foo=bar&perl=6#module"); + + is ~$match, "https", "Scheme is 'https'"; + is ~$match, "tyil", "Username is 'tyil'"; + is ~$match, "donthackme", "Password is 'donthackme'"; + is ~$match, "www.tyil.nl", "Hostname is 'www.tyil.nl'"; + is +$match, 8443, "Port is 8443"; + is ~$match, "module", "Fragment is 'module'"; + + subtest "path", { + plan 4; + + my @path = $match; + + is @path.elems, 3, "Path consists of 3 parts"; + is @path[0], "a", "Part 0 is 'a'"; + is @path[1], "path", "Part 1 is 'path'"; + is @path[2], "part", "Part 2 is 'part'"; + } + + subtest "query", { + plan 5; + + my @query = $match; + + is @query.elems, 2, "Query consists of 2 parts"; + is @query[0], "foo", "Part 0's key is 'foo'"; + is @query[0], "bar", "Part 0's value is 'bar'"; + is @query[1], "perl", "Part 1's key is 'perl'"; + is @query[1], "6", "Part 1's value is '6'"; + } +} + +# vim: ft=perl6 noet diff --git a/t/02-actions.t.t b/t/02-actions.t.t new file mode 100644 index 0000000..8eae227 --- /dev/null +++ b/t/02-actions.t.t @@ -0,0 +1,77 @@ +#! /usr/bin/env perl6 + +use v6.d; + +use URL::Grammar; +use URL::Grammar::Actions; + +use Test; + +plan 2; + +subtest "https://www.tyil.nl", { + plan 8; + + my %match = URL::Grammar.parse("https://www.tyil.nl", actions => URL::Grammar::Actions.new).made; + + is %match, "https", "Scheme is 'https'"; + is %match, "www.tyil.nl", "Hostname is 'www.tyil.nl'"; + + nok %match, "URL contains no username"; + nok %match, "URL contains no password"; + nok %match, "URL contains no port"; + nok %match, "URL contains no path"; + nok %match, "URL contains no query"; + nok %match, "URL contains no fragment"; +}; + +subtest "https://tyil:donthackme\@www.tyil.nl:8443/a/path/part?foo=bar&perl=6#module", { + plan 8; + + my %match = URL::Grammar.parse( + "https://tyil:donthackme\@www.tyil.nl:8443/a/path/part?foo=bar&perl=6#module", + actions => URL::Grammar::Actions.new, + ).made; + + is %match, "https", "Scheme is 'https'"; + is %match, "tyil", "Username is 'tyil'"; + is %match, "donthackme", "Password is 'donthackme'"; + is %match, "www.tyil.nl", "Hostname is 'www.tyil.nl'"; + is %match, 8443, "Port is 8443"; + is %match, "module", "Fragment is 'module'"; + + subtest "path", { + plan 4; + + my @path = %match.list; + + is @path.elems, 3, "Path consists of 3 parts"; + is @path[0], "a", "Part 0 is 'a'"; + is @path[1], "path", "Part 1 is 'path'"; + is @path[2], "part", "Part 2 is 'part'"; + } + + subtest "query", { + plan 3; + + my %query = %match.hash; + + is %query.elems, 2, "Query consists of 2 parts"; + + subtest "foo", { + plan 2; + + ok %query:exists, "Query has a key 'foo'"; + is %query, "bar", "Value for 'foo' is 'bar'"; + } + + subtest "perl", { + plan 2; + + ok %query:exists, "Query has a key 'perl'"; + is %query, "6", "Value for 'perl' is '6'"; + } + } +} + +# vim: ft=perl6 noet diff --git a/t/03-instantiation.t b/t/03-instantiation.t new file mode 100644 index 0000000..15b7efa --- /dev/null +++ b/t/03-instantiation.t @@ -0,0 +1,94 @@ +#! /usr/bin/env perl6 + +use v6.d; + +use Test; +use URL; + +plan 2; + +subtest "Object oriented", { + plan 2; + + subtest "https://www.tyil.nl", { + plan 8; + + my $url = URL.new( + scheme => "https", + hostname => "www.tyil.nl", + ); + + is $url.username, Str, "Username is empty"; + is $url.password, Str, "Password is emtpy"; + is $url.port, Int, "Port is empty"; + is $url.path, [], "Path is empty"; + is $url.query, {}, "Query is empty"; + is $url.fragment, Str, "Fragment is empty"; + + is $url.scheme, "https", "Scheme is 'https'"; + is $url.hostname, "www.tyil.nl", "Host is 'www.tyil.nl'"; + } + + subtest "https://tyil:donthackme\@www.tyil.nl:8443/a/path/part?foo=bar&perl=6#module", { + plan 8; + + my $url = URL.new( + scheme => "https", + username => "tyil", + password => "donthackme", + hostname => "www.tyil.nl", + port => 8443, + path => ["a", "path", "part"], + query => { foo => "bar", perl => "6" }, + fragment => "module", + ); + + is $url.scheme, "https", "Scheme is https"; + is $url.username, "tyil", "Username is 'tyil'"; + is $url.password, "donthackme", "Password is 'donthackme'"; + is $url.hostname, "www.tyil.nl", "Host is www.tyil.nl"; + is $url.port, 8443, "Port is 8443"; + is $url.fragment, "module", "Fragment is 'module'"; + + subtest "path", { + plan 4; + + my @path = $url.path; + + is @path.elems, 3, "URL path part contains 3 elements"; + is @path[0], "a", "URL path part 0 is 'a'"; + is @path[1], "path", "URL path part 1 is 'path'"; + is @path[2], "part", "URL path part 2 is 'part'"; + } + + subtest "query", { + plan 3; + + my %query = $url.query; + + is %query.elems, 2, "URL query part contains 2 elements"; + is %query, "bar", "foo query is bar"; + is %query, "6", "perl query is 6"; + } + } +} + +subtest "Grammar", { + subtest "https://www.tyil.nl", { + plan 8; + + my $url = URL.new("https://www.tyil.nl"); + + is $url.username, Str, "Username is empty"; + is $url.password, Str, "Password is emtpy"; + is $url.port, Int, "Port is empty"; + is $url.path, [], "Path is empty"; + is $url.query, {}, "Query is empty"; + is $url.fragment, Str, "Fragment is empty"; + + is $url.scheme, "https", "Scheme is 'https'"; + is $url.hostname, "www.tyil.nl", "Host is 'www.tyil.nl'"; + } +} + +# vim: ft=perl6 noet diff --git a/t/04-stringification.t b/t/04-stringification.t new file mode 100644 index 0000000..4a50e5a --- /dev/null +++ b/t/04-stringification.t @@ -0,0 +1,38 @@ +#! /usr/bin/env perl6 + +use v6.d; + +use Test; +use URL; + +plan 2; + +subtest "https://www.tyil.nl", { + plan 4; + + my $url = URL.new( + scheme => "https", + hostname => "www.tyil.nl", + ); + + is $url.Str(:path), "", "Str(:path) = ''"; + is $url.Str(:query), "", "Str(:query) = ''"; + is $url.Str(:userinfo), "", "Str(:userinfo) = ''"; + is ~$url, "https://www.tyil.nl", "Str() = 'https://www.tyil.nl'"; +} + +subtest "https://tyil:donthackme\@www.tyil.nl:8443/a/path/part?foo=bar&perl=6#module", { + plan 4; + + my $url = URL.new("https://tyil:donthackme\@www.tyil.nl:8443/a/path/part?foo=bar&perl=6#module"); + + is $url.Str(:path), "a/path/part", "Str(:path) = 'a/path/part'"; + is $url.Str(:query), "foo=bar&perl=6", "Str(:query) = 'foo=bar&perl=6'"; + is $url.Str(:userinfo), "tyil:donthackme", "Str(:userinfo) = 'tyil:donthackme'"; + is ~$url, + "https://tyil:donthackme\@www.tyil.nl:8443/a/path/part?foo=bar&perl=6#module", + "Str() = 'https://tyil:donthackme\@www.tyil.nl:8443/a/path/part?foo=bar&perl=6#module'" + ; +} + +# vim: ft=perl6 noet -- cgit v1.1