From: Chris Nandor Date: Fri, 30 Mar 2001 16:51:00 +0000 (-0500) Subject: File::Glob stuff for Mac OS X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7369a5240f1efb9ab50b6f47289fb602aaaccc25;p=p5sagit%2Fp5-mst-13.2.git File::Glob stuff for Mac OS Message-Id: p4raw-id: //depot/perl@9479 --- diff --git a/ext/File/Glob/Glob.pm b/ext/File/Glob/Glob.pm index 76adbe7..561f331 100644 --- a/ext/File/Glob/Glob.pm +++ b/ext/File/Glob/Glob.pm @@ -376,14 +376,32 @@ Win32 users should use the real slash. If you really want to use 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 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 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 Egnat@frii.comE, and is released under the artistic license. Further modifications were -made by Greg Bacon Egbacon@cs.uah.eduE and Gurusamy Sarathy -Egsar@activestate.comE. The C glob code has the +made by Greg Bacon Egbacon@cs.uah.eduE, Gurusamy Sarathy +Egsar@activestate.comE, and Thomas Wegner +Ewegner_thomas@yahoo.comE. The C glob code has the following copyright: Copyright (c) 1989, 1993 The Regents of the University of California. diff --git a/ext/File/Glob/bsd_glob.c b/ext/File/Glob/bsd_glob.c index a0becd1..6e2c9f1 100644 --- a/ext/File/Glob/bsd_glob.c +++ b/ext/File/Glob/bsd_glob.c @@ -79,8 +79,11 @@ static char sccsid[] = "@(#)glob.c 8.3 (Berkeley) 10/13/93"; #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 @@ static char sccsid[] = "@(#)glob.c 8.3 (Berkeley) 10/13/93"; #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 @@ glob0(const Char *pattern, glob_t *pglob) 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 @@ g_opendir(register Char *str, glob_t *pglob) { 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)); diff --git a/t/lib/glob-basic.t b/t/lib/glob-basic.t index ec2f539..170237f 100755 --- a/t/lib/glob-basic.t +++ b/t/lib/glob-basic.t @@ -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 @@ sub array { $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; } @@ -120,7 +125,7 @@ print "ok 8\n"; # "~" 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"; diff --git a/t/lib/glob-case.t b/t/lib/glob-case.t index 56d35f3..881470c 100755 --- a/t/lib/glob-case.t +++ b/t/lib/glob-case.t @@ -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 @@ use File::Glob qw(:glob csh_glob); $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"; diff --git a/t/lib/glob-global.t b/t/lib/glob-global.t index a82408c..1d79032 100755 --- a/t/lib/glob-global.t +++ b/t/lib/glob-global.t @@ -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 @@ use File::Glob ':globally'; $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 "# |@r|\nnot " if @r < 3; 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 @@ my $r = scalar @r; # 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 @@ print "ok 8\n"; 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 @@ print "ok 9\n"; # test if different glob ops maintain independent contexts @s = (); my $i = 0; -while (<*/*.t>) { - #print "# $_ <"; - push @s, $_; - while () { - #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 () { + #print " $_"; + $i++; + } + #print " >\n"; } - #print " >\n"; } print "not " if "@r" ne "@s" or not $i; print "ok 10\n"; diff --git a/t/lib/glob-taint.t b/t/lib/glob-taint.t index fe2fa23..4c09903 100755 --- a/t/lib/glob-taint.t +++ b/t/lib/glob-taint.t @@ -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";