aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorPatrick Spek <p.spek@tyil.nl>2019-04-08 19:30:35 +0200
committerPatrick Spek <p.spek@tyil.nl>2019-04-08 19:30:35 +0200
commit1bd1dff6d449ab221e191679fd8ec516b7cc1d4e (patch)
treedbb9afa885183300b40e7cd9c29dc892aa4635c3
downloadURL-1bd1dff6d449ab221e191679fd8ec516b7cc1d4e.tar.gz
URL-1bd1dff6d449ab221e191679fd8ec516b7cc1d4e.tar.bz2
Initial commit
-rw-r--r--.editorconfig16
-rw-r--r--.gitignore14
-rw-r--r--.gitlab-ci.yml23
-rw-r--r--CHANGELOG.md9
-rw-r--r--META6.json27
-rw-r--r--README.pod623
-rw-r--r--lib/URL.pm6126
-rw-r--r--lib/URL/Grammar.pm648
-rw-r--r--lib/URL/Grammar/Actions.pm647
-rw-r--r--t/01-grammar.t61
-rw-r--r--t/02-actions.t.t77
-rw-r--r--t/03-instantiation.t94
-rw-r--r--t/04-stringification.t38
13 files changed, 603 insertions, 0 deletions
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 <p.spek@tyil.work>"
+ ],
+ "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 <p.spek@tyil.work>
+=VERSION 0.0.0
+
+=head1 Description
+
+A Perl 6 library to handle URLs
+
+=head1 Installation
+
+Install this module through L<zef|https://github.com/ugexe/zef>:
+
+=begin code :lang<sh>
+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<path>.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 <p.spek@tyil.work>
+=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 {
+ [ <scheme> ":" ]?
+ "//"?
+ [ <userinfo> "@" ]?
+ <host>?
+ <path>?
+ [ "?" <query> ]?
+ [ "#" <fragment> ]?
+}
+
+token scheme { <[ a..z ]> <[ a..z 0..9 . + - ]>* }
+token userinfo { <username> [ ":" <password> ] }
+token username { <-[ : @ ]>+ }
+token password { <-[ @ ]>+ }
+token host { <hostname> [ ":" <port> ]? }
+token hostname { [ <-[ / : # ? \h ]>+ | "[" <-[ \] ]>+ "]" ] }
+token port { \d ** 1..5 }
+token path { "/" <part=.path-part>* % "/" }
+token path-part { <-[ / ? # ]>+ }
+token query { <part=.query-part>* % "&" }
+token query-part { <key=.query-part-key> "=" <value=.query-part-value> }
+token query-part-key { <-[ = # & ]>+ }
+token query-part-value { <-[ # & ]>+ }
+token fragment { <-[ \s ]>+ }
+
+=begin pod
+
+=NAME URL::Grammar
+=AUTHOR Patrick Spek <p.spek@tyil.work>
+=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 => $/<scheme>.made // Str,
+ username => $/<userinfo><username>.made // Str,
+ password => $/<userinfo><password>.made // Str,
+ hostname => $/<host><hostname>.made // Str,
+ port => $/<host><port>.made // Int,
+ path => $/<path>.made // [],
+ query => $/<query>.made // {},
+ fragment => $/<fragment>.made // Str,
+ }
+}
+
+method scheme ($/) { make ~$/ }
+method username ($/) { make ~$/ }
+method password ($/) { make ~$/ }
+method hostname ($/) { make ~$/ }
+method port ($/) { make +$/ }
+method path ($/) { make $/<part>».Str }
+method query ($/) { make $/<part>».made }
+method query-part ($/) { make $/<key>.Str => $/<value>.Str }
+method fragment ($/) { make ~$/ }
+
+=begin pod
+
+=NAME URL::Grammar::Actions
+=AUTHOR Patrick Spek <p.spek@tyil.work>
+=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<scheme>, "https", "Scheme is 'https'";
+ nok $match<userinfo><username>, "URL contains no username";
+ nok $match<userinfo><password>, "URL contains no password";
+ is ~$match<host><hostname>, "www.tyil.nl", "Hostname is 'www.tyil.nl'";
+ nok $match<host><port>, "URL contains no port";
+ nok $match<path>, "URL contains no path";
+ nok $match<query>, "URL contains no query";
+ nok $match<fragment>, "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<scheme>, "https", "Scheme is 'https'";
+ is ~$match<userinfo><username>, "tyil", "Username is 'tyil'";
+ is ~$match<userinfo><password>, "donthackme", "Password is 'donthackme'";
+ is ~$match<host><hostname>, "www.tyil.nl", "Hostname is 'www.tyil.nl'";
+ is +$match<host><port>, 8443, "Port is 8443";
+ is ~$match<fragment>, "module", "Fragment is 'module'";
+
+ subtest "path", {
+ plan 4;
+
+ my @path = $match<path><part>;
+
+ 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<query><part>;
+
+ is @query.elems, 2, "Query consists of 2 parts";
+ is @query[0]<key>, "foo", "Part 0's key is 'foo'";
+ is @query[0]<value>, "bar", "Part 0's value is 'bar'";
+ is @query[1]<key>, "perl", "Part 1's key is 'perl'";
+ is @query[1]<value>, "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<scheme>, "https", "Scheme is 'https'";
+ is %match<hostname>, "www.tyil.nl", "Hostname is 'www.tyil.nl'";
+
+ nok %match<username>, "URL contains no username";
+ nok %match<password>, "URL contains no password";
+ nok %match<port>, "URL contains no port";
+ nok %match<path>, "URL contains no path";
+ nok %match<query>, "URL contains no query";
+ nok %match<fragment>, "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<scheme>, "https", "Scheme is 'https'";
+ is %match<username>, "tyil", "Username is 'tyil'";
+ is %match<password>, "donthackme", "Password is 'donthackme'";
+ is %match<hostname>, "www.tyil.nl", "Hostname is 'www.tyil.nl'";
+ is %match<port>, 8443, "Port is 8443";
+ is %match<fragment>, "module", "Fragment is 'module'";
+
+ subtest "path", {
+ plan 4;
+
+ my @path = %match<path>.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<query>.hash;
+
+ is %query.elems, 2, "Query consists of 2 parts";
+
+ subtest "foo", {
+ plan 2;
+
+ ok %query<foo>:exists, "Query has a key 'foo'";
+ is %query<foo>, "bar", "Value for 'foo' is 'bar'";
+ }
+
+ subtest "perl", {
+ plan 2;
+
+ ok %query<perl>:exists, "Query has a key 'perl'";
+ is %query<perl>, "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<foo>, "bar", "foo query is bar";
+ is %query<perl>, "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