[Gd-chatter] r11679 - in trunk/libraries: registry/generic uri uri/uri-test
turbo24prg at gwydiondylan.org
turbo24prg at gwydiondylan.org
Sun Feb 17 18:31:02 CET 2008
Author: turbo24prg
Date: Sun Feb 17 18:31:02 2008
New Revision: 11679
Added:
trunk/libraries/registry/generic/uri (contents, props changed)
trunk/libraries/uri/
trunk/libraries/uri/library.dylan (contents, props changed)
trunk/libraries/uri/uri-test/
trunk/libraries/uri/uri-test/library.dylan (contents, props changed)
trunk/libraries/uri/uri-test/uri-test.dylan (contents, props changed)
trunk/libraries/uri/uri-test/uri-test.hdp (contents, props changed)
trunk/libraries/uri/uri-test/uri-test.lid (contents, props changed)
trunk/libraries/uri/uri.dylan (contents, props changed)
trunk/libraries/uri/uri.lid (contents, props changed)
Log:
Job: 7370
initial checkin
Added: trunk/libraries/registry/generic/uri
==============================================================================
--- (empty file)
+++ trunk/libraries/registry/generic/uri Sun Feb 17 18:31:02 2008
@@ -0,0 +1 @@
+abstract://dylan/uri/uri.lid
Added: trunk/libraries/uri/library.dylan
==============================================================================
--- (empty file)
+++ trunk/libraries/uri/library.dylan Sun Feb 17 18:31:02 2008
@@ -0,0 +1,36 @@
+module: dylan-user
+
+define library uri
+ use common-dylan;
+ use collection-extensions;
+ use io;
+ use regular-expressions;
+ export uri;
+end library;
+
+define module uri
+ use common-dylan;
+ use common-extensions;
+ use vector-search;
+ use subseq;
+ use format;
+ use format-out;
+ use regular-expressions;
+ use streams;
+ export <uri>, <url>,
+ uri-scheme, uri-scheme-setter,
+ uri-userinfo, uri-userinfo-setter,
+ uri-host, uri-host-setter,
+ uri-port, uri-port-setter,
+ uri-path, uri-path-setter,
+ uri-query, uri-query-setter,
+ uri-fragment, uri-fragment-setter,
+ uri-authority, uri-authority-setter;
+ export parse-uri, parse-url,
+ build-uri, transform-uris,
+ build-path, build-query;
+ export remove-dot-segments,
+ split-path, split-query;
+ export absolute?, relative?;
+ export print-message;
+end module;
Added: trunk/libraries/uri/uri-test/library.dylan
==============================================================================
--- (empty file)
+++ trunk/libraries/uri/uri-test/library.dylan Sun Feb 17 18:31:02 2008
@@ -0,0 +1,13 @@
+module: dylan-user
+
+define library uri-test
+ use common-dylan;
+ use testworks;
+ use uri;
+end library uri-test;
+
+define module uri-test
+ use common-dylan;
+ use testworks;
+ use uri;
+end module uri-test;
Added: trunk/libraries/uri/uri-test/uri-test.dylan
==============================================================================
--- (empty file)
+++ trunk/libraries/uri/uri-test/uri-test.dylan Sun Feb 17 18:31:02 2008
@@ -0,0 +1,263 @@
+module: uri-test
+
+define macro uri-reference-test-definer
+ { define uri-reference-test ?name:token
+ ?uri:token
+ ( ?scheme:token , ?authority:token ,
+ ?path:token , ?query:token ,
+ ?fragment:token )
+ => ?result:token
+ end
+ }
+ =>
+ {
+ define test "uri-reference-" ## ?name ()
+ let uri = parse-uri(?uri);
+ check-equal("scheme", uri.uri-scheme, ?scheme);
+ check-equal("authority", uri.uri-authority, ?authority);
+ check-equal("path", build-path(uri), ?path);
+ check-equal("query", build-query(uri), ?query);
+ check-equal("fragment", uri.uri-fragment, ?fragment);
+ let target-uri = transform-uris($base-uri, uri);
+ check-equal("target-uri", build-uri(target-uri), ?result);
+ end
+ }
+end macro;
+
+define suite uri-suite ()
+ suite uri-transform-suite;
+ suite uri-normalization-suite;
+end;
+
+define suite uri-transform-suite ()
+ test uri-base-test;
+ suite uri-transform-normal-suite;
+ suite uri-transform-abnormal-suite
+end;
+
+define constant $base-uri = parse-uri("http://a/b/c/d;p?q");
+
+define test uri-base-test ()
+ check-equal("base-uri scheme", $base-uri.uri-scheme, "http");
+ check-equal("base-uri authority", $base-uri.uri-authority, "a");
+ check-equal("base-uri path", build-path($base-uri), "/b/c/d;p");
+ check-equal("base-uri query", build-query($base-uri), "q");
+ check-equal("base-uri fragment", $base-uri.uri-fragment, "");
+end;
+
+define suite uri-transform-normal-suite ()
+ test uri-reference-normal-test-1;
+ test uri-reference-normal-test-2;
+ test uri-reference-normal-test-3;
+ test uri-reference-normal-test-4;
+ test uri-reference-normal-test-5;
+ test uri-reference-normal-test-6;
+ test uri-reference-normal-test-7;
+ test uri-reference-normal-test-8;
+ test uri-reference-normal-test-9;
+ test uri-reference-normal-test-10;
+ test uri-reference-normal-test-11;
+ test uri-reference-normal-test-12;
+ test uri-reference-normal-test-13;
+ test uri-reference-normal-test-14;
+ test uri-reference-normal-test-15;
+ test uri-reference-normal-test-16;
+ test uri-reference-normal-test-17;
+ test uri-reference-normal-test-18;
+ test uri-reference-normal-test-19;
+ test uri-reference-normal-test-20;
+ test uri-reference-normal-test-21;
+ test uri-reference-normal-test-22;
+ test uri-reference-normal-test-23;
+end;
+
+define uri-reference-test normal-test-1
+ "g:h" ("g", "", "h", "", "") => "g:h"
+end;
+
+define uri-reference-test normal-test-2
+ "g" ("", "", "g", "", "") => "http://a/b/c/g"
+end;
+
+define uri-reference-test normal-test-3
+ "./g" ("", "", "./g", "", "") => "http://a/b/c/g"
+end;
+
+define uri-reference-test normal-test-4
+ "g/" ("", "", "g/", "", "") => "http://a/b/c/g/"
+end;
+
+define uri-reference-test normal-test-5
+ "/g" ("", "", "/g", "", "") => "http://a/g"
+end;
+
+define uri-reference-test normal-test-6
+ "//g" ("", "g", "", "", "") => "http://g"
+end;
+
+define uri-reference-test normal-test-7
+ "?y" ("", "", "", "y", "") => "http://a/b/c/d;p?y"
+end;
+
+define uri-reference-test normal-test-8
+ "g?y" ("", "", "g", "y", "") => "http://a/b/c/g?y"
+end;
+
+define uri-reference-test normal-test-9
+ "#s" ("", "", "", "", "s") => "http://a/b/c/d;p?q#s"
+end;
+
+define uri-reference-test normal-test-10
+ "g#s" ("", "", "g", "", "s") => "http://a/b/c/g#s"
+end;
+
+define uri-reference-test normal-test-11
+ "g?y#s" ("", "", "g", "y", "s") => "http://a/b/c/g?y#s"
+end;
+
+define uri-reference-test normal-test-12
+ ";x" ("", "", ";x", "", "") => "http://a/b/c/;x"
+end;
+
+define uri-reference-test normal-test-13
+ "g;x" ("", "", "g;x", "", "") => "http://a/b/c/g;x"
+end;
+
+define uri-reference-test normal-test-14
+ "g;x?y#s" ("", "", "g;x", "y", "s") => "http://a/b/c/g;x?y#s"
+end;
+
+define uri-reference-test normal-test-15
+ "" ("", "", "", "", "") => "http://a/b/c/d;p?q"
+end;
+
+define uri-reference-test normal-test-16
+ "." ("", "", ".", "", "") => "http://a/b/c/"
+end;
+
+define uri-reference-test normal-test-17
+ "./" ("", "", "./", "", "") => "http://a/b/c/"
+end;
+
+define uri-reference-test normal-test-18
+ ".." ("", "", "..", "", "") => "http://a/b/"
+end;
+
+define uri-reference-test normal-test-19
+ "../" ("", "", "../", "", "") => "http://a/b/"
+end;
+
+define uri-reference-test normal-test-20
+ "../g" ("", "", "../g", "", "") => "http://a/b/g"
+end;
+
+define uri-reference-test normal-test-21
+ "../.." ("", "", "../..", "", "") => "http://a/"
+end;
+
+define uri-reference-test normal-test-22
+ "../../" ("", "", "../../", "", "") => "http://a/"
+end;
+
+define uri-reference-test normal-test-23
+ "../../g" ("", "", "../../g", "", "") => "http://a/g"
+end;
+
+define suite uri-transform-abnormal-suite ()
+ test uri-reference-abnormal-test-1;
+ test uri-reference-abnormal-test-2;
+ test uri-reference-abnormal-test-3;
+ test uri-reference-abnormal-test-4;
+ test uri-reference-abnormal-test-5;
+ test uri-reference-abnormal-test-6;
+ test uri-reference-abnormal-test-7;
+ test uri-reference-abnormal-test-8;
+ test uri-reference-abnormal-test-9;
+ test uri-reference-abnormal-test-10;
+ test uri-reference-abnormal-test-11;
+ test uri-reference-abnormal-test-12;
+ test uri-reference-abnormal-test-13;
+ test uri-reference-abnormal-test-14;
+end;
+
+define uri-reference-test abnormal-test-1
+ "../../../g" ("", "", "../../../g", "", "") => "http://a/g"
+end;
+
+define uri-reference-test abnormal-test-2
+ "../../../../g" ("", "", "../../../../g", "", "") => "http://a/g"
+end;
+
+define uri-reference-test abnormal-test-3
+ "/./g" ("", "", "/./g", "", "") => "http://a/g"
+end;
+
+define uri-reference-test abnormal-test-4
+ "/../g" ("", "", "/../g", "", "") => "http://a/g"
+end;
+
+define uri-reference-test abnormal-test-5
+ "g." ("", "", "g.", "", "") => "http://a/b/c/g."
+end;
+
+define uri-reference-test abnormal-test-6
+ ".g" ("", "", ".g", "", "") => "http://a/b/c/.g"
+end;
+
+define uri-reference-test abnormal-test-7
+ "g.." ("", "", "g..", "", "") => "http://a/b/c/g.."
+end;
+
+define uri-reference-test abnormal-test-8
+ "..g" ("", "", "..g", "", "") => "http://a/b/c/..g"
+end;
+
+define uri-reference-test abnormal-test-9
+ "./../g" ("", "", "./../g", "", "") => "http://a/b/g"
+end;
+
+define uri-reference-test abnormal-test-10
+ "./g/." ("", "", "./g/.", "", "") => "http://a/b/c/g/"
+end;
+
+define uri-reference-test abnormal-test-11
+ "g/./h" ("", "", "g/./h", "", "") => "http://a/b/c/g/h"
+end;
+
+define uri-reference-test abnormal-test-12
+ "g/../h" ("", "", "g/../h", "", "") => "http://a/b/c/h"
+end;
+
+define uri-reference-test abnormal-test-13
+ "g;x=1/./y" ("", "", "g;x=1/./y", "", "") => "http://a/b/c/g;x=1/y"
+end;
+
+define uri-reference-test abnormal-test-14
+ "g;x=1/../y" ("", "", "g;x=1/../y", "", "") => "http://a/b/c/y"
+end;
+
+define suite uri-normalization-suite ()
+ test uri-path-segment-normalization-test;
+end;
+
+define test uri-path-segment-normalization-test ()
+ check-equal("path", "/a/c", remove-dot-segments("/a/b/../c"));
+ check-equal("path", "/a/b/c", remove-dot-segments("/a/b/./c"));
+ check-equal("path", "/a/c", remove-dot-segments("/a/./b/../c"));
+ check-equal("path", "/b/c", remove-dot-segments("/a/../b/./c"));
+ check-equal("path", "/a/c", remove-dot-segments("/a/b/./../c"));
+ check-equal("path", "/a/c", remove-dot-segments("/a/b/.././c"));
+ check-equal("path", "/b/c", remove-dot-segments("/a/../../../b/c"));
+
+ check-equal("path", "a/c", remove-dot-segments("a/b/../c"));
+ check-equal("path", "a/b/c", remove-dot-segments("a/b/./c"));
+ check-equal("path", "a/c", remove-dot-segments("a/./b/../c"));
+ check-equal("path", "b/c", remove-dot-segments("a/../b/./c"));
+ check-equal("path", "a/c", remove-dot-segments("a/b/./../c"));
+ check-equal("path", "a/c", remove-dot-segments("a/b/.././c"));
+ check-equal("path", "b/c", remove-dot-segments("a/../../../b/c"));
+end;
+
+begin
+ run-test-application(uri-suite); //, arguments: #("-debug"));
+end;
Added: trunk/libraries/uri/uri-test/uri-test.hdp
==============================================================================
--- (empty file)
+++ trunk/libraries/uri/uri-test/uri-test.hdp Sun Feb 17 18:31:02 2008
@@ -0,0 +1,4 @@
+library: uri-test
+synopsis: test library for uri
+files: library
+ uri-test
Added: trunk/libraries/uri/uri-test/uri-test.lid
==============================================================================
--- (empty file)
+++ trunk/libraries/uri/uri-test/uri-test.lid Sun Feb 17 18:31:02 2008
@@ -0,0 +1,4 @@
+library: uri-test
+synopsis: test library for uri
+files: library
+ uri-test
Added: trunk/libraries/uri/uri.dylan
==============================================================================
--- (empty file)
+++ trunk/libraries/uri/uri.dylan Sun Feb 17 18:31:02 2008
@@ -0,0 +1,367 @@
+module: uri
+author: turbo24prg
+synopsis: RFC 3986: Uniform Resource Identifier (URI): Generic Syntax
+
+define class <uri> (<object>)
+ slot uri-scheme :: <string> = "",
+ init-keyword: scheme:;
+ slot uri-userinfo :: <string> = "",
+ init-keyword: userinfo:;
+ slot uri-host :: <string> = "",
+ init-keyword: host:;
+ slot uri-port :: false-or(<integer>) = #f,
+ init-keyword: port:;
+ slot uri-path :: <deque> = make(<deque>),
+ init-keyword: path:;
+ // keys without vaule are #t
+ slot uri-query :: <string-table> = make(<string-table>),
+ init-keyword: query:;
+ slot uri-fragment :: <string> = "",
+ init-keyword: fragment:;
+end;
+
+define class <url> (<uri>) end;
+
+define method uri-authority (uri :: <uri>) => (result :: <string>);
+ let result = "";
+ unless (empty?(uri.uri-userinfo))
+ result := concatenate(result, percent-encode(#"userinfo", uri.uri-userinfo), "@");
+ end;
+ result := concatenate(result, uri.uri-host | "");
+ if (uri.uri-port)
+ result := concatenate(result, ":", integer-to-string(uri.uri-port));
+ end if;
+ result;
+end;
+
+define constant $alpha =
+ #('A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M',
+ 'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z',
+ 'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm',
+ 'n', 'o', 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', 'x', 'y', 'z');
+define constant $digit = #('0', '1', '2', '3', '4', '5', '6', '7', '8', '9');
+
+define constant $uri-parts :: <table> = make(<table>);
+
+define constant $uri-scheme = concatenate($alpha, $digit, #('+', '-', '.'));
+define constant $uri-gen-delims = #(':', '/', '?', '#', '[', ']', '@');
+define constant $uri-sub-delims = #('!', '$', '&', '\'', '(', ')', '*', '+', ',', ';', '=');
+define constant $uri-reserved = concatenate($uri-gen-delims, $uri-sub-delims);
+define constant $uri-unreserved = concatenate($alpha, $digit, #('-', '.', '_', '~'));
+define constant $uri-pchar = concatenate($uri-unreserved, $uri-sub-delims, #(':', '@'));
+define constant $uri-userinfo = concatenate($uri-unreserved, $uri-sub-delims, #(':'));
+$uri-parts[#"userinfo"] := $uri-userinfo;
+define constant $uri-query = concatenate($uri-pchar, #('/', '?'));
+$uri-parts[#"query"] := $uri-query;
+define constant $uri-port = $digit;
+define constant $uri-segment = $uri-pchar;
+$uri-parts[#"segment"] := $uri-segment;
+define constant $uri-fragment = $uri-query;
+
+define method parse-uri-as (class :: subclass(<uri>), uri :: <string>) => (result :: <uri>);
+ let (uri, _scheme, scheme, _authority, authority,
+ _userinfo, userinfo, host, _port, port,
+ path, _query, query, _fragment, fragment) =
+ regex-search-strings("^(([^:/?#]+):)?(//((([^/?#]*)@)?([^/?#:]*)(:([^/?#]*))?))?([^?#]*)(\\?([^#]*))?(#(.*))?", uri);
+ // inside generic method to save code duplication
+ if (class == <url> & query)
+ query := regex-replace(query, "\\+", " ");
+ end if;
+ let (scheme, userinfo, host, path, query, fragment)
+ = apply(values, map(method (slot)
+ if (instance?(slot, <string>))
+ percent-decode(slot)
+ else
+ slot
+ end if;
+ end,
+ list(scheme, userinfo, host, path, query, fragment)));
+ let uri = make(class, scheme: scheme | "", userinfo: userinfo | "", host: host | "",
+ port: port & string-to-integer(port), fragment: fragment | "");
+ if (~empty?(path))
+ uri.uri-path := split-path(path);
+ end if;
+ if (query)
+ uri.uri-query := split-query(query);
+ end if;
+ if (absolute?(uri))
+ uri.uri-path := remove-dot-segments(uri.uri-path);
+ end if;
+ uri;
+end;
+
+define constant parse-uri = curry(parse-uri-as, <uri>);
+
+define constant parse-url = curry(parse-uri-as, <url>);
+
+// relative / absolute
+
+define function relative? (uri :: <uri>) => (result :: <boolean>);
+ empty?(uri.uri-scheme)
+end;
+
+define constant absolute? = complement(relative?);
+
+// split parts
+
+define method split-path (path :: <string>) => (parts :: <sequence>);
+ split(path, "/", remove-empty-items: #f);
+end;
+
+define method split-query (query :: <string>) => (parts :: <string-table>);
+ let parts = split(query, "&");
+ let table = make(<string-table>);
+ for (part in parts)
+ let (key, value) = apply(values, split(part, "=", remove-empty-items: #f));
+ unless (value)
+ value := #t;
+ end unless;
+ table[key] := value;
+ end for;
+ table;
+end method split-query;
+
+define function relative? (uri :: <uri>) => (is-relative? :: <boolean>);
+ empty?(uri.uri-scheme);
+end;
+
+define function absolute? (uri :: <uri>) => (is-absolute? :: <boolean>);
+ ~relative?(uri);
+end;
+
+// build-uri
+
+define open generic build-uri (uri :: <uri>) => (result :: <string>);
+
+define method build-uri (uri :: <uri>) => (result :: <string>);
+ let result :: <string> = "";
+ unless (empty?(uri.uri-scheme))
+ result := concatenate(result, uri.uri-scheme, ":");
+ end;
+ unless (empty?(uri.uri-authority))
+ result := concatenate(result, "//", uri.uri-authority);
+ end;
+ result := concatenate(result, build-path(uri));
+ unless (empty?(uri.uri-query))
+ result := concatenate(result, "?", build-query(uri));
+ end;
+ unless (empty?(uri.uri-fragment))
+ result := concatenate(result, "#", uri.uri-fragment);
+ end;
+ result;
+end;
+
+// build-path
+
+define open generic build-path (path :: <object>, #key) => (encoded-path :: <string>);
+
+define method build-path (uri :: <uri>, #key include :: <sequence> = #()) => (encoded-path :: <string>);
+ if (empty?(uri.uri-path)) "" else
+ apply(join, "/", map(method (segment)
+ percent-encode(#"segment", segment, include: include)
+ end, uri.uri-path));
+ end if;
+end;
+
+// build-query
+
+define open generic build-query (query :: <object>, #key) => (encoded-query :: <string>);
+
+define method build-query (uri :: <uri>, #key include :: <sequence> = #()) => (encoded-query :: <string>);
+ if (empty?(uri.uri-query)) "" else
+ let parts = make(<stretchy-vector>);
+ for (value keyed-by key in uri.uri-query)
+ key := percent-encode(#"query", key, include: include);
+ add!(parts, if (value == #t)
+ key
+ else
+ concatenate(key, "=", percent-encode(#"query", value, include: include));
+ end if);
+ end for;
+ apply(join, "&", parts);
+ end if;
+end;
+
+define method build-query (url :: <url>, #key) => (encoded-query :: <string>);
+ next-method(url, include: #('+'));
+end;
+
+// percent-encode
+
+define generic percent-encode (part :: <object>, unencoded :: <object>, #key) => (encoded :: <string>);
+
+define method percent-encode (part, unencoded :: <byte-string>, #key include :: <sequence> = #()) => (encoded :: <string>);
+ let encoded = "";
+ for (char in unencoded)
+ encoded := concatenate(encoded, if (member?(char, $uri-parts[part]) & ~member?(char, include))
+ list(char) else percent-encode(part, char) end if);
+ end for;
+ encoded;
+end method percent-encode;
+
+define method percent-encode (part, unencoded :: <character>, #key) => (encoded :: <string>);
+ format-to-string("%%%X", as(<byte>, unencoded));
+end;
+
+// percent-decode
+
+define method percent-decode (encoded :: <byte-string>) => (unencoded :: <string>);
+ let result = "";
+ let (decode?, ignore?) = values(#f, #f);
+ for (char in encoded, position from 0)
+ if (ignore?)
+ ignore? := #f;
+ else
+ if (char = '%' & ~decode?)
+ decode? := #t;
+ else
+ if (decode? & size(encoded) > position + 1)
+ let low = encoded[position + 1];
+ char := as(<string>, list(char, low));
+ char := string-to-integer(char, base: 16);
+ char := as(<byte-character>, char);
+ ignore? := #t;
+ decode? := #f;
+ end if;
+ unless (decode?)
+ result := concatenate(result, list(char));
+ end unless;
+ end if;
+ end if;
+ end for;
+ result;
+end method percent-decode;
+
+// remove-dot-segments
+
+define generic remove-dot-segments (path :: <object>) => (result :: <object>);
+
+define method remove-dot-segments (path :: <string>) => (result :: <string>);
+ let path = split(path, "/", remove-empty-items: #f);
+ path := remove-dot-segments(path);
+ apply(join, "/", path);
+end;
+
+define method remove-dot-segments (path :: <sequence>) => (result :: <sequence>);
+ let input = make(<deque>);
+ do(curry(push-last, input), path);
+ let output = make(<deque>);
+ for (segment in input, i from 0)
+ let last? = (i = size(input) - 1);
+ if ((segment = "." | segment = "") & last?)
+ push-last(output, "");
+ elseif (segment = ".." & last?)
+ last(output) := "";
+ elseif (segment = "..")
+ if (size(output) > 0 & last(output) ~= "")
+ pop-last(output);
+ end if;
+ elseif (segment = ".")
+ else
+ push-last(output, segment);
+ end if;
+ end for;
+ output;
+end;
+
+define method transform-uris (base :: <uri>, reference :: <uri>,
+ #key as :: subclass(<uri>) = <uri>) => (target :: <uri>);
+ local method merge (base, reference)
+ if (~empty?(base.uri-authority) & empty?(base.uri-path))
+ concatenate(#(""), reference.uri-path);
+ else
+ concatenate(copy-sequence(base.uri-path, end: base.uri-path.size - 1), reference.uri-path)
+ end if;
+ end;
+ let target = make(as);
+ if (~empty?(reference.uri-scheme))
+ target.uri-scheme := reference.uri-scheme;
+ // target.uri-authority = reference.uri-authority;
+ target.uri-userinfo := reference.uri-userinfo;
+ target.uri-host := reference.uri-host;
+ target.uri-port := reference.uri-port;
+ target.uri-path := remove-dot-segments(reference.uri-path);
+ target.uri-query := reference.uri-query;
+ else
+ if (~empty?(reference.uri-authority))
+ // target.uri-authority = reference.uri-authority;
+ target.uri-userinfo := reference.uri-userinfo;
+ target.uri-host := reference.uri-host;
+ target.uri-port := reference.uri-port;
+ target.uri-path := remove-dot-segments(reference.uri-path);
+ target.uri-query := reference.uri-query;
+ else
+ if (empty?(reference.uri-path))
+ target.uri-path := base.uri-path;
+ if (~empty?(reference.uri-query))
+ target.uri-query := reference.uri-query;
+ else
+ target.uri-query := base.uri-query;
+ end if;
+ else
+ if (~empty?(reference.uri-path) & first(reference.uri-path) = "")
+ target.uri-path := remove-dot-segments(reference.uri-path);
+ else
+ target.uri-path := remove-dot-segments(merge(base, reference));
+ end if;
+ target.uri-query := reference.uri-query;
+ end if;
+ // target.uri-authority = base.uri-authority;
+ target.uri-userinfo := base.uri-userinfo;
+ target.uri-host := base.uri-host;
+ target.uri-port := base.uri-port;
+ end if;
+ target.uri-scheme := base.uri-scheme;
+ end if;
+ target.uri-fragment := reference.uri-fragment;
+ target;
+end;
+
+define method print-message (uri :: <uri>, stream :: <stream>) => ();
+ format(stream, "%s", build-uri(uri))
+end;
+
+
+begin
+/*
+ let uri = parse-uri("http://foo:bar@baz.blub:23/path/test/../page?fo%20=ba+r&q1=q2&q3=&q4#extra");
+ let url = parse-url("http://foo:bar@baz.blub:23/path/test/../page?fo%20o=b+r&q1=q2&q3=&q4#extra");
+ format-out("%=\n", uri.uri-query);
+ format-out("%=\n", url.uri-query);
+*/
+/*
+ format-out("%=\n", percent-decode("foo%20bar"));
+ format-out("%=\n", percent-decode("%2"));
+ format-out("%=\n", percent-decode("%"));
+ format-out("%=\n", percent-decode("%rg"));
+*/
+end;
+
+/*
+let uri = parse-uri("http://foo:bar@baz.blub:23/path/test/../page?foo=bar&q1=q2#extra");
+format-out("%s\n", build-uri(uri));
+uri := make(<uri>, scheme: "http", userinfo: "foo at bar:blub");
+format-out("%s\n", build-uri(uri));
+uri := make(<uri>, scheme: "http", host: "foobar", path: "/p1/p2/p3", query: "k1=v1&k2=v2");
+last(uri.uri-path) := "foo/bar+baz";
+format-out("%s\n", build-uri(uri));
+let url = make(<url>, scheme: "http", host: "foobar", path: "/p1/p2/p3", query: "k1=v1&k2=v2");
+last(url.uri-path) := "foo/bar+baz";
+format-out("%s\n", build-uri(url));
+
+let uri1 = parse-uri("http://foo.bar/test");
+format-out("\n");
+format-out("uri1: %=\n", uri);
+format-out("uri1 (built): %=\n", build-uri(uri1));
+let uri2 = make(<uri>, path: "../foo/../../bar");
+format-out("\n");
+format-out("uri2: %=\n", uri2);
+format-out("uri2 (built): %=\n", build-uri(uri2));
+let uri3 = transform-uris(uri1, uri2);
+format-out("\n");
+format-out("uri3: %=\n", uri3);
+format-out("uri3 (built): %=\n", build-uri(uri3));
+
+//format-out("%s\n", build-uri(transform-uris(parse-uri("http://foo.bar/test"), make(<uri>, path: "../foo/../../bar"))));
+//format-out("%s\n", build-uri(transform-uris(parse-uri("http://foo.bar/test"), make(<uri>, path: "/foo/bar"))));
+*/
Added: trunk/libraries/uri/uri.lid
==============================================================================
--- (empty file)
+++ trunk/libraries/uri/uri.lid Sun Feb 17 18:31:02 2008
@@ -0,0 +1,3 @@
+library: uri
+files: library
+ uri
More information about the chatter
mailing list