From: Paul Moore Date: Tue, 2 Nov 1999 11:11:25 +0000 (+0000) Subject: various File::Glob fixes for DOSISH platforms X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=220398a0501cffd114fa4441a4a685dc486ed3d8;p=p5sagit%2Fp5-mst-13.2.git various File::Glob fixes for DOSISH platforms Message-Id: <714DFA46B9BBD0119CD000805FC1F53BDC38E3@UKRUX002.rundc.uk.origin-it.com> Subject: File::Glob again. Final patch, honest! p4raw-id: //depot/perl@4615 --- diff --git a/MANIFEST b/MANIFEST index 2aa7eb2..02e507a 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1231,6 +1231,7 @@ t/lib/findbin.t See if FindBin works t/lib/gdbm.t See if GDBM_File works t/lib/getopt.t See if Getopt::Std and Getopt::Long work t/lib/glob-basic.t See if File::Glob works +t/lib/glob-case.t See if File::Glob works t/lib/glob-global.t See if File::Glob works t/lib/glob-taint.t See if File::Glob works t/lib/gol-basic.t See if Getopt::Long works diff --git a/ext/File/Glob/Changes b/ext/File/Glob/Changes index 7b8ef7d..e246c6d 100644 --- a/ext/File/Glob/Changes +++ b/ext/File/Glob/Changes @@ -36,3 +36,12 @@ Revision history for Perl extension File::Glob - ansified prototypes - s/struct stat/Stat_t/ - split on spaces to make <*.c *.h> work (for compatibility) +0.991 Tue Oct 26 09:48:00 BST 1999 + - Add case-insensitive matching (GLOB_NOCASE) + - Make glob_csh case insensitive by default on Win32, VMS, + OS/2, DOS, RISC OS, and Mac OS + - Add support for :case and :nocase tags + - Hack to make patterns like C:* work on DOSISH systems + - Add support for either \ or / as separators on DOSISH systems + - Limit effect of \ as a quoting operator on DOSISH systems to + when it precedes one of []{}-~\ (to minimise backslashitis). diff --git a/ext/File/Glob/Glob.pm b/ext/File/Glob/Glob.pm index c3b25fa..bac9832 100644 --- a/ext/File/Glob/Glob.pm +++ b/ext/File/Glob/Glob.pm @@ -2,7 +2,8 @@ package File::Glob; use strict; use Carp; -use vars qw($VERSION @ISA @EXPORT_OK @EXPORT_FAIL %EXPORT_TAGS $AUTOLOAD); +use vars qw($VERSION @ISA @EXPORT_OK @EXPORT_FAIL + %EXPORT_TAGS $AUTOLOAD $DEFAULT_FLAGS); require Exporter; require DynaLoader; @@ -11,15 +12,16 @@ require AutoLoader; @ISA = qw(Exporter DynaLoader AutoLoader); @EXPORT_OK = qw( - globally csh_glob glob GLOB_ABEND GLOB_ALTDIRFUNC GLOB_BRACE + GLOB_CSH GLOB_ERR GLOB_ERROR GLOB_MARK + GLOB_NOCASE GLOB_NOCHECK GLOB_NOMAGIC GLOB_NOSORT @@ -28,16 +30,16 @@ require AutoLoader; GLOB_TILDE ); -@EXPORT_FAIL = ( 'globally' ); - %EXPORT_TAGS = ( 'glob' => [ qw( GLOB_ABEND GLOB_ALTDIRFUNC GLOB_BRACE + GLOB_CSH GLOB_ERR GLOB_ERROR GLOB_MARK + GLOB_NOCASE GLOB_NOCHECK GLOB_NOMAGIC GLOB_NOSORT @@ -48,18 +50,24 @@ require AutoLoader; ) ], ); -$VERSION = '0.99'; - -sub export_fail { - shift; - - if ($_[0] eq 'globally') { - local $^W; - *CORE::GLOBAL::glob = \&File::Glob::csh_glob; - shift; +$VERSION = '0.991'; + +sub import { + my $i = 1; + while ($i < @_) { + if ($_[$i] =~ /^:(case|nocase|globally)$/) { + splice(@_, $i, 1); + $DEFAULT_FLAGS &= ~GLOB_NOCASE() if $1 eq 'case'; + $DEFAULT_FLAGS |= GLOB_NOCASE() if $1 eq 'nocase'; + if ($1 eq 'globally') { + local $^W; + *CORE::GLOBAL::glob = \&File::Glob::csh_glob; + } + next; + } + ++$i; } - - @_; + goto &Exporter::import; } sub AUTOLOAD { @@ -93,6 +101,11 @@ sub GLOB_ERROR { sub GLOB_CSH () { GLOB_BRACE() | GLOB_NOMAGIC() | GLOB_QUOTE() | GLOB_TILDE() } +$DEFAULT_FLAGS = GLOB_CSH(); +if ($^O =~ /^(?:MSWin32|VMS|os2|dos|riscos|MacOS)$/) { + $DEFAULT_FLAGS |= GLOB_NOCASE(); +} + # Autoload methods go after =cut, and are processed by the autosplit program. sub glob { @@ -127,10 +140,10 @@ sub csh_glob { # if we're just beginning, do it all first if ($iter{$cxix} == 0) { if (@pat) { - $entries{$cxix} = [ map { doglob($_, GLOB_CSH) } @pat ]; + $entries{$cxix} = [ map { doglob($_, $DEFAULT_FLAGS) } @pat ]; } else { - $entries{$cxix} = [ doglob($pat, GLOB_CSH) ]; + $entries{$cxix} = [ doglob($pat, $DEFAULT_FLAGS) ]; } } @@ -169,7 +182,15 @@ File::Glob - Perl extension for BSD glob routine } ## override the core glob (even with -T) - use File::Glob 'globally'; + use File::Glob ':globally'; + my @sources = <*.{c,h,y}> + + ## override the core glob, forcing case sensitivity + use File::Glob qw(:globally :case); + my @sources = <*.{c,h,y}> + + ## override the core glob forcing case insensitivity + use File::Glob qw(:globally :nocase); my @sources = <*.{c,h,y}> =head1 DESCRIPTION @@ -193,6 +214,11 @@ cannot open or read. Ordinarily glob() continues to find matches. Each pathname that is a directory that matches the pattern has a slash appended. +=item C + +By default, file names are assumed to be case sensitive; this flag +makes glob() treat case differences as not significant. + =item C If the pattern does not match any pathname, then glob() returns a list @@ -228,6 +254,7 @@ behaviour and should probably not be used anywhere else. Use the backslash ('\') character for quoting: every occurrence of a backslash followed by a character in the pattern is replaced by that character, avoiding any special interpretation of the character. +(But see below for exceptions on DOSISH systems). =item C @@ -288,6 +315,18 @@ that you can use a backslash to escape things. =item * +On DOSISH systems, backslash is a valid directory separator character. +In this case, use of backslash as a quoting character (via GLOB_QUOTE) +interferes with the use of backslash as a directory separator. The +best (simplest, most portable) solution is to use forward slashes for +directory separators, and backslashes for quoting. However, this does +not match "normal practice" on these systems. As a concession to user +expectation, therefore, backslashes (under GLOB_QUOTE) only quote the +glob metacharacters '[', ']', '{', '}', '-', '~', and backslash itself. +All other backslashes are passed through unchanged. + +=item * + 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. diff --git a/ext/File/Glob/Glob.xs b/ext/File/Glob/Glob.xs index 98e366c..1805f68 100644 --- a/ext/File/Glob/Glob.xs +++ b/ext/File/Glob/Glob.xs @@ -80,6 +80,12 @@ constant(char *name, int arg) #endif break; case 'N': + if (strEQ(name, "GLOB_NOCASE")) +#ifdef GLOB_NOCASE + return GLOB_NOCASE; +#else + goto not_there; +#endif if (strEQ(name, "GLOB_NOCHECK")) #ifdef GLOB_NOCHECK return GLOB_NOCHECK; diff --git a/ext/File/Glob/bsd_glob.c b/ext/File/Glob/bsd_glob.c index f42b689..c422d60 100644 --- a/ext/File/Glob/bsd_glob.c +++ b/ext/File/Glob/bsd_glob.c @@ -91,6 +91,9 @@ static char sccsid[] = "@(#)glob.c 8.3 (Berkeley) 10/13/93"; #define BG_RANGE '-' #define BG_RBRACKET ']' #define BG_SEP '/' +#ifdef DOSISH +#define BG_SEP2 '\\' +#endif #define BG_STAR '*' #define BG_TILDE '~' #define BG_UNDERSCORE '_' @@ -132,6 +135,7 @@ typedef U8 Char; static int compare(const void *, const void *); +static int ci_compare(const void *, const void *); static void g_Ctoc(const Char *, char *); static int g_lstat(Char *, Stat_t *, glob_t *); static DIR *g_opendir(Char *, glob_t *); @@ -148,7 +152,7 @@ static int globextend(const Char *, glob_t *); static const Char * globtilde(const Char *, Char *, glob_t *); static int globexp1(const Char *, glob_t *); static int globexp2(const Char *, const Char *, glob_t *, int *); -static int match(Char *, Char *, Char *); +static int match(Char *, Char *, Char *, int); #ifdef GLOB_DEBUG static void qprintf(const char *, Char *); #endif /* GLOB_DEBUG */ @@ -186,11 +190,41 @@ bsd_glob(const char *pattern, int flags, bufnext = patbuf; bufend = bufnext + MAXPATHLEN; +#ifdef DOSISH + /* Nasty hack to treat patterns like "C:*" correctly. In this + * case, the * should match any file in the current directory + * on the C: drive. However, the glob code does not treat the + * colon specially, so it looks for files beginning "C:" in + * the current directory. To fix this, change the pattern to + * add an explicit "./" at the start (just after the drive + * letter and colon - ie change to "C:./*"). + */ + if (isalpha(pattern[0]) && pattern[1] == ':' && + pattern[2] != BG_SEP && pattern[2] != BG_SEP2 && + bufend - bufnext > 4) { + *bufnext++ = pattern[0]; + *bufnext++ = ':'; + *bufnext++ = '.'; + *bufnext++ = BG_SEP; + patnext += 2; + } +#endif if (flags & GLOB_QUOTE) { /* Protect the quoted characters. */ while (bufnext < bufend && (c = *patnext++) != BG_EOS) if (c == BG_QUOTE) { +#ifdef DOSISH + /* To avoid backslashitis on Win32, + * we only treat \ as a quoting character + * if it precedes one of the + * metacharacters []-{}~\ + */ + if ((c = *patnext++) != '[' && c != ']' && + c != '-' && c != '{' && c != '}' && + c != '~' && c != '\\') { +#else if ((c = *patnext++) == BG_EOS) { +#endif c = BG_QUOTE; --patnext; } @@ -496,12 +530,27 @@ glob0(const Char *pattern, glob_t *pglob) } else if (!(pglob->gl_flags & GLOB_NOSORT)) qsort(pglob->gl_pathv + pglob->gl_offs + oldpathc, - pglob->gl_pathc - oldpathc, sizeof(char *), compare); + pglob->gl_pathc - oldpathc, sizeof(char *), + (pglob->gl_flags & GLOB_NOCASE) ? ci_compare : compare); pglob->gl_flags = oldflags; return(0); } static int +ci_compare(const void *p, const void *q) +{ + const char *pp = *(const char **)p; + const char *qq = *(const char **)q; + while (*pp && *qq) { + if (tolower(*pp) != tolower(*qq)) + break; + ++pp; + ++qq; + } + return (tolower(*pp) - tolower(*qq)); +} + +static int compare(const void *p, const void *q) { return(strcmp(*(char **)p, *(char **)q)); @@ -542,7 +591,11 @@ glob2(Char *pathbuf, Char *pathend, Char *pattern, glob_t *pglob) return(0); if (((pglob->gl_flags & GLOB_MARK) && - pathend[-1] != BG_SEP) && (S_ISDIR(sb.st_mode) + pathend[-1] != BG_SEP +#ifdef DOSISH + && pathend[-1] != BG_SEP2 +#endif + ) && (S_ISDIR(sb.st_mode) || (S_ISLNK(sb.st_mode) && (g_stat(pathbuf, &sb, pglob) == 0) && S_ISDIR(sb.st_mode)))) { @@ -559,7 +612,11 @@ glob2(Char *pathbuf, Char *pathend, Char *pattern, glob_t *pglob) /* Find end of next segment, copy tentatively to pathend. */ q = pathend; p = pattern; - while (*p != BG_EOS && *p != BG_SEP) { + while (*p != BG_EOS && *p != BG_SEP +#ifdef DOSISH + && *p != BG_SEP2 +#endif + ) { if (ismeta(*p)) anymeta = 1; *q++ = *p++; @@ -568,7 +625,11 @@ glob2(Char *pathbuf, Char *pathend, Char *pattern, glob_t *pglob) if (!anymeta) { /* No expansion, do next segment. */ pathend = q; pattern = p; - while (*pattern == BG_SEP) + while (*pattern == BG_SEP +#ifdef DOSISH + || *pattern == BG_SEP2 +#endif + ) *pathend++ = *pattern++; } else /* Need expansion, recurse. */ return(glob3(pathbuf, pathend, pattern, p, pglob)); @@ -583,6 +644,7 @@ glob3(Char *pathbuf, Char *pathend, Char *pattern, register Direntry_t *dp; DIR *dirp; int err; + int nocase; char buf[MAXPATHLEN]; /* @@ -608,6 +670,7 @@ glob3(Char *pathbuf, Char *pathend, Char *pattern, } err = 0; + nocase = ((pglob->gl_flags & GLOB_NOCASE) != 0); /* Search directory for matching names. */ if (pglob->gl_flags & GLOB_ALTDIRFUNC) @@ -624,7 +687,7 @@ glob3(Char *pathbuf, Char *pathend, Char *pattern, for (sc = (U8 *) dp->d_name, dc = pathend; (*dc++ = *sc++) != BG_EOS;) continue; - if (!match(pathend, pattern, restpattern)) { + if (!match(pathend, pattern, restpattern, nocase)) { *pathend = BG_EOS; continue; } @@ -703,7 +766,7 @@ globextend(const Char *path, glob_t *pglob) * pattern causes a recursion level. */ static int -match(register Char *name, register Char *pat, register Char *patend) +match(register Char *name, register Char *pat, register Char *patend, int nocase) { int ok, negate_range; Char c, k; @@ -715,7 +778,7 @@ match(register Char *name, register Char *pat, register Char *patend) if (pat == patend) return(1); do - if (match(name, pat, patend)) + if (match(name, pat, patend, nocase)) return(1); while (*name++ != BG_EOS); return(0); @@ -731,16 +794,22 @@ match(register Char *name, register Char *pat, register Char *patend) ++pat; while (((c = *pat++) & M_MASK) != M_END) if ((*pat & M_MASK) == M_RNG) { - if (c <= k && k <= pat[1]) - ok = 1; + if (nocase) { + if (tolower(c) <= tolower(k) && tolower(k) <= tolower(pat[1])) + ok = 1; + } else { + if (c <= k && k <= pat[1]) + ok = 1; + } pat += 2; - } else if (c == k) + } else if (nocase ? (tolower(c) == tolower(k)) : (c == k)) ok = 1; if (ok == negate_range) return(0); break; default: - if (*name++ != c) + k = *name++; + if (nocase ? (tolower(k) != tolower(c)) : (k != c)) return(0); break; } diff --git a/ext/File/Glob/bsd_glob.h b/ext/File/Glob/bsd_glob.h index 410b007..10d1de5 100644 --- a/ext/File/Glob/bsd_glob.h +++ b/ext/File/Glob/bsd_glob.h @@ -71,6 +71,7 @@ typedef struct { #define GLOB_NOMAGIC 0x0200 /* GLOB_NOCHECK without magic chars (csh). */ #define GLOB_QUOTE 0x0400 /* Quote special chars with \. */ #define GLOB_TILDE 0x0800 /* Expand tilde names from the passwd file. */ +#define GLOB_NOCASE 0x1000 /* Treat filenames without regard for case. */ #define GLOB_NOSPACE (-1) /* Malloc call failed. */ #define GLOB_ABEND (-2) /* Unignored error. */ diff --git a/op.c b/op.c index 80fb550..1be2428 100644 --- a/op.c +++ b/op.c @@ -5357,7 +5357,7 @@ Perl_ck_glob(pTHX_ OP *o) modname->op_private |= OPpCONST_BARE; ENTER; utilize(1, start_subparse(FALSE, 0), Nullop, modname, - newSVOP(OP_CONST, 0, newSVpvn("globally", 8))); + newSVOP(OP_CONST, 0, newSVpvn(":globally", 9))); gv = gv_fetchpv("CORE::GLOBAL::glob", FALSE, SVt_PVCV); LEAVE; } diff --git a/t/lib/glob-case.t b/t/lib/glob-case.t new file mode 100755 index 0000000..2e65a0f --- /dev/null +++ b/t/lib/glob-case.t @@ -0,0 +1,48 @@ +#!./perl + +BEGIN { + chdir 't' if -d 't'; + unshift @INC, '../lib'; + print "1..7\n"; +} +END { + print "not ok 1\n" unless $loaded; +} +use File::Glob qw(:glob csh_glob); +$loaded = 1; +print "ok 1\n"; + +# 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 +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 +print "not " unless @a == 0; +print "ok 3\n"; + +# Test the explicit use of the GLOB_NOCASE flag +@a = File::Glob::glob("lib/G*.t", GLOB_NOCASE); +print "not " unless @a >= 3; +print "ok 4\n"; + +# Test Win32 backslash nastiness... +if ($^O ne 'MSWin32') { + print "ok 5\nok 6\nok 7\n"; +} +else { + @a = File::Glob::glob("lib\\g*.t"); + print "not " unless @a >= 3; + print "ok 5\n"; + mkdir "[]", 0; + @a = File::Glob::glob("\\[\\]", GLOB_QUOTE); + rmdir "[]"; + print "# returned @a\nnot " unless @a == 1; + print "ok 6\n"; + @a = File::Glob::glob("lib\\*", GLOB_QUOTE); + print "not " if @a == 0; + print "ok 7\n"; +} diff --git a/t/lib/glob-global.t b/t/lib/glob-global.t index 7da741e..44d7e8b 100755 --- a/t/lib/glob-global.t +++ b/t/lib/glob-global.t @@ -23,7 +23,7 @@ EOMessage } } -use File::Glob 'globally'; +use File::Glob ':globally'; $loaded = 1; print "ok 1\n"; @@ -81,7 +81,7 @@ print "ok 8\n"; # how about in a different package, like? package Foo; -use File::Glob 'globally'; +use File::Glob ':globally'; @s = (); while (glob '*/*.t') { #print "# $_\n";