develooper Front page | perl.perl5.porters | Postings from March 2001

[PATCH] File::Glob stuff for Mac OS

From:
Chris Nandor
Date:
March 30, 2001 13:51
Subject:
[PATCH] File::Glob stuff for Mac OS
Message ID:
p05010400b6eaab36051c@[10.0.1.177]
bsd_glob.c and Glob.pm below from Thomas Wegner, and test patches from me.  Same patches apply on perl and maint-5.6/perl (with some line offsets on perl).

I got kill working on Mac OS so that it always returns 0, and is only useful to check for taintedness.  But just after I finished this up, I realized I could do a safe check for taintedness just with this:

	eval { $data, eval 1 };

D'oh.  I suggest that in the future, this is used for taint checks in .t files etc., unless there are objections.  It's a wee bit more portable.  :-)  Regardless, kill will work for Mac OS in the future.

--Chris


--- ext/File/Glob/bsd_glob.c.orig	Wed Mar 28 23:39:06 2001
+++ ext/File/Glob/bsd_glob.c	Fri Mar 30 16:08:54 2001
@@ -79,8 +79,11 @@
 #ifndef MAXPATHLEN
 #  ifdef PATH_MAX
 #    define	MAXPATHLEN	PATH_MAX
-#  else
-#    define	MAXPATHLEN	1024
+#    ifdef MACOS_TRADITIONAL
+#      define	MAXPATHLEN	255
+#    else
+#      define	MAXPATHLEN	1024
+#    endif
 #  endif
 #endif
 
@@ -93,7 +96,11 @@
 #define	BG_QUOTE	'\\'
 #define	BG_RANGE	'-'
 #define	BG_RBRACKET	']'
-#define	BG_SEP		'/'
+#ifdef MACOS_TRADITIONAL
+#  define	BG_SEP	':'
+#else
+#  define	BG_SEP	'/'
+#endif
 #ifdef DOSISH
 #define BG_SEP2		'\\'
 #endif
@@ -451,6 +458,12 @@
 	int c, err, oldflags, oldpathc;
 	Char *bufnext, patbuf[MAXPATHLEN+1];
 
+#ifdef MACOS_TRADITIONAL
+	if ( (*pattern == BG_TILDE) && (pglob->gl_flags & GLOB_TILDE) ) {
+		return(globextend(pattern, pglob));
+	}
+#endif
+
 	qpat = globtilde(pattern, patbuf, pglob);
 	qpatnext = qpat;
 	oldflags = pglob->gl_flags;
@@ -861,10 +874,15 @@
 {
 	char buf[MAXPATHLEN];
 
-	if (!*str)
+	if (!*str) {
+#ifdef MACOS_TRADITIONAL
+		strcpy(buf, ":");
+#else
 		strcpy(buf, ".");
-	else
+#endif
+	} else {
 		g_Ctoc(str, buf);
+	}
 
 	if (pglob->gl_flags & GLOB_ALTDIRFUNC)
 		return((*pglob->gl_opendir)(buf));
--- ext/File/Glob/Glob.pm.orig	Wed Mar 21 23:00:45 2001
+++ ext/File/Glob/Glob.pm	Fri Mar 30 16:03:28 2001
@@ -376,14 +376,32 @@
 backslashes, consider using Sarathy's File::DosGlob, which comes with
 the standard Perl distribution.
 
+=item *
+
+Mac OS (Classic) users should note a few differences. Since
+Mac OS is not Unix, when the glob code encounters a tilde glob (e.g.
+~user/foo) and the C<GLOB_TILDE> flag is used, it simply returns that
+pattern without doing any expansion.
+
+Glob on Mac OS is case-insensitive by default (if you don't use any
+flags). If you specify any flags at all and still want glob
+to be case-insensitive, you must include C<GLOB_NOCASE> in the flags.
+
+The path separator is ':' (aka colon), not '/' (aka slash). Mac OS users
+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 AUTHOR
 
 The Perl interface was written by Nathan Torkington E<lt>gnat@frii.comE<gt>,
 and is released under the artistic license.  Further modifications were
-made by Greg Bacon E<lt>gbacon@cs.uah.eduE<gt> and Gurusamy Sarathy
-E<lt>gsar@activestate.comE<gt>.  The C glob code has the
+made by Greg Bacon E<lt>gbacon@cs.uah.eduE<gt>, Gurusamy Sarathy
+E<lt>gsar@activestate.comE<gt>, and Thomas Wegner
+E<lt>wegner_thomas@yahoo.comE<gt>.  The C glob code has the
 following copyright:
 
     Copyright (c) 1989, 1993 The Regents of the University of California.
--- t/lib/glob-basic.t.orig	Thu Mar  8 00:51:37 2001
+++ t/lib/glob-basic.t	Fri Mar 30 16:09:32 2001
@@ -2,7 +2,12 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
+    if ($^O eq 'MacOS') { 
+	@INC = qw(: ::lib ::macos:lib); 
+    } else { 
+	@INC = '.'; 
+	push @INC, '../lib'; 
+    }
     require Config; import Config;
     if ($Config{'extensions'} !~ /\bFile\/Glob\b/i) {
         print "1..0\n";
@@ -26,7 +31,7 @@
 $ENV{PATH} = "/bin";
 delete @ENV{BASH_ENV, CDPATH, ENV, IFS};
 @correct = ();
-if (opendir(D, ".")) {
+if (opendir(D, $^O eq "MacOS" ? ":" : ".")) {
    @correct = grep { !/^\./ } sort readdir(D);
    closedir D;
 }
@@ -118,7 +123,7 @@
 # "~" should expand to $ENV{HOME}
 $ENV{HOME} = "sweet home";
 @a = bsd_glob('~', GLOB_TILDE | GLOB_NOMAGIC);
-unless (@a == 1 and $a[0] eq $ENV{HOME}) {
+unless ($^O eq "MacOS" || (@a == 1 and $a[0] eq $ENV{HOME})) {
     print "not ";
 }
 print "ok 9\n";
--- t/lib/glob-case.t.orig	Mon Feb  5 23:54:28 2001
+++ t/lib/glob-case.t	Thu Mar 29 17:27:43 2001
@@ -2,7 +2,12 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
+    if ($^O eq 'MacOS') { 
+	@INC = qw(: ::lib ::macos:lib); 
+    } else { 
+	@INC = '.'; 
+	push @INC, '../lib'; 
+    }
     require Config; import Config;
     if ($Config{'extensions'} !~ /\bFile\/Glob\b/i) {
         print "1..0\n";
@@ -17,20 +22,22 @@
 $loaded = 1;
 print "ok 1\n";
 
+my $pat = $^O eq "MacOS" ? ":lib:G*.t" : "lib/G*.t";
+
 # Test the actual use of the case sensitivity tags, via csh_glob()
 import File::Glob ':nocase';
-@a = csh_glob("lib/G*.t"); # At least glob-basic.t glob-case.t glob-global.t
+@a = csh_glob($pat); # At least glob-basic.t glob-case.t glob-global.t
 print "not " unless @a >= 3;
 print "ok 2\n";
 
 # This may fail on systems which are not case-PRESERVING
 import File::Glob ':case';
-@a = csh_glob("lib/G*.t"); # None should be uppercase
+@a = csh_glob($pat); # None should be uppercase
 print "not " unless @a == 0;
 print "ok 3\n";
 
 # Test the explicit use of the GLOB_NOCASE flag
-@a = bsd_glob("lib/G*.t", GLOB_NOCASE);
+@a = bsd_glob($pat, GLOB_NOCASE);
 print "not " unless @a >= 3;
 print "ok 4\n";
 
--- t/lib/glob-global.t.orig	Mon Feb  5 23:54:28 2001
+++ t/lib/glob-global.t	Thu Mar 29 18:27:37 2001
@@ -2,7 +2,12 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
+    if ($^O eq 'MacOS') { 
+	@INC = qw(: ::lib ::macos:lib); 
+    } else { 
+	@INC = '.'; 
+	push @INC, '../lib'; 
+    }
     require Config; import Config;
     if ($Config{'extensions'} !~ /\bFile\/Glob\b/i) {
         print "1..0\n";
@@ -31,9 +36,9 @@
 $loaded = 1;
 print "ok 1\n";
 
-$_ = "lib/*.t";
+$_ = $^O eq "MacOS" ? ":lib:*.t" : "lib/*.t";
 my @r = glob;
-print "not " if $_ ne 'lib/*.t';
+print "not " if $_ ne ($^O eq "MacOS" ? ":lib:*.t" : "lib/*.t");
 print "ok 2\n";
 
 # we should have at least basic.t, global.t, taint.t
@@ -41,7 +46,11 @@
 print "ok 3\n";
 
 # check if <*/*> works
-@r = <*/*.t>;
+if ($^O eq "MacOS") {
+    @r = <:*:*.t>;
+} else {
+    @r = <*/*.t>;
+}
 # at least t/global.t t/basic.t, t/taint.t
 print "not " if @r < 3;
 print "ok 4\n";
@@ -49,34 +58,55 @@
 
 # check if scalar context works
 @r = ();
-while (defined($_ = <*/*.t>)) {
-    #print "# $_\n";
-    push @r, $_;
+if ($^O eq "MacOS") {
+    while (defined($_ = <:*:*.t>)) {
+	#print "# $_\n";
+	push @r, $_;
+    }
+} else {
+    while (defined($_ = <*/*.t>)) {
+	#print "# $_\n";
+	push @r, $_;
+    }
 }
 print "not " if @r != $r;
 print "ok 5\n";
 
 # check if list context works
 @r = ();
-for (<*/*.t>) {
-    #print "# $_\n";
-    push @r, $_;
+if ($^O eq "MacOS") {
+    for (<:*:*.t>) {
+	#print "# $_\n";
+	push @r, $_;
+    }
+} else {
+    for (<*/*.t>) {
+	#print "# $_\n";
+	push @r, $_;
+    }
 }
 print "not " if @r != $r;
 print "ok 6\n";
 
 # test if implicit assign to $_ in while() works
 @r = ();
-while (<*/*.t>) {
-    #print "# $_\n";
-    push @r, $_;
+if ($^O eq "MacOS") {
+    while (<:*:*.t>) {
+	#print "# $_\n";
+	push @r, $_;
+    }
+} else {
+    while (<*/*.t>) {
+	#print "# $_\n";
+	push @r, $_;
+    }
 }
 print "not " if @r != $r;
 print "ok 7\n";
 
 # test if explicit glob() gets assign magic too
 my @s = ();
-while (glob '*/*.t') {
+while (glob($^O eq 'MacOS' ? ':*:*.t' : '*/*.t')) {
     #print "# $_\n";
     push @s, $_;
 }
@@ -87,7 +117,7 @@
 package Foo;
 use File::Glob ':globally';
 @s = ();
-while (glob '*/*.t') {
+while (glob($^O eq 'MacOS' ? ':*:*.t' : '*/*.t')) {
     #print "# $_\n";
     push @s, $_;
 }
@@ -97,14 +127,26 @@
 # test if different glob ops maintain independent contexts
 @s = ();
 my $i = 0;
-while (<*/*.t>) {
-    #print "# $_ <";
-    push @s, $_;
-    while (<bas*/*.t>) {
-        #print " $_";
-        $i++;
+if ($^O eq "MacOS") {
+    while (<:*:*.t>) {
+	#print "# $_ <";
+	push @s, $_;
+	while (<:bas*:*.t>) {
+	    #print " $_";
+	    $i++;
+	}
+	#print " >\n";
+    }
+} else {
+    while (<*/*.t>) {
+	#print "# $_ <";
+	push @s, $_;
+	while (<bas*/*.t>) {
+	    #print " $_";
+	    $i++;
+	}
+	#print " >\n";
     }
-    #print " >\n";
 }
 print "not " if "@r" ne "@s" or not $i;
 print "ok 10\n";
--- t/lib/glob-taint.t.orig	Mon Feb  5 23:54:28 2001
+++ t/lib/glob-taint.t	Fri Mar 30 15:36:42 2001
@@ -2,7 +2,12 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
+    if ($^O eq 'MacOS') { 
+	@INC = qw(: ::lib ::macos:lib); 
+    } else { 
+	@INC = '.'; 
+	push @INC, '../lib'; 
+    }
     require Config; import Config;
     if ($Config{'extensions'} !~ /\bFile\/Glob\b/i) {
         print "1..0\n";

-- 
Chris Nandor                      pudge@pobox.com    http://pudge.net/
Open Source Development Network    pudge@osdn.com     http://osdn.com/



nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About