Front page | perl.perl5.porters |
Postings from March 2001
[PATCH] File::Glob stuff for Mac OS
Thread Previous
|
Thread Next
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/
Thread Previous
|
Thread Next