This patch should fix the failure of old_base.t:4 of URI::URL on OS/2.
The change is the following:

  a path name of the form D:/dir/filename is encoded as file:///D:/dir/filename

  a path name extracted from an URL contains slashes.

AFAIU, this form of the file URL is the suggested one - and it is
supported by all the browsers I checked (lynx, explorer and netscape).

Thanks,
Ilya

--- ./t/old-base.t-pre  Wed Jul 23 15:41:40 2003
+++ ./t/old-base.t      Thu Sep 18 18:47:34 2003
@@ -677,9 +677,9 @@ sub newlocal_test {
         $dir =~ s#/$##;
     }
     $dir = uri_escape($dir, ':');
-    $dir =~ s/^(\w)%3A/$1:/ if $isMSWin32;
+    $dir =~ s/^(\w)%3A/$1:/ if $isMSWin32 or $^O eq 'os2';
     $url = newlocal URI::URL;
-    my $ss = $isMSWin32 ? '//' : '';
+    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";
@@ -705,7 +705,7 @@ sub newlocal_test {
         $dir =~ s#/$##;
     }
     $dir = uri_escape($dir, ':');
-    $dir =~ s/^(\w)%3A/$1:/ if $isMSWin32;
+    $dir =~ s/^(\w)%3A/$1:/ if $isMSWin32 or $^O eq 'os2';
     $url = newlocal URI::URL 'foo';
     $url->_expect('as_string', "file:$ss$dir/foo");
 
@@ -719,7 +719,7 @@ sub newlocal_test {
         $dir =~ s#/$##;
     }
     $dir = uri_escape($dir, ':');
-    $dir =~ s/^(\w)%3A/$1:/ if $isMSWin32;
+    $dir =~ s/^(\w)%3A/$1:/ if $isMSWin32 or $^O eq 'os2';
     $url = newlocal URI::URL 'bar/';
     $url->_expect('as_string', "file:$ss$dir/bar/");
 
@@ -729,7 +729,7 @@ sub newlocal_test {
     $dir = `$pwd`; $dir =~ tr|\\|/|;
         chomp $dir;
         $dir = uri_escape($dir, ':');
-    $dir =~ s/^(\w)%3A/$1:/ if $isMSWin32;
+    $dir =~ s/^(\w)%3A/$1:/ if $isMSWin32 or $^O eq 'os2';
     $url = newlocal URI::URL '0';
     $url->_expect('as_string', "file:$ss${dir}0");
     }
--- ./URI/file/OS2.pm-pre       Fri Sep 11 01:54:04 1998
+++ ./URI/file/OS2.pm   Thu Sep 18 18:44:44 2003
@@ -3,4 +3,26 @@ package URI::file::OS2;
 require URI::file::Win32;
 @ISA=qw(URI::file::Win32);
 
+# The Win32 version translates k:/foo to file://k:/foo  (?!)
+# We add an empty host
+
+sub extract_authority
+{
+    my $class = shift;
+    return $1 if $_[0] =~ s,^\\\\([^\\]+),,;  # UNC
+    return $1 if $_[0] =~ s,^//([^/]+),,;     # UNC too?
+
+    if ($_[0] =~ m#^[a-zA-Z]{1,2}:#) {       # allow for ab: drives
+       return "";
+    }
+    return;
+}
+
+sub file {
+  my $p = &URI::file::Win32::file;
+  return unless defined $p;
+  $p =~ s,\\,/,g;
+  $p;
+}
+
 1;

Reply via email to