[MacPerl-Porters] [PATCHES] io_dir.t and IO::Dir

[Thomas Wegner]

Hi, 

I'm sending patches for "io_dir.t" and "IO::Dir". There are some path specification 
issues that have to be fixed. And here they are:


diff -ru :perl:t:lib:io_dir.t.orig :perl:t:lib:io_dir.t
--- :perl:t:lib:io_dir.t.orig   Mon May 28 18:32:46 2001
+++ :perl:t:lib:io_dir.t        Mon May 28 19:06:35 2001
@@ -19,7 +19,7 @@
 
 print "1..10\n";
 
-$dot = new IO::Dir ".";
+$dot = ($^O eq 'MacOS') ? new IO::Dir ":" : new IO::Dir ".";
 print defined($dot) ? "ok" : "not ok", " 1\n";
 
 @a = sort <*>;
@@ -41,7 +41,7 @@
 print FH "X";
 close(FH);
 
-tie %dir, IO::Dir, ".";
+($^O eq 'MacOS') ? tie %dir, IO::Dir, ":" : tie %dir, IO::Dir, ".";
 my @files = keys %dir;
 
 # I hope we do not have an empty dir :-)
@@ -55,7 +55,7 @@
 
 print -f 'X' ? "ok" : "not ok", " 8\n";
 
-tie %dirx, IO::Dir, ".", DIR_UNLINK;
+($^O eq 'MacOS') ? tie %dirx, IO::Dir, ":", DIR_UNLINK : tie %dirx, IO::Dir, ".", 
+DIR_UNLINK;
 
 my $statx = $dirx{'X'};
 print defined($statx) && UNIVERSAL::isa($statx,'File::stat') && $statx->size == 1



diff -ru :perl:lib:IO:Dir.pm.orig :perl:lib:IO:Dir.pm
--- :perl:lib:IO:Dir.pm.orig    Tue May  8 18:06:26 2001
+++ :perl:lib:IO:Dir.pm Mon May 28 19:36:33 2001
@@ -45,6 +45,10 @@
     return undef
     unless opendir($dh, $dirname);
     ${*$dh}{io_dir_path} = $dirname;
+    ${*$dh}{path_sep} = '/'; # default path separator
+    if ($^O eq 'MacOS') {
+        ${*$dh}{path_sep} = ($dirname =~ /:$/) ? '' : ':';
+    }
     1;
 }
 
@@ -103,18 +107,18 @@
 
 sub EXISTS {
     my($dh,$key) = @_;
-    -e ${*$dh}{io_dir_path} . "/" . $key;
+    -e ${*$dh}{io_dir_path} . ${*$dh}{path_sep} . $key;
 }
 
 sub FETCH {
     my($dh,$key) = @_;
-    &lstat(${*$dh}{io_dir_path} . "/" . $key);
+    &lstat(${*$dh}{io_dir_path} . ${*$dh}{path_sep} . $key);
 }
 
 sub STORE {
     my($dh,$key,$data) = @_;
     my($atime,$mtime) = ref($data) ? @$data : ($data,$data);
-    my $file = ${*$dh}{io_dir_path} . "/" . $key;
+    my $file = ${*$dh}{io_dir_path} . ${*$dh}{path_sep} . $key;
     unless(-e $file) {
     my $io = IO::File->new($file,O_CREAT | O_RDWR);
     $io->close if $io;
@@ -125,8 +129,8 @@
 sub DELETE {
     my($dh,$key) = @_;
     # Only unlink if unlink-ing is enabled
-    my $file = ${*$dh}{io_dir_path} . "/" . $key;
-
+    my $file = ${*$dh}{io_dir_path} . ${*$dh}{path_sep} . $key;
+    
     return 0
     unless ${*$dh}{io_dir_unlink};
 
@@ -220,6 +224,20 @@
 an array of two values can be passed. The first array element will be used to
 set the access time and the second element will be used to set the modification
 time.
+
+=head1 NOTES
+
+=over 4
+
+=item *
+
+On Mac OS (Classic), the path separator is ':', not '/', and the 
+current directory is denoted as ':', not '.'. You should be careful 
+about specifying relative pathnames. While a full path always begins 
+with a volume name, a relative pathname should always begin with a 
+':'.  If specifying a volume name only, a trailing ':' is required.
+
+=back
 
 =head1 SEE ALSO
 


__END__ of patches


The patches should be applied against MacPerl 5.6.1a2, i.e. after the maint patch has 
been applied.


Best regards,

--Thomas

_________________________________________________________
Do You Yahoo!?
Get your free @yahoo.com address at http://mail.yahoo.com