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

5 files changed, 154 insertions, 30 deletions

diff --git a/ext/File/Glob/Changes b/ext/File/Glob/Changes
index 7b8ef7d706..e246c6d684 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 c3b25fa92c..bac98324f4 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<GLOB_NOCASE>
+
+By default, file names are assumed to be case sensitive; this flag
+makes glob() treat case differences as not significant.
+
 =item C<GLOB_NOCHECK>
 
 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<GLOB_TILDE>
 
@@ -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 98e366c401..1805f68a96 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 f42b689cd7..c422d608bd 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 410b007a2d..10d1de534c 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. */