X-Git-Url: http://git.maemo.org/git/?p=dh-make-perl;a=blobdiff_plain;f=dev%2Fi386%2Fliburi-perl%2Fliburi-perl-1.35.dfsg.1%2Ft%2Fold-base.t;fp=dev%2Fi386%2Fliburi-perl%2Fliburi-perl-1.35.dfsg.1%2Ft%2Fold-base.t;h=21c5f9f598f204b3715f6dd564e3ba8ba66e398c;hp=0000000000000000000000000000000000000000;hb=8977e561d8a9eae6959218b0306c9df2056a38a9;hpb=df794b845212301ea0d267c919232538bfef356a

diff --git a/dev/i386/liburi-perl/liburi-perl-1.35.dfsg.1/t/old-base.t b/dev/i386/liburi-perl/liburi-perl-1.35.dfsg.1/t/old-base.t
new file mode 100644
index 0000000..21c5f9f
--- /dev/null
+++ b/dev/i386/liburi-perl/liburi-perl-1.35.dfsg.1/t/old-base.t
@@ -0,0 +1,1023 @@
+#!/local/bin/perl -w
+
+use URI::URL qw(url);
+use URI::Escape qw(uri_escape uri_unescape);
+
+# want compatiblity
+use URI::file;
+$URI::file::DEFAULT_AUTHORITY = undef;
+
+# _expect()
+#
+# Handy low-level object method tester which we insert as a method
+# in the URI::URL class
+#
+sub URI::URL::_expect {
+    my($self, $method, $expect, @args) = @_;
+    my $result = $self->$method(@args);
+    $expect = 'UNDEF' unless defined $expect;
+    $result = 'UNDEF' unless defined $result;
+    return 1 if $expect eq $result;
+    warn "'$self'->$method(@args) = '$result' " .
+		"(expected '$expect')\n";
+    $self->print_on('STDERR');
+    die "Test Failed";
+}
+
+package main;
+
+# Must ensure that there is no relative paths in @INC because we will
+# chdir in the newlocal tests.
+unless ($^O eq "MacOS") {
+chomp($pwd = ($^O =~ /mswin32/i ? `cd` : $^O eq 'VMS' ? `show default` : `pwd`));
+if ($^O eq 'VMS') {
+    $pwd =~ s#^\s+##;
+    $pwd = VMS::Filespec::unixpath($pwd);
+    $pwd =~ s#/$##;
+}
+for (@INC) {
+    my $x = $_;
+    $x = VMS::Filespec::unixpath($x) if $^O eq 'VMS';
+    next if $x =~ m|^/| or $^O =~ /os2|mswin32/i
+	and $x =~ m#^(\w:[\\/]|[\\/]{2})#;
+    print "Turn lib path $x into $pwd/$x\n";
+    $_ = "$pwd/$x";
+
+}
+}
+
+$| = 1;
+
+print "1..8\n";  # for Test::Harness
+
+# Do basic tests first.
+# Dies if an error has been detected, prints "ok" otherwise.
+
+print "Self tests for URI::URL version $URI::URL::VERSION...\n";
+
+eval { scheme_parse_test(); };
+print "not " if $@;
+print "ok 1\n";
+
+eval { parts_test(); };
+print "not " if $@;
+print "ok 2\n";
+
+eval { escape_test(); };
+print "not " if $@;
+print "ok 3\n";
+
+eval { newlocal_test(); };
+print "not " if $@;
+print "ok 4\n";
+
+eval { absolute_test(); };
+print "not " if $@;
+print "ok 5\n";
+
+eval { eq_test(); };
+print "not " if $@;
+print "ok 6\n";
+
+# Let's test making our own things
+URI::URL::strict(0);
+# This should work after URI::URL::strict(0)
+$url = new URI::URL "x-myscheme:something";
+# Since no implementor is registered for 'x-myscheme' then it will
+# be handled by the URI::URL::_generic class
+$url->_expect('as_string' => 'x-myscheme:something');
+$url->_expect('path' => 'something');
+URI::URL::strict(1);
+
+=comment
+
+# Let's try to make our URL subclass
+{
+    package MyURL;
+    @ISA = URI::URL::implementor();
+
+    sub _parse {
+	my($self, $init) = @_;
+	$self->URI::URL::_generic::_parse($init, qw(netloc path));
+    }
+
+    sub foo {
+	my $self = shift;
+	print ref($self)."->foo called for $self\n";
+    }
+}
+# Let's say that it implements the 'x-a+b.c' scheme (alias 'x-foo')
+URI::URL::implementor('x-a+b.c', 'MyURL');
+URI::URL::implementor('x-foo', 'MyURL');
+
+# Now we are ready to try our new URL scheme
+$url = new URI::URL 'x-a+b.c://foo/bar;a?b';
+$url->_expect('as_string', 'x-a+b.c://foo/bar;a?b');
+$url->_expect('path', '/bar;a?b');
+$url->foo;
+$newurl = new URI::URL 'xxx', $url;
+$newurl->foo;
+$url = new URI::URL 'yyy', 'x-foo:';
+$url->foo;
+
+=cut
+
+print "ok 7\n";
+
+# Test the new wash&go constructor
+print "not " if url("../foo.html", "http://www.sn.no/a/b")->abs->as_string
+		ne 'http://www.sn.no/foo.html';
+print "ok 8\n";
+
+print "URI::URL version $URI::URL::VERSION ok\n";
+
+exit 0;
+
+
+
+
+#####################################################################
+#
+# scheme_parse_test()
+#
+# test parsing and retrieval methods
+
+sub scheme_parse_test {
+
+    print "scheme_parse_test:\n";
+
+    $tests = {
+	'hTTp://web1.net/a/b/c/welcome#intro'
+	=> {    'scheme'=>'http', 'host'=>'web1.net', 'port'=>80,
+		'path'=>'/a/b/c/welcome', 'frag'=>'intro','query'=>undef,
+		'epath'=>'/a/b/c/welcome', 'equery'=>undef,
+		'params'=>undef, 'eparams'=>undef,
+		'as_string'=>'http://web1.net/a/b/c/welcome#intro',
+		'full_path' => '/a/b/c/welcome' },
+
+	'http://web:1/a?query+text'
+	=> {    'scheme'=>'http', 'host'=>'web', 'port'=>1,
+		'path'=>'/a', 'frag'=>undef, 'query'=>'query+text' },
+
+	'http://web.net/'
+	=> {    'scheme'=>'http', 'host'=>'web.net', 'port'=>80,
+		'path'=>'/', 'frag'=>undef, 'query'=>undef,
+		'full_path' => '/',
+		'as_string' => 'http://web.net/' },
+
+	'http://web.net'
+	=> {    'scheme'=>'http', 'host'=>'web.net', 'port'=>80,
+		'path'=>'/', 'frag'=>undef, 'query'=>undef,
+		'full_path' => '/',
+		'as_string' => 'http://web.net/' },
+
+	'http:0'
+	 => {   'scheme'=>'http', 'path'=>'0', 'query'=>undef,
+		'as_string'=>'http:0', 'full_path'=>'0', },
+
+	'http:/0?0'
+	 => {   'scheme'=>'http', 'path'=>'/0', 'query'=>'0',
+		'as_string'=>'http:/0?0', 'full_path'=>'/0?0', },
+
+	'http://0:0/0/0;0?0#0'
+	 => {   'scheme'=>'http', 'host'=>'0', 'port'=>'0',
+		'path' => '/0/0', 'query'=>'0', 'params'=>'0',
+		'netloc'=>'0:0',
+		'frag'=>0, 'as_string'=>'http://0:0/0/0;0?0#0' },
+
+	'ftp://0%3A:%40@h:0/0?0'
+	=>  {   'scheme'=>'ftp', 'user'=>'0:', 'password'=>'@',
+		'host'=>'h', 'port'=>'0', 'path'=>'/0?0',
+		'query'=>'0', params=>undef,
+		'netloc'=>'0%3A:%40@h:0',
+		'as_string'=>'ftp://0%3A:%40@h:0/0?0' },
+
+	'ftp://usr:pswd@web:1234/a/b;type=i'
+	=> {    'host'=>'web', 'port'=>1234, 'path'=>'/a/b',
+		'user'=>'usr', 'password'=>'pswd',
+		'params'=>'type=i',
+		'as_string'=>'ftp://usr:pswd@web:1234/a/b;type=i' },
+
+	'ftp://host/a/b'
+	=> {    'host'=>'host', 'port'=>21, 'path'=>'/a/b',
+		'user'=>'anonymous',
+		'as_string'=>'ftp://host/a/b' },
+
+	'file://host/fseg/fs?g/fseg'
+	# don't escape ? for file: scheme
+	=> {    'host'=>'host', 'path'=>'/fseg/fs?g/fseg',
+		'as_string'=>'file://host/fseg/fs?g/fseg' },
+
+	'gopher://host'
+	=> {     'gtype'=>'1', 'as_string' => 'gopher://host', },
+
+	'gopher://host/'
+	=> {     'gtype'=>'1', 'as_string' => 'gopher://host/', },
+
+	'gopher://gopher/2a_selector'
+	=> {    'gtype'=>'2', 'selector'=>'a_selector',
+		'as_string' => 'gopher://gopher/2a_selector', },
+
+	'mailto:libwww-perl@ics.uci.edu'
+	=> {    'address'       => 'libwww-perl@ics.uci.edu',
+		'encoded822addr'=> 'libwww-perl@ics.uci.edu',
+#		'user'          => 'libwww-perl',
+#		'host'          => 'ics.uci.edu',
+		'as_string'     => 'mailto:libwww-perl@ics.uci.edu', },
+
+	'news:*'
+	=> {    'groupart'=>'*', 'group'=>'*', as_string=>'news:*' },
+	'news:comp.lang.perl'
+	=> {    'group'=>'comp.lang.perl' },
+	'news:perl-faq/module-list-1-794455075@ig.co.uk'
+	=> {    'article'=>
+		    'perl-faq/module-list-1-794455075@ig.co.uk' },
+
+	'nntp://news.com/comp.lang.perl/42'
+	=> {    'group'=>'comp.lang.perl', }, #'digits'=>42 },
+
+	'telnet://usr:pswd@web:12345/'
+	=> {    'user'=>'usr', 'password'=>'pswd', 'host'=>'web' },
+	'rlogin://aas@a.sn.no'
+	=> {    'user'=>'aas', 'host'=>'a.sn.no' },
+#	'tn3270://aas@ibm'
+#	=> {    'user'=>'aas', 'host'=>'ibm',
+#		'as_string'=>'tn3270://aas@ibm/'},
+
+#	'wais://web.net/db'
+#	=> { 'database'=>'db' },
+#	'wais://web.net/db?query'
+#	=> { 'database'=>'db', 'query'=>'query' },
+#	'wais://usr:pswd@web.net/db/wt/wp'
+#	=> {    'database'=>'db', 'wtype'=>'wt', 'wpath'=>'wp',
+#		'password'=>'pswd' },
+    };
+
+    foreach $url_str (sort keys %$tests ){
+	print "Testing '$url_str'\n";
+	my $url = new URI::URL $url_str;
+	my $tests = $tests->{$url_str};
+	while( ($method, $exp) = each %$tests ){
+	    $exp = 'UNDEF' unless defined $exp;
+	    $url->_expect($method, $exp);
+	}
+    }
+}
+
+
+#####################################################################
+#
+# parts_test()          (calls netloc_test test)
+#
+# Test individual component part access functions
+#
+sub parts_test {
+    print "parts_test:\n";
+
+    # test storage part access/edit methods (netloc, user, password,
+    # host and port are tested by &netloc_test)
+
+    $url = new URI::URL 'file://web/orig/path';
+    $url->scheme('http');
+    $url->path('1info');
+    $url->query('key words');
+    $url->frag('this');
+    $url->_expect('as_string' => 'http://web/1info?key%20words#this');
+
+    $url->epath('%2f/%2f');
+    $url->equery('a=%26');
+    $url->_expect('full_path' => '/%2f/%2f?a=%26');
+
+    # At this point it should be impossible to access the members path()
+    # and query() without complaints.
+    eval { my $p = $url->path; print "Path is $p\n"; };
+    die "Path exception failed" unless $@;
+    eval { my $p = $url->query; print "Query is $p\n"; };
+    die "Query exception failed" unless $@;
+
+    # but we should still be able to set it 
+    $url->path("howdy");
+    $url->_expect('as_string' => 'http://web/howdy?a=%26#this');
+
+    # Test the path_components function
+    $url = new URI::URL 'file:%2f/%2f';
+    my $p;
+    $p = join('-', $url->path_components);
+    die "\$url->path_components returns '$p', expected '/-/'"
+      unless $p eq "/-/";
+    $url->host("localhost");
+    $p = join('-', $url->path_components);
+    die "\$url->path_components returns '$p', expected '-/-/'"
+      unless $p eq "-/-/";
+    $url->epath("/foo/bar/");
+    $p = join('-', $url->path_components);
+    die "\$url->path_components returns '$p', expected '-foo-bar-'"
+      unless $p eq "-foo-bar-";
+    $url->path_components("", "/etc", "\0", "..", "øse", "");
+    $url->_expect('full_path' => '/%2Fetc/%00/../%F8se/');
+
+    # Setting undef
+    $url = new URI::URL 'http://web/p;p?q#f';
+    $url->epath(undef);
+    $url->equery(undef);
+    $url->eparams(undef);
+    $url->frag(undef);
+    $url->_expect('as_string' => 'http://web');
+
+    # Test http query access methods
+    $url->keywords('dog');
+    $url->_expect('as_string' => 'http://web?dog');
+    $url->keywords(qw(dog bones));
+    $url->_expect('as_string' => 'http://web?dog+bones');
+    $url->keywords(0,0);
+    $url->_expect('as_string' => 'http://web?0+0');
+    $url->keywords('dog', 'bones', '#+=');
+    $url->_expect('as_string' => 'http://web?dog+bones+%23%2B%3D');
+    $a = join(":", $url->keywords);
+    die "\$url->keywords did not work (returned '$a')" unless $a eq 'dog:bones:#+=';
+    # calling query_form is an error
+#    eval { my $foo = $url->query_form; };
+#    die "\$url->query_form should croak since query contains keywords not a form."
+#      unless $@;
+
+    $url->query_form(a => 'foo', b => 'bar');
+    $url->_expect('as_string' => 'http://web?a=foo&b=bar');
+    my %a = $url->query_form;
+    die "\$url->query_form did not work"
+      unless $a{a} eq 'foo' && $a{b} eq 'bar';
+
+    $url->query_form(a => undef, a => 'foo', '&=' => '&=+');
+    $url->_expect('as_string' => 'http://web?a=&a=foo&%26%3D=%26%3D%2B');
+
+    my @a = $url->query_form;
+    die "Wrong length" unless @a == 6;
+    die "Bad keys from query_form"
+      unless $a[0] eq 'a' && $a[2] eq 'a' && $a[4] eq '&=';
+    die "Bad values from query_form"
+      unless $a[1] eq '' && $a[3] eq 'foo' && $a[5] eq '&=+';
+
+    # calling keywords is an error
+#    eval { my $foo = $url->keywords; };
+#    die "\$url->keywords should croak when query is a form"
+#      unless $@;
+    # Try this odd one
+    $url->equery('&=&=b&a=&a&a=b=c&&a=b');
+    @a = $url->query_form;
+    #print join(":", @a), "\n";
+    die "Wrong length" unless @a == 16;
+    die "Wrong sequence" unless $a[4]  eq ""  && $a[5]  eq "b" &&
+                                $a[10] eq "a" && $a[11] eq "b=c";
+
+    # Try array ref values in the key value pairs
+    $url->query_form(a => ['foo', 'bar'], b => 'foo', c => ['bar', 'foo']);
+    $url->_expect('as_string', 'http://web?a=foo&a=bar&b=foo&c=bar&c=foo');
+
+
+    netloc_test();
+    port_test();
+
+    $url->query(undef);
+    $url->_expect('query', undef);
+
+    $url = new URI::URL 'gopher://gopher/';
+    $url->port(33);
+    $url->gtype("3");
+    $url->selector("S");
+    $url->search("query");
+    $url->_expect('as_string', 'gopher://gopher:33/3S%09query');
+
+    $url->epath("45%09a");
+    $url->_expect('gtype' => '4');
+    $url->_expect('selector' => '5');
+    $url->_expect('search' => 'a');
+    $url->_expect('string' => undef);
+    $url->_expect('path' => "/45\ta");
+#    $url->path("00\t%09gisle");
+#    $url->_expect('search', '%09gisle');
+
+    # Let's test som other URL schemes
+    $url = new URI::URL 'news:';
+    $url->group("comp.lang.perl.misc");
+    $url->_expect('as_string' => 'news:comp.lang.perl.misc');
+    $url->article('<1234@a.sn.no>');
+    $url->_expect('as_string' => 'news:1234@a.sn.no'); # "<" and ">" are gone
+    # This one should be illegal
+    eval { $url->article("no.perl"); };
+    die "This one should really complain" unless $@;
+
+#    $url = new URI::URL 'mailto:';
+#    $url->user("aas");
+#    $url->host("a.sn.no");
+#    $url->_expect("as_string" => 'mailto:aas@a.sn.no');
+#    $url->address('foo@bar');
+#    $url->_expect("host" => 'bar');
+#    $url->_expect("user" => 'foo');
+
+#    $url = new URI::URL 'wais://host/database/wt/wpath';
+#    $url->database('foo');
+#    $url->_expect('as_string' => 'wais://host/foo/wt/wpath');
+#    $url->wtype('bar');
+#    $url->_expect('as_string' => 'wais://host/foo/bar/wpath');
+
+    # Test crack method for various URLs
+    my(@crack, $crack);
+    @crack = URI::URL->new("http://host/path;param?query#frag")->crack;
+    die "Cracked result should be 9 elements" unless @crack == 9;
+    $crack = join("*", map { defined($_) ? $_ : "UNDEF" } @crack);
+    print "Cracked result: $crack\n";
+    die "Bad crack result" unless
+      $crack eq "http*UNDEF*UNDEF*host*80*/path*param*query*frag";
+
+    @crack = URI::URL->new("foo/bar", "ftp://aas\@ftp.sn.no/")->crack;
+    die "Cracked result should be 9 elements" unless @crack == 9;
+    $crack = join("*", map { defined($_) ? $_ : "UNDEF" } @crack);
+    print "Cracked result: $crack\n";
+#    die "Bad crack result" unless
+#      $crack eq "ftp*UNDEF*UNDEF*UNDEF*21*foo/bar*UNDEF*UNDEF*UNDEF";
+
+    @crack = URI::URL->new('ftp://u:p@host/q?path')->crack;
+    die "Cracked result should be 9 elements" unless @crack == 9;
+    $crack = join("*", map { defined($_) ? $_ : "UNDEF" } @crack);
+    print "Cracked result: $crack\n";
+    die "Bad crack result" unless
+      $crack eq "ftp*u*p*host*21*/q?path*UNDEF*path*UNDEF";
+
+    @crack = URI::URL->new("ftp://ftp.sn.no/pub")->crack;    # Test anon ftp
+    die "Cracked result should be 9 elements" unless @crack == 9;
+    die "No passwd in anonymous crack" unless $crack[2];
+    $crack[2] = 'passwd';  # easier to test when we know what it is
+    $crack = join("*", map { defined($_) ? $_ : "UNDEF" } @crack);
+    print "Cracked result: $crack\n";
+    die "Bad crack result" unless
+      $crack eq "ftp*anonymous*passwd*ftp.sn.no*21*/pub*UNDEF*UNDEF*UNDEF";
+
+    @crack = URI::URL->new('mailto:aas@sn.no')->crack;
+    die "Cracked result should be 9 elements" unless @crack == 9;
+    $crack = join("*", map { defined($_) ? $_ : "UNDEF" } @crack);
+    print "Cracked result: $crack\n";
+#    die "Bad crack result" unless
+#      $crack eq "mailto*aas*UNDEF*sn.no*UNDEF*aas\@sn.no*UNDEF*UNDEF*UNDEF";
+
+    @crack = URI::URL->new('news:comp.lang.perl.misc')->crack;
+    die "Cracked result should be 9 elements" unless @crack == 9;
+    $crack = join("*", map { defined($_) ? $_ : "UNDEF" } @crack);
+    print "Cracked result: $crack\n";
+    die "Bad crack result" unless
+      $crack eq "news*UNDEF*UNDEF*UNDEF*119*comp.lang.perl.misc*UNDEF*UNDEF*UNDEF";
+}
+
+#
+# netloc_test()
+#
+# Test automatic netloc synchronisation
+#
+sub netloc_test {
+    print "netloc_test:\n";
+
+    my $url = new URI::URL 'ftp://anonymous:p%61ss@håst:12345';
+    $url->_expect('user', 'anonymous');
+    $url->_expect('password', 'pass');
+    $url->_expect('host', 'håst');
+    $url->_expect('port', 12345);
+    # Can't really know how netloc is represented since it is partially escaped
+    #$url->_expect('netloc', 'anonymous:pass@hst:12345');
+    $url->_expect('as_string' => 'ftp://anonymous:pass@h%E5st:12345');
+
+    # The '0' is sometimes tricky to get right
+    $url->user(0);
+    $url->password(0);
+    $url->host(0);
+    $url->port(0);
+    $url->_expect('netloc' => '0:0@0:0');
+    $url->host(undef);
+    $url->_expect('netloc' => '0:0@:0');
+    $url->host('h');
+    $url->user(undef);
+    $url->_expect('netloc' => ':0@h:0');
+    $url->user('');
+    $url->_expect('netloc' => ':0@h:0');
+    $url->password('');
+    $url->_expect('netloc' => ':@h:0');
+    $url->user('foo');
+    $url->_expect('netloc' => 'foo:@h:0');
+
+    # Let's try a simple one
+    $url->user('nemo');
+    $url->password('p2');
+    $url->host('hst2');
+    $url->port(2);
+    $url->_expect('netloc' => 'nemo:p2@hst2:2');
+
+    $url->user(undef);
+    $url->password(undef);
+    $url->port(undef);
+    $url->_expect('netloc' => 'hst2');
+    $url->_expect('port' => '21');  # the default ftp port
+
+    $url->port(21);
+    $url->_expect('netloc' => 'hst2:21');
+
+    # Let's try some reserved chars
+    $url->user("@");
+    $url->password(":-#-;-/-?");
+    $url->_expect('as_string' => 'ftp://%40::-%23-;-%2F-%3F@hst2:21');
+
+}
+
+#
+# port_test()
+#
+# Test port behaviour
+#
+sub port_test {
+    print "port_test:\n";
+
+    $url = URI::URL->new('http://foo/root/dir/');
+    my $port = $url->port;
+    die "Port undefined" unless defined $port;
+    die "Wrong port $port" unless $port == 80;
+    die "Wrong string" unless $url->as_string eq
+	'http://foo/root/dir/';
+
+    $url->port(8001);
+    $port = $url->port;
+    die "Port undefined" unless defined $port;
+    die "Wrong port $port" unless $port == 8001;
+    die "Wrong string" unless $url->as_string eq
+	'http://foo:8001/root/dir/';
+
+    $url->port(80);
+    $port = $url->port;
+    die "Port undefined" unless defined $port;
+    die "Wrong port $port" unless $port == 80;
+    die "Wrong string" unless $url->canonical->as_string eq
+	'http://foo/root/dir/';
+
+    $url->port(8001);
+    $url->port(undef);
+    $port = $url->port;
+    die "Port undefined" unless defined $port;
+    die "Wrong port $port" unless $port == 80;
+    die "Wrong string" unless $url->as_string eq
+	'http://foo/root/dir/';
+}
+
+
+#####################################################################
+#
+# escape_test()
+#
+# escaping functions
+
+sub escape_test {
+    print "escape_test:\n";
+
+    # supply escaped URL
+    $url = new URI::URL 'http://web/this%20has%20spaces';
+    # check component is unescaped
+    $url->_expect('path', '/this has spaces');
+
+    # modify the unescaped form
+    $url->path('this ALSO has spaces');
+    # check whole url is escaped
+    $url->_expect('as_string',
+		  'http://web/this%20ALSO%20has%20spaces');
+
+    $url = new URI::URL uri_escape('http://web/try %?#" those');
+    $url->_expect('as_string',
+		  'http%3A%2F%2Fweb%2Ftry%20%25%3F%23%22%20those');
+
+    my $all = pack('C*',0..255);
+    my $esc = uri_escape($all);
+    my $new = uri_unescape($esc);
+    die "uri_escape->uri_unescape mismatch" unless $all eq $new;
+
+    $url->path($all);
+    $url->_expect('full_path' => q(%00%01%02%03%04%05%06%07%08%09%0A%0B%0C%0D%0E%0F%10%11%12%13%14%15%16%17%18%19%1A%1B%1C%1D%1E%1F%20!%22%23$%&'()*+,-./0123456789:;%3C=%3E%3F@ABCDEFGHIJKLMNOPQRSTUVWXYZ[%5C]%5E_%60abcdefghijklmnopqrstuvwxyz%7B%7C%7D~%7F%80%81%82%83%84%85%86%87%88%89%8A%8B%8C%8D%8E%8F%90%91%92%93%94%95%96%97%98%99%9A%9B%9C%9D%9E%9F%A0%A1%A2%A3%A4%A5%A6%A7%A8%A9%AA%AB%AC%AD%AE%AF%B0%B1%B2%B3%B4%B5%B6%B7%B8%B9%BA%BB%BC%BD%BE%BF%C0%C1%C2%C3%C4%C5%C6%C7%C8%C9%CA%CB%CC%CD%CE%CF%D0%D1%D2%D3%D4%D5%D6%D7%D8%D9%DA%DB%DC%DD%DE%DF%E0%E1%E2%E3%E4%E5%E6%E7%E8%E9%EA%EB%EC%ED%EE%EF%F0%F1%F2%F3%F4%F5%F6%F7%F8%F9%FA%FB%FC%FD%FE%FF));
+
+    # test escaping uses uppercase (preferred by rfc1837)
+    $url = new URI::URL 'file://h/';
+    $url->path(chr(0x7F));
+    $url->_expect('as_string', 'file://h/%7F');
+
+    return;
+    # reserved characters differ per scheme
+
+    ## XXX is this '?' allowed to be unescaped
+    $url = new URI::URL 'file://h/test?ing';
+    $url->_expect('path', '/test?ing');
+
+    $url = new URI::URL 'file://h/';
+    $url->epath('question?mark');
+    $url->_expect('as_string', 'file://h/question?mark');
+    # XXX Why should this be any different???
+    #     Perhaps we should not expect too much :-)
+    $url->path('question?mark');
+    $url->_expect('as_string', 'file://h/question%3Fmark');
+
+    # See what happens when set different elements to this ugly sting
+    my $reserved = ';/?:@&=#%';
+    $url->path($reserved . "foo");
+    $url->_expect('as_string', 'file://h/%3B/%3F%3A%40%26%3D%23%25foo');
+
+    $url->scheme('http');
+    $url->path('');
+    $url->_expect('as_string', 'http://h/');
+    $url->query($reserved);
+    $url->params($reserved);
+    $url->frag($reserved);
+    $url->_expect('as_string', 'http://h/;%3B%2F%3F%3A%40&=%23%25?%3B%2F%3F%3A%40&=%23%25#;/?:@&=#%');
+
+    $str = $url->as_string;
+    $url = new URI::URL $str;
+    die "URL changed" if $str ne $url->as_string;
+
+    $url = new URI::URL 'ftp:foo';
+    $url->user($reserved);
+    $url->host($reserved);
+    $url->_expect('as_string', 'ftp://%3B%2F%3F%3A%40%26%3D%23%25@%3B%2F%3F%3A%40%26%3D%23%25/foo');
+
+}
+
+
+#####################################################################
+#
+# newlocal_test()
+#
+
+sub newlocal_test {
+    return 1 if $^O eq "MacOS";
+
+    print "newlocal_test:\n";
+    my $isMSWin32 = ($^O =~ /MSWin32/i);
+    my $pwd = ($isMSWin32 ? 'cd' :
+	      ($^O eq 'qnx' ? '/usr/bin/fullpath -t' :
+              ($^O eq 'VMS' ? 'show default' :
+              (-e '/bin/pwd' ? '/bin/pwd' : 'pwd'))));
+    my $tmpdir = ($^O eq 'MSWin32' ? $ENV{TEMP} : '/tmp');
+    if ( $^O eq 'qnx' ) {
+	$tmpdir = `/usr/bin/fullpath -t $tmpdir`;
+	chomp $tmpdir;
+    }
+    $tmpdir = '/sys$scratch' if $^O eq 'VMS';
+    $tmpdir =~ tr|\\|/|;
+
+    my $savedir = `$pwd`;     # we don't use Cwd.pm because we want to check
+			      # that it get require'd correctly by URL.pm
+    chomp $savedir;
+    if ($^O eq 'VMS') {
+        $savedir =~ s#^\s+##;
+        $savedir = VMS::Filespec::unixpath($savedir);
+        $savedir =~ s#/$##;
+    }
+
+    # cwd
+    chdir($tmpdir) or die $!;
+    my $dir = `$pwd`; $dir =~ tr|\\|/|;
+    chomp $dir;
+    if ($^O eq 'VMS') {
+        $dir =~ s#^\s+##;
+        $dir = VMS::Filespec::unixpath($dir);
+        $dir =~ s#/$##;
+    }
+    $dir = uri_escape($dir, ':');
+    $dir =~ s/^(\w)%3A/$1:/ if $isMSWin32 or $^O eq 'os2';
+    $url = newlocal URI::URL;
+    my $ss = $isMSWin32 ? '//' : (($dir =~ m,^/,) ? '' : '///' );
+    $url->_expect('as_string', URI::URL->new("file:$ss$dir/")->as_string);
+
+    print "Local directory is ". $url->local_path . "\n";
+
+    if ($^O ne 'VMS') {
+    # absolute dir
+    chdir('/') or die $!;
+    $url = newlocal URI::URL '/usr/';
+    $url->_expect('as_string', 'file:/usr/');
+
+    # absolute file
+    $url = newlocal URI::URL '/vmunix';
+    $url->_expect('as_string', 'file:/vmunix');
+    }
+
+    # relative file
+    chdir($tmpdir) or die $!;
+    $dir = `$pwd`; $dir =~ tr|\\|/|;
+    chomp $dir;
+    if ($^O eq 'VMS') {
+        $dir =~ s#^\s+##;
+        $dir = VMS::Filespec::unixpath($dir);
+        $dir =~ s#/$##;
+    }
+    $dir = uri_escape($dir, ':');
+    $dir =~ s/^(\w)%3A/$1:/ if $isMSWin32 or $^O eq 'os2';
+    $url = newlocal URI::URL 'foo';
+    $url->_expect('as_string', "file:$ss$dir/foo");
+
+    # relative dir
+    chdir($tmpdir) or die $!;
+    $dir = `$pwd`; $dir =~ tr|\\|/|;
+    chomp $dir;
+    if ($^O eq 'VMS') {
+        $dir =~ s#^\s+##;
+        $dir = VMS::Filespec::unixpath($dir);
+        $dir =~ s#/$##;
+    }
+    $dir = uri_escape($dir, ':');
+    $dir =~ s/^(\w)%3A/$1:/ if $isMSWin32 or $^O eq 'os2';
+    $url = newlocal URI::URL 'bar/';
+    $url->_expect('as_string', "file:$ss$dir/bar/");
+
+    # 0
+    if ($^O ne 'VMS') {
+    chdir('/') or die $!;
+    $dir = `$pwd`; $dir =~ tr|\\|/|;
+        chomp $dir;
+        $dir = uri_escape($dir, ':');
+    $dir =~ s/^(\w)%3A/$1:/ if $isMSWin32 or $^O eq 'os2';
+    $url = newlocal URI::URL '0';
+    $url->_expect('as_string', "file:$ss${dir}0");
+    }
+
+    # Test access methods for file URLs
+    $url = new URI::URL 'file:/c:/dos';
+    $url->_expect('dos_path', 'C:\\DOS');
+    $url->_expect('unix_path', '/c:/dos');
+    #$url->_expect('vms_path', '[C:]DOS');
+    $url->_expect('mac_path',  'UNDEF');
+
+    $url = new URI::URL 'file:/foo/bar';
+    $url->_expect('unix_path', '/foo/bar');
+    $url->_expect('mac_path', 'foo:bar');
+
+    # Some edge cases
+#    $url = new URI::URL 'file:';
+#    $url->_expect('unix_path', '/');
+    $url = new URI::URL 'file:/';
+    $url->_expect('unix_path', '/');
+    $url = new URI::URL 'file:.';
+    $url->_expect('unix_path', '.');
+    $url = new URI::URL 'file:./foo';
+    $url->_expect('unix_path', './foo');
+    $url = new URI::URL 'file:0';
+    $url->_expect('unix_path', '0');
+    $url = new URI::URL 'file:../../foo';
+    $url->_expect('unix_path', '../../foo');
+    $url = new URI::URL 'file:foo/../bar';
+    $url->_expect('unix_path', 'foo/../bar');
+
+    # Relative files
+    $url = new URI::URL 'file:foo/b%61r/Note.txt';
+    $url->_expect('unix_path', 'foo/bar/Note.txt');
+    $url->_expect('mac_path', ':foo:bar:Note.txt');
+    $url->_expect('dos_path', 'FOO\\BAR\\NOTE.TXT');
+    #$url->_expect('vms_path', '[.FOO.BAR]NOTE.TXT');
+
+    # The VMS path found in RFC 1738 (section 3.10)
+    $url = new URI::URL 'file://vms.host.edu/disk$user/my/notes/note12345.txt';
+#    $url->_expect('vms_path', 'DISK$USER:[MY.NOTES]NOTE12345.TXT');
+#    $url->_expect('mac_path', 'disk$user:my:notes:note12345.txt');
+
+    chdir($savedir) or die $!;
+}
+
+
+#####################################################################
+#
+# absolute_test()
+#
+sub absolute_test {
+
+    print "Test relative/absolute URI::URL parsing:\n";
+
+    # Tests from draft-ietf-uri-relative-url-06.txt
+    # Copied verbatim from the draft, parsed below
+
+    @URI::URL::g::ISA = qw(URI::URL::_generic); # for these tests
+
+    my $base = 'http://a/b/c/d;p?q#f';
+
+    $absolute_tests = <<EOM;
+5.1.  Normal Examples
+
+      g:h        = <URL:g:h>
+      g          = <URL:http://a/b/c/g>
+      ./g        = <URL:http://a/b/c/g>
+      g/         = <URL:http://a/b/c/g/>
+      /g         = <URL:http://a/g>
+      //g        = <URL:http://g>
+#      ?y         = <URL:http://a/b/c/d;p?y>
+      g?y        = <URL:http://a/b/c/g?y>
+      g?y/./x    = <URL:http://a/b/c/g?y/./x>
+      #s         = <URL:http://a/b/c/d;p?q#s>
+      g#s        = <URL:http://a/b/c/g#s>
+      g#s/./x    = <URL:http://a/b/c/g#s/./x>
+      g?y#s      = <URL:http://a/b/c/g?y#s>
+ #     ;x         = <URL:http://a/b/c/d;x>
+      g;x        = <URL:http://a/b/c/g;x>
+      g;x?y#s    = <URL:http://a/b/c/g;x?y#s>
+      .          = <URL:http://a/b/c/>
+      ./         = <URL:http://a/b/c/>
+      ..         = <URL:http://a/b/>
+      ../        = <URL:http://a/b/>
+      ../g       = <URL:http://a/b/g>
+      ../..      = <URL:http://a/>
+      ../../     = <URL:http://a/>
+      ../../g    = <URL:http://a/g>
+
+5.2.  Abnormal Examples
+
+   Although the following abnormal examples are unlikely to occur
+   in normal practice, all URL parsers should be capable of resolving
+   them consistently.  Each example uses the same base as above.
+
+   An empty reference resolves to the complete base URL:
+
+      <>         = <URL:http://a/b/c/d;p?q#f>
+
+   Parsers must be careful in handling the case where there are more
+   relative path ".." segments than there are hierarchical levels in
+   the base URL's path.  Note that the ".." syntax cannot be used to
+   change the <net_loc> of a URL.
+
+     ../../../g = <URL:http://a/../g>
+     ../../../../g = <URL:http://a/../../g>
+
+   Similarly, parsers must avoid treating "." and ".." as special
+   when they are not complete components of a relative path.
+
+      /./g       = <URL:http://a/./g>
+      /../g      = <URL:http://a/../g>
+      g.         = <URL:http://a/b/c/g.>
+      .g         = <URL:http://a/b/c/.g>
+      g..        = <URL:http://a/b/c/g..>
+      ..g        = <URL:http://a/b/c/..g>
+
+   Less likely are cases where the relative URL uses unnecessary or
+   nonsensical forms of the "." and ".." complete path segments.
+
+      ./../g     = <URL:http://a/b/g>
+      ./g/.      = <URL:http://a/b/c/g/>
+      g/./h      = <URL:http://a/b/c/g/h>
+      g/../h     = <URL:http://a/b/c/h>
+
+   Finally, some older parsers allow the scheme name to be present in
+   a relative URL if it is the same as the base URL scheme.  This is
+   considered to be a loophole in prior specifications of partial
+   URLs [1] and should be avoided by future parsers.
+
+      http:g     = <URL:http:g>
+      http:      = <URL:http:>
+EOM
+    # convert text to list like
+    # @absolute_tests = ( ['g:h' => 'g:h'], ...)
+
+    for $line (split("\n", $absolute_tests)) {
+	next unless $line =~ /^\s{6}/;
+	if ($line =~ /^\s+(\S+)\s*=\s*<URL:([^>]*)>/) {
+	    my($rel, $abs) = ($1, $2);
+	    $rel = '' if $rel eq '<>';
+	    push(@absolute_tests, [$rel, $abs]);
+	}
+	else {
+	    warn "illegal line '$line'";
+	}
+    }
+
+    # add some extra ones for good measure
+
+    push(@absolute_tests, ['x/y//../z' => 'http://a/b/c/x/y/z'],
+			  ['1'         => 'http://a/b/c/1'    ],
+			  ['0'         => 'http://a/b/c/0'    ],
+			  ['/0'        => 'http://a/0'        ],
+#			  ['%2e/a'     => 'http://a/b/c/%2e/a'],  # %2e is '.'
+#			  ['%2e%2e/a'  => 'http://a/b/c/%2e%2e/a'],
+	);
+
+    print "  Relative    +  Base  =>  Expected Absolute URL\n";
+    print "================================================\n";
+    for $test (@absolute_tests) {
+	my($rel, $abs) = @$test;
+	my $abs_url = new URI::URL $abs;
+	my $abs_str = $abs_url->as_string;
+
+	printf("  %-10s  +  $base  =>  %s\n", $rel, $abs);
+	my $u   = new URI::URL $rel, $base;
+	my $got = $u->abs;
+	$got->_expect('as_string', $abs_str);
+    }
+
+    # bug found and fixed in 1.9 by "J.E. Fritz" <FRITZ@gems.vcu.edu>
+    $base = new URI::URL 'http://host/directory/file';
+    my $relative = new URI::URL 'file', $base;
+    my $result = $relative->abs;
+
+    my ($a, $b) = ($base->path, $result->path);
+	die "'$a' and '$b' should be the same" unless $a eq $b;
+
+    # Counter the expectation of least surprise,
+    # section 6 of the draft says the URL should
+    # be canonicalised, rather than making a simple
+    # substitution of the last component.
+    # Better doublecheck someone hasn't "fixed this bug" :-)
+    $base = new URI::URL 'http://host/dir1/../dir2/file';
+    $relative = new URI::URL 'file', $base;
+    $result = $relative->abs;
+    die 'URL not canonicalised' unless $result eq 'http://host/dir2/file';
+
+    print "--------\n";
+    # Test various other kinds of URLs and how they like to be absolutized
+    for (["http://abc/", "news:45664545", "http://abc/"],
+	 ["news:abc",    "http://abc/",   "news:abc"],
+	 ["abc",         "file:/test?aas", "file:/abc"],
+#	 ["gopher:",     "",               "gopher:"],
+#	 ["?foo",        "http://abc/a",   "http://abc/a?foo"],
+	 ["?foo",        "file:/abc",      "file:/?foo"],
+	 ["#foo",        "http://abc/a",   "http://abc/a#foo"],
+	 ["#foo",        "file:a",         "file:a#foo"],
+	 ["#foo",        "file:/a",         "file:/a#foo"],
+	 ["#foo",        "file:/a",         "file:/a#foo"],
+	 ["#foo",        "file://localhost/a", "file://localhost/a#foo"],
+	 ['123@sn.no',   "news:comp.lang.perl.misc", 'news:/123@sn.no'],
+	 ['no.perl',     'news:123@sn.no',           'news:/no.perl'],
+	 ['mailto:aas@a.sn.no', "http://www.sn.no/", 'mailto:aas@a.sn.no'],
+
+	 # Test absolutizing with old behaviour.
+	 ['http:foo',     'http://h/a/b',   'http://h/a/foo'],
+	 ['http:/foo',    'http://h/a/b',   'http://h/foo'],
+	 ['http:?foo',    'http://h/a/b',   'http://h/a/b?foo'],
+	 ['http:#foo',    'http://h/a/b',   'http://h/a/b#foo'],
+	 ['http:?foo#bar','http://h/a/b',   'http://h/a/b?foo#bar'],
+	 ['file:/foo',    'http://h/a/b',   'file:/foo'],
+
+	)
+    {
+	my($url, $base, $expected_abs) = @$_;
+	my $rel = new URI::URL $url, $base;
+	my $abs = $rel->abs($base, 1);
+	printf("  %-12s+  $base  =>  %s\n", $rel, $abs);
+	$abs->_expect('as_string', $expected_abs);
+    }
+    print "absolute test ok\n";
+
+    # Test relative function
+    for (
+	 ["http://abc/a",   "http://abc",        "a"],
+	 ["http://abc/a",   "http://abc/b",      "a"],
+	 ["http://abc/a?q", "http://abc/b",      "a?q"],
+	 ["http://abc/a;p", "http://abc/b",      "a;p"],
+	 ["http://abc/a",   "http://abc/a/b/c/", "../../../a"],
+         ["http://abc/a/",  "http://abc/a/",     "./"],
+         ["http://abc/a#f", "http://abc/a",      "#f"],
+
+	 ["file:/etc/motd", "file:/",            "etc/motd"],
+	 ["file:/etc/motd", "file:/etc/passwd",  "motd"],
+	 ["file:/etc/motd", "file:/etc/rc2.d/",  "../motd"],
+	 ["file:/etc/motd", "file:/usr/lib/doc", "../../etc/motd"],
+         ["file:",          "file:/etc/",        "../"],
+         ["file:foo",       "file:/etc/",        "../foo"],
+
+	 ["mailto:aas",     "http://abc",        "mailto:aas"],
+
+	 # Nicolai Langfeldt's original example
+	 ["http://www.math.uio.no/doc/mail/top.html",
+	  "http://www.math.uio.no/doc/linux/", "../mail/top.html"],
+        )
+    {
+	my($abs, $base, $expect) = @$_;
+	printf "url('$abs', '$base')->rel eq '$expect'\n";
+	my $rel = URI::URL->new($abs, $base)->rel;
+	$rel->_expect('as_string', $expect);
+    }
+    print "relative test ok\n";
+}
+
+
+sub eq_test
+{
+    my $u1 = new URI::URL 'http://abc.com:80/~smith/home.html';
+    my $u2 = new URI::URL 'http://ABC.com/%7Esmith/home.html';
+    my $u3 = new URI::URL 'http://ABC.com:/%7esmith/home.html';
+
+    # Test all permutations of these tree
+    $u1->eq($u2) or die "1: $u1 ne $u2";
+    $u1->eq($u3) or die "2: $u1 ne $u3";
+    $u2->eq($u1) or die "3: $u2 ne $u1";
+    $u2->eq($u3) or die "4: $u2 ne $u3";
+    $u3->eq($u1) or die "5: $u3 ne $u1";
+    $u3->eq($u2) or die "6: $u3 ne $u2";
+
+    # Test empty path
+    my $u4 = new URI::URL 'http://www.sn.no';
+    $u4->eq("HTTP://WWW.SN.NO:80/") or die "7: $u4";
+    $u4->eq("http://www.sn.no:81") and die "8: $u4";
+
+    # Test mailto
+#    my $u5 = new URI::URL 'mailto:AAS@SN.no';
+#    $u5->eq('mailto:aas@sn.no') or die "9: $u5";
+
+    # Test reserved char
+    my $u6 = new URI::URL 'ftp://ftp/%2Fetc';
+    $u6->eq("ftp://ftp/%2fetc") or die "10: $u6";
+    $u6->eq("ftp://ftp://etc") and die "11: $u6";
+}
+