diff options
Diffstat (limited to 't/heuristic.t')
| -rw-r--r-- | t/heuristic.t | 138 |
1 files changed, 138 insertions, 0 deletions
diff --git a/t/heuristic.t b/t/heuristic.t new file mode 100644 index 0000000..63c2ad8 --- /dev/null +++ b/t/heuristic.t @@ -0,0 +1,138 @@ +use strict; +use warnings; + +BEGIN { + # mock up a gethostbyname that always works :-) + *CORE::GLOBAL::gethostbyname = sub { + my $name = shift; + #print "# gethostbyname [$name]\n"; + die if wantarray; + return 1 if $name =~ /^www\.perl\.(com|org|ca|su)\.$/; + return 1 if $name eq "www.perl.co.uk\."; + return 0; + }; +} + +print "1..26\n"; + +use URI::Heuristic qw(uf_urlstr uf_url); +if (shift) { + $URI::Heuristic::DEBUG++; + open(STDERR, ">&STDOUT"); # redirect STDERR +} + +print "not " unless uf_urlstr("http://www.sn.no/") eq "http://www.sn.no/"; +print "ok 1\n"; + +if ($^O eq "MacOS") { + print "not " unless uf_urlstr("etc:passwd") eq "file:/etc/passwd"; +} else { +print "not " unless uf_urlstr("/etc/passwd") eq "file:/etc/passwd"; +} +print "ok 2\n"; + +if ($^O eq "MacOS") { + print "not " unless uf_urlstr(":foo.txt") eq "file:./foo.txt"; +} else { +print "not " unless uf_urlstr("./foo.txt") eq "file:./foo.txt"; +} +print "ok 3\n"; + +print "not " unless uf_urlstr("ftp.aas.no/lwp.tar.gz") eq "ftp://ftp.aas.no/lwp.tar.gz"; +print "ok 4\n"; + +if($^O eq "MacOS") { +# its a weird, but valid, MacOS path, so it can't be left alone + print "not " unless uf_urlstr("C:\\CONFIG.SYS") eq "file:/C/%5CCONFIG.SYS"; +} else { +print "not " unless uf_urlstr("C:\\CONFIG.SYS") eq "file:C:\\CONFIG.SYS"; +} +print "ok 5\n"; + +{ + local $ENV{LC_ALL} = ""; + local $ENV{LANG} = ""; + local $ENV{HTTP_ACCEPT_LANGUAGE} = ""; + + $ENV{LC_ALL} = "en_GB.UTF-8"; + undef $URI::Heuristic::MY_COUNTRY; + print "not " unless uf_urlstr("perl/camel.gif") =~ m,^http://www\.perl\.(org|co)\.uk/camel\.gif$,; + print "ok 6\n"; + + use Net::Domain; + $ENV{LC_ALL} = "C"; + { no warnings; *Net::Domain::hostfqdn = sub { return 'vasya.su' } } + undef $URI::Heuristic::MY_COUNTRY; + print "not " unless uf_urlstr("perl/camel.gif") =~ m,^http://www\.perl\.su/camel\.gif$,; + print "ok 7\n"; + + $ENV{LC_ALL} = "C"; + { no warnings; *Net::Domain::hostfqdn = sub { return '' } } + undef $URI::Heuristic::MY_COUNTRY; + print "not " unless uf_urlstr("perl/camel.gif") =~ m,^http://www\.perl\.(com|org)/camel\.gif$,; + print "ok 8\n"; + + $ENV{HTTP_ACCEPT_LANGUAGE} = "en-ca"; + undef $URI::Heuristic::MY_COUNTRY; + print "not " unless uf_urlstr("perl/camel.gif") eq "http://www.perl.ca/camel.gif"; + print "ok 9\n"; +} + +$URI::Heuristic::MY_COUNTRY = "bv"; +print "not " unless uf_urlstr("perl/camel.gif") =~ m,^http://www\.perl\.(com|org)/camel\.gif$,; +print "ok 10\n"; + +# Backwards compatibility; uk != United Kingdom in ISO 3166 +$URI::Heuristic::MY_COUNTRY = "uk"; +print "not " unless uf_urlstr("perl/camel.gif") =~ m,^http://www\.perl\.(org|co)\.uk/camel\.gif$,; +print "ok 11\n"; + +$URI::Heuristic::MY_COUNTRY = "gb"; +print "not " unless uf_urlstr("perl/camel.gif") =~ m,^http://www\.perl\.(org|co)\.uk/camel\.gif$,; +print "ok 12\n"; + +$ENV{URL_GUESS_PATTERN} = "www.ACME.org www.ACME.com"; +print "not " unless uf_urlstr("perl") eq "http://www.perl.org"; +print "ok 13\n"; + +{ + local $ENV{URL_GUESS_PATTERN} = ""; + print "not " unless uf_urlstr("perl") eq "http://perl"; + print "ok 14\n"; + + print "not " unless uf_urlstr("http:80") eq "http:80"; + print "ok 15\n"; + + print "not " unless uf_urlstr("mailto:gisle\@aas.no") eq "mailto:gisle\@aas.no"; + print "ok 16\n"; + + print "not " unless uf_urlstr("gisle\@aas.no") eq "mailto:gisle\@aas.no"; + print "ok 17\n"; + + print "not " unless uf_urlstr("Gisle.Aas\@aas.perl.org") eq "mailto:Gisle.Aas\@aas.perl.org"; + print "ok 18\n"; + + print "not " unless uf_url("gopher.sn.no")->scheme eq "gopher"; + print "ok 19\n"; + + print "not " unless uf_urlstr("123.3.3.3:8080/foo") eq "http://123.3.3.3:8080/foo"; + print "ok 20\n"; + + print "not " unless uf_urlstr("123.3.3.3:443/foo") eq "https://123.3.3.3:443/foo"; + print "ok 21\n"; + + print "not " unless uf_urlstr("123.3.3.3:21/foo") eq "ftp://123.3.3.3:21/foo"; + print "ok 22\n"; + + print "not " unless uf_url("FTP.example.com")->scheme eq "ftp"; + print "ok 23\n"; + + print "not " unless uf_url("ftp2.example.com")->scheme eq "ftp"; + print "ok 24\n"; + + print "not " unless uf_url("ftp")->scheme eq "ftp"; + print "ok 25\n"; + + print "not " unless uf_url("https.example.com")->scheme eq "https"; + print "ok 26\n"; +} |