ext/File/Glob/t/case.t See if File::Glob works
ext/File/Glob/t/global.t See if File::Glob works
ext/File/Glob/t/taint.t See if File::Glob works
+ext/File/Glob/t/utf8.t See if File::Glob works
ext/File/Glob/TODO File::Glob extension todo list
ext/Filter/t/call.t See if Filter::Util::Call works
ext/Filter/Util/Call/Call.pm Filter::Util::Call extension module
GLOB_NOSPACE
GLOB_QUOTE
GLOB_TILDE
+ GLOB_UTF8
);
%EXPORT_TAGS = (
GLOB_NOSPACE
GLOB_QUOTE
GLOB_TILDE
+ GLOB_UTF8
glob
bsd_glob
) ],
require Exporter;
my $i = 1;
while ($i < @_) {
- if ($_[$i] =~ /^:(case|nocase|globally)$/) {
+ if ($_[$i] =~ /^:(case|nocase|globally|utf8)$/) {
splice(@_, $i, 1);
$DEFAULT_FLAGS &= ~GLOB_NOCASE() if $1 eq 'case';
$DEFAULT_FLAGS |= GLOB_NOCASE() if $1 eq 'nocase';
+ $DEFAULT_FLAGS |= GLOB_UTF8() if $1 eq 'utf8';
if ($1 eq 'globally') {
local $^W;
*CORE::GLOBAL::glob = \&File::Glob::csh_glob;
## override the core glob (CORE::glob() does this automatically
## by default anyway, since v5.6.0)
use File::Glob ':globally';
- my @sources = <*.{c,h,y}>
+ my @sources = <*.{c,h,y}>;
## override the core glob, forcing case sensitivity
use File::Glob qw(:globally :case);
- my @sources = <*.{c,h,y}>
+ my @sources = <*.{c,h,y}>;
## override the core glob forcing case insensitivity
use File::Glob qw(:globally :nocase);
- my @sources = <*.{c,h,y}>
+ my @sources = <*.{c,h,y}>;
+
+ ## override the core glob forcing UTF-8 names
+ use File::Glob qw(:globally :utf8);
+ my @sources = <*.{c,h,y}>;
=head1 DESCRIPTION
=back
+The following flag has been added in the Perl implementation for
+Unicode compatibility:
+
+=over 4
+
+=item C<GLOB_UTF8>
+
+The filenames returned will be marked as being in UTF-8 encoding of
+Unicode. Note that it is your responsibility to ascertain that the
+filesystem you are globbing in returns valid UTF-8 filenames.
+The encoding pragma affects this feature, see L<encoding>.
+
=head1 DIAGNOSTICS
bsd_glob() returns a list of matching paths, possibly zero length. If an
strlen(pglob.gl_pathv[i])));
TAINT;
SvTAINT(tmp);
+ if (pglob.gl_flags & GLOB_UTF8)
+ sv_utf8_upgrade(tmp);
PUSHs(tmp);
}
NAME => 'File::Glob',
NAMES => [qw(GLOB_ABEND GLOB_ALPHASORT GLOB_ALTDIRFUNC GLOB_BRACE GLOB_ERR
GLOB_LIMIT GLOB_MARK GLOB_NOCASE GLOB_NOCHECK GLOB_NOMAGIC
- GLOB_NOSORT GLOB_NOSPACE GLOB_QUOTE GLOB_TILDE),
+ GLOB_NOSORT GLOB_NOSPACE GLOB_QUOTE GLOB_TILDE GLOB_UTF8),
{name=>"GLOB_ERROR", macro=>["#ifdef GLOB_ERROR\n\tdMY_CXT;\n\n","#endif\n"]}],
BREAKOUT_AT => 8,
);
#define GLOB_ALPHASORT 0x2000 /* Alphabetic, not ASCII sort, like csh. */
#define GLOB_LIMIT 0x4000 /* Limit pattern match output to ARG_MAX
(usually from limits.h). */
+#define GLOB_UTF8 0x8000 /* Return UTF-8. (Perl extension.) */
#define GLOB_NOSPACE (-1) /* Malloc call failed. */
#define GLOB_ABEND (-2) /* Unignored error. */
--- /dev/null
+use File::Glob qw(:globally :utf8);
+
+# Can't really depend on Tru64 UTF-8 filenames being so must just see
+# that things don't crash and that *if* UTF-8 were to be received, it's
+# valid. (Maybe later add checks that are run if we are on NTFS/HFS+.)
+# (see also t/op/readdir.t)
+
+print "1..2\n";
+
+my $a = <*>;
+
+print utf8::valid($a) ? "ok 1\n" : "not ok 1\n";
+
+my @a=<*>;
+
+print utf8::valid($a[0]) ? "ok 2\n" : "not ok 2\n";
+
0x0001368c, /* readlink */
0x0012291c, /* mkdir */
0x0001379c, /* rmdir */
- 0x0002c814, /* open_dir */
+ 0x0122c814, /* open_dir */
0x0000d600, /* readdir */
0x0000d60c, /* telldir */
0x0002c804, /* seekdir */
# Directory calls.
-open_dir opendir ck_fun is@ F S
+open_dir opendir ck_fun is@ F S S?
readdir readdir ck_fun % F
telldir telldir ck_fun st% F
seekdir seekdir ck_fun s@ F S
the default encoding of your STDIN, STDOUT, and STDERR, and of
B<any subsequent file open>, is UTF-8.
+=item *
+
+If your filesystem supports returning UTF-8 encoded filenames,
+it is possible to make Perl to understand that the filenames
+returned by readdir() and glob() are in Unicode.
+
=back
=head2 Safe Signals
(F) There are no byte-swapping functions for a machine with this byte
order.
+=item Unknown discipline '%s'
+
+(F) You specified an unknown I/O discipline. See L<open> for valid
+filehandle disciplines and L<perlfunc/opendir> for valid directory
+handle disciplines.
+
=item Unknown "re" subpragma '%s' (known ones are: %s)
You tried to use an unknown subpragma of the "re" pragma.
See L</seek> for some details about mixing reading and writing.
+=item opendir DIRHANDLE,MODE,EXPR
+
=item opendir DIRHANDLE,EXPR
Opens a directory named EXPR for processing by C<readdir>, C<telldir>,
C<seekdir>, C<rewinddir>, and C<closedir>. Returns true if successful.
DIRHANDLEs have their own namespace separate from FILEHANDLEs.
+In three-argument form the middle argument may be C<:utf8> to force
+the filenames returned by readdir() to be in UTF-8 encoding of Unicode.
+This naturally works only if your filesystem returns UTF-8 filenames.
+The encoding pragma affects this feature, see L<encoding>.
+
=item ord EXPR
=item ord
@dots = grep { /^\./ && -f "$some_dir/$_" } readdir(DIR);
closedir DIR;
+In some filesystems it is possible to return UTF-8 encoded filenames.
+To get readdir() to return such filenames, you must use C<:utf8> with
+the three-argument form of opendir(), see L</opendir>.
+
=item readline EXPR
Reads from the filehandle whose typeglob is contained in EXPR. In scalar
perl's encoding on output by use of the ":encoding(...)" layer.
See L<open>.
+In some filesystems (for example Microsoft NTFS and Apple HFS+) the
+filenames are in UTF-8 . By using opendir() and File::Glob you can
+make readdir() and glob() to return the filenames as Unicode, see
+L<perlfunc/opendir> and L<File::Glob> for details.
+
To mark the Perl source itself as being in a particular encoding,
see L<encoding>.
UTF-8 encoded. A C<use open ':utf8'> would have avoided the bug, or
explicitly opening also the F<file> for input as UTF-8.
+In some filesystems (for example Microsoft NTFS and Apple HFS+) the
+filenames are in UTF-8 . By using opendir() and File::Glob you can
+make readdir() and glob() to return the filenames as Unicode, see
+L<perlfunc/opendir> and L<File::Glob> for details.
+
B<NOTE>: the C<:utf8> and C<:encoding> features work only if your
Perl has been built with the new "perlio" feature. Almost all
Perl 5.8 platforms do use "perlio", though: you can see whether
dSP;
STRLEN n_a;
char *dirname = POPpx;
- GV *gv = (GV*)POPs;
- register IO *io = GvIOn(gv);
+ char *dscp = NULL;
+ GV *gv;
+ register IO *io;
+ bool want_utf8 = FALSE;
+
+ if (MAXARG == 3)
+ dscp = POPpx;
+
+ gv = (GV*)POPs;
+ io = GvIOn(gv);
if (!io)
goto nope;
+ if (dscp) {
+ if (*dscp == ':') {
+ if (strnEQ(dscp + 1, "utf8", 4))
+ want_utf8 = TRUE;
+ else
+ Perl_croak(aTHX_ "Unknown discipline '%s'", dscp);
+ }
+ else
+ Perl_croak(aTHX_ "Unknown discipline '%s'", dscp);
+ }
+
if (IoDIRP(io))
PerlDir_close(IoDIRP(io));
if (!(IoDIRP(io) = PerlDir_open(dirname)))
goto nope;
+ if (want_utf8)
+ IoFLAGS(io) |= IOf_DIR_UTF8;
+
RETPUSHYES;
nope:
if (!errno)
if (!(IoFLAGS(io) & IOf_UNTAINT))
SvTAINTED_on(sv);
#endif
+ if (IoFLAGS(io) & IOf_DIR_UTF8)
+ sv_utf8_upgrade(sv);
XPUSHs(sv_2mortal(sv));
}
}
if (!(IoFLAGS(io) & IOf_UNTAINT))
SvTAINTED_on(sv);
#endif
+ if (IoFLAGS(io) & IOf_DIR_UTF8)
+ sv_utf8_upgrade(sv);
XPUSHs(sv_2mortal(sv));
}
RETURN;
#define IOf_UNTAINT 16 /* consider this fp (and its data) "safe" */
#define IOf_NOLINE 32 /* slurped a pseudo-line from empty file */
#define IOf_FAKE_DIRP 64 /* xio_dirp is fake (source filters kludge) */
+#define IOf_DIR_UTF8 128 /* readdir tries to return utf8 */
/* The following macros define implementation-independent predicates on SVs. */
eval 'opendir(NOSUCH, "no/such/directory");';
if ($@) { print "1..0\n"; exit; }
-print "1..3\n";
+print "1..6\n";
for $i (1..2000) {
local *OP;
shift(@G);
}
if (@R == 0 && @G == 0) { print "ok 3\n"; } else { print "not ok 3\n"; }
+
+# Can't really depend on Tru64 UTF-8 filenames being so must just see
+# that things don't crash and that *if* UTF-8 were to be received, it's
+# valid. (Maybe later add checks that are run if we are on NTFS/HFS+.)
+# (see also ext/File/Glob/t/utf8.t)
+
+opendir(OP, ":utf8", "op");
+
+my $a = readdir(OP);
+
+print utf8::valid($a) ? "ok 4\n" : "not ok 4\n";
+
+my @a = readdir(OP);
+
+print utf8::valid($a[0]) ? "ok 5\n" : "not ok 5\n";
+
+# But we can check for bogus mode arguments.
+
+eval { opendir(OP, ":foo", "op") };
+
+print $@ =~ /Unknown discipline ':foo'/ ? "ok 6\n" : "not ok 6\n";
+
projects / p5sagit/p5-mst-13.2.git / commitdiff