summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/File/DosGlob.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/File/DosGlob.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/File/DosGlob.pm34
1 files changed, 15 insertions, 19 deletions
diff --git a/Master/tlpkg/tlperl/lib/File/DosGlob.pm b/Master/tlpkg/tlperl/lib/File/DosGlob.pm
index 7e57175ca3f..c90bebb2780 100644
--- a/Master/tlpkg/tlperl/lib/File/DosGlob.pm
+++ b/Master/tlpkg/tlperl/lib/File/DosGlob.pm
@@ -1,23 +1,22 @@
#!perl -w
-# use strict fails
-#Can't use string ("main::glob") as a symbol ref while "strict refs" in use at /usr/lib/perl5/5.005/File/DosGlob.pm line 191.
-
#
# Documentation at the __END__
#
package File::DosGlob;
-our $VERSION = '1.06';
+our $VERSION = '1.10';
use strict;
use warnings;
+require XSLoader;
+XSLoader::load();
+
sub doglob {
my $cond = shift;
my @retval = ();
my $fix_drive_relative_paths;
- #print "doglob: ", join('|', @_), "\n";
OUTER:
for my $pat (@_) {
my @matched = ();
@@ -41,7 +40,6 @@ sub doglob {
}
if ($pat =~ m|^(.*)([\\/])([^\\/]*)\z|s) {
($head, $sepchr, $tail) = ($1,$2,$3);
- #print "div: |$head|$sepchr|$tail|\n";
push (@retval, $pat), next OUTER if $tail eq '';
if ($head =~ /[*?]/) {
@globdirs = doglob('d', $head);
@@ -64,6 +62,13 @@ sub doglob {
opendir(D, $head) or next OUTER;
my @leaves = readdir D;
closedir D;
+
+ # VMS-format filespecs, especially if they contain extended characters,
+ # are unlikely to match patterns correctly, so Unixify them.
+ if ($^O eq 'VMS') {
+ require VMS::Filespec;
+ @leaves = map {$_ =~ s/\.$//; VMS::Filespec::unixify($_)} @leaves;
+ }
$head = '' if $head eq '.';
$head .= $sepchr unless $head eq '' or substr($head,-1) eq $sepchr;
@@ -73,7 +78,6 @@ sub doglob {
$pat =~ s/\*/.*/g;
$pat =~ s/\?/.?/g;
- #print "regex: '$pat', head: '$head'\n";
my $matchsub = sub { $_[0] =~ m|^$pat\z|is };
INNER:
for my $e (@leaves) {
@@ -106,18 +110,15 @@ sub doglob {
#
# context (keyed by second cxix arg provided by core)
-my %entries;
+our %entries;
sub glob {
- my($pat,$cxix) = @_;
+ my($pat,$cxix) = ($_[0], _callsite());
my @pat;
# glob without args defaults to $_
$pat = $_ unless defined $pat;
- # assume global context if not provided one
- $cxix = '_G_' unless defined $cxix;
-
# if we're just beginning, do it all first
if (!$entries{$cxix}) {
# extract patterns
@@ -142,7 +143,6 @@ sub glob {
#print "Got: \n\t$start\n\t$match\n\t$end\n";
my $tmp = "$start$match$end";
while ( $tmp =~ s/^(.*?)(?<!\\)\{(?:.*(?<!\\)\,)?(.*\Q$match\E.*?)(?:(?<!\\)\,.*)?(?<!\\)\}(.*)$/$1$2$3/ ) {
- #print "Striped: $tmp\n";
# these expansions will be performed by the original,
# when we call REHASH.
}
@@ -160,7 +160,6 @@ sub glob {
}
if ( $#appendpat != -1
) {
- #print "LOOP\n";
#FIXME: Max loop, no way! :")
for ( @appendpat ) {
push @pat, $_;
@@ -169,11 +168,8 @@ sub glob {
}
}
for ( @pat ) {
- s/\\{/{/g;
- s/\\}/}/g;
- s/\\,/,/g;
+ s/\\([{},])/$1/g;
}
- #print join ("\n", @pat). "\n";
$entries{$cxix} = [doglob(1,@pat)];
}
@@ -236,7 +232,7 @@ It is largely compatible with perlglob.exe (the M$ setargv.obj
version) in all but one respect--it understands wildcards in
directory components.
-For example, C<<..\\l*b\\file/*glob.p?>> will work as expected (in
+For example, C<< <..\\l*b\\file/*glob.p?> >> will work as expected (in
that it will find something like '..\lib\File/DosGlob.pm' alright).
Note that all path components are case-insensitive, and that
backslashes and forward slashes are both accepted, and preserved.