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
- 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).
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;
@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
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
) ],
);
-$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 {
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 {
# 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) ];
}
}
}
## 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
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
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>
=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.
#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;
#define BG_RANGE '-'
#define BG_RBRACKET ']'
#define BG_SEP '/'
+#ifdef DOSISH
+#define BG_SEP2 '\\'
+#endif
#define BG_STAR '*'
#define BG_TILDE '~'
#define BG_UNDERSCORE '_'
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 *);
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 */
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;
}
}
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));
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)))) {
/* 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++;
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));
register Direntry_t *dp;
DIR *dirp;
int err;
+ int nocase;
char buf[MAXPATHLEN];
/*
}
err = 0;
+ nocase = ((pglob->gl_flags & GLOB_NOCASE) != 0);
/* Search directory for matching names. */
if (pglob->gl_flags & GLOB_ALTDIRFUNC)
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;
}
* 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;
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);
++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;
}
#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. */
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;
}
--- /dev/null
+#!./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";
+}
}
}
-use File::Glob 'globally';
+use File::Glob ':globally';
$loaded = 1;
print "ok 1\n";
# how about in a different package, like?
package Foo;
-use File::Glob 'globally';
+use File::Glob ':globally';
@s = ();
while (glob '*/*.t') {
#print "# $_\n";
projects / p5sagit/p5-mst-13.2.git / commitdiff