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.
#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
#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
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;
{
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));
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";
$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;
}
# "~" 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";
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";
$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";
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";
$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
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";
# 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, $_;
}
package Foo;
use File::Glob ':globally';
@s = ();
-while (glob '*/*.t') {
+while (glob($^O eq 'MacOS' ? ':*:*.t' : '*/*.t')) {
#print "# $_\n";
push @s, $_;
}
# 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";
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";
projects / p5sagit/p5-mst-13.2.git / commitdiff