vcs.maemo.org Git - dh-make-perl/blob - dev/i386/liburi-perl/liburi-perl-1.35.dfsg.1/t/heuristic.t

   1 #!perl -w
   2
   3 if (-f "OFFLINE") {
   4    print "1..0";
   5    exit;
   6 }
   7
   8 print "1..15\n";
   9
  10 use URI::Heuristic qw(uf_urlstr uf_url);
  11 if (shift) {
  12     $URI::Heuristic::DEBUG++;
  13     open(STDERR, ">&STDOUT");  # redirect STDERR
  14 }
  15
  16 print "not " unless uf_urlstr("http://www.sn.no/") eq "http://www.sn.no/";
  17 print "ok 1\n";
  18
  19 if ($^O eq "MacOS") {
  20     print "not " unless uf_urlstr("etc:passwd") eq "file:/etc/passwd";
  21 } else {
  22 print "not " unless uf_urlstr("/etc/passwd") eq "file:/etc/passwd";
  23 }
  24 print "ok 2\n";
  25
  26 if ($^O eq "MacOS") {
  27     print "not " unless uf_urlstr(":foo.txt") eq "file:./foo.txt";
  28 } else {
  29 print "not " unless uf_urlstr("./foo.txt") eq "file:./foo.txt";
  30 }
  31 print "ok 3\n";
  32
  33 print "not " unless uf_urlstr("ftp.aas.no/lwp.tar.gz") eq "ftp://ftp.aas.no/lwp.tar.gz";
  34 print "ok 4\n";
  35
  36 if($^O eq "MacOS") {
  37 #  its a weird, but valid, MacOS path, so it can't be left alone
  38     print "not " unless uf_urlstr("C:\\CONFIG.SYS") eq "file:/C/%5CCONFIG.SYS";
  39 } else {
  40 print "not " unless uf_urlstr("C:\\CONFIG.SYS") eq "file:C:\\CONFIG.SYS";
  41 }
  42 print "ok 5\n";
  43
  44 if (gethostbyname("www.netscape.com")) {
  45     # DNS probably work, lets run test 6..8
  46
  47     $URI::Heuristic::MY_COUNTRY = "bv";
  48     print "not " unless uf_urlstr("perl/camel.gif") eq "http://www.perl.com/camel.gif";
  49     print "ok 6\n";
  50
  51     $URI::Heuristic::MY_COUNTRY = "uk";
  52     print "not " unless uf_urlstr("perl/camel.gif") =~ m,^http://www\.perl\.(org|co)\.uk/camel\.gif$,;
  53     print "ok 7\n";
  54
  55     $ENV{URL_GUESS_PATTERN} = "www.ACME.org www.ACME.com";
  56     print "not " unless uf_urlstr("perl") eq "http://www.perl.org";
  57     print "ok 8\n";
  58
  59 } else {
  60     # don't make the inocent worry
  61     print "Skipping test 6-8 because DNS does not work\n";
  62     for (6..8) { print "ok $_\n"; }
  63
  64 }
  65
  66 {
  67 local $ENV{URL_GUESS_PATTERN} = "";
  68 print "not " unless uf_urlstr("perl") eq "http://perl";
  69 print "ok 9\n";
  70
  71 print "not " unless uf_urlstr("http:80") eq "http:80";
  72 print "ok 10\n";
  73
  74 print "not " unless uf_urlstr("mailto:gisle\@aas.no") eq "mailto:gisle\@aas.no";
  75 print "ok 11\n";
  76
  77 print "not " unless uf_urlstr("gisle\@aas.no") eq "mailto:gisle\@aas.no";
  78 print "ok 12\n";
  79
  80 print "not " unless uf_urlstr("Gisle.Aas\@aas.perl.org") eq "mailto:Gisle.Aas\@aas.perl.org";
  81 print "ok 13\n";
  82
  83 print "not " unless uf_url("gopher.sn.no")->scheme eq "gopher";
  84 print "ok 14\n";
  85
  86 print "not " unless uf_urlstr("123.3.3.3:8080/foo") eq "http://123.3.3.3:8080/foo";
  87 print "ok 15\n";
  88 }
  89
  90 #
  91 #print "not " unless uf_urlstr("some-site") eq "http://www.some-site.com";
  92 #print "ok 15\n";
  93 #
  94 #print "not " unless uf_urlstr("some-site.com") eq "http://some-site.com";
  95 #print "ok 16\n";
  96 #