Move File::DosGlob from lib to ext

2 files changed, 0 insertions, 429 deletions

diff --git a/lib/File/DosGlob.pm b/lib/File/DosGlob.pm
deleted file mode 100644
index 8208f6790b..0000000000
--- a/lib/File/DosGlob.pm
+++ /dev/null
@@ -1,297 +0,0 @@
-#!perl -w
-
-#
-# Documentation at the __END__
-#
-
-package File::DosGlob;
-
-our $VERSION = '1.08';
-use strict;
-use warnings;
-
-sub doglob {
-    my $cond = shift;
-    my @retval = ();
-    my $fix_drive_relative_paths;
-  OUTER:
-    for my $pat (@_) {
-	my @matched = ();
-	my @globdirs = ();
-	my $head = '.';
-	my $sepchr = '/';
-        my $tail;
-	next OUTER unless defined $pat and $pat ne '';
-	# if arg is within quotes strip em and do no globbing
-	if ($pat =~ /^"(.*)"\z/s) {
-	    $pat = $1;
-	    if ($cond eq 'd') { push(@retval, $pat) if -d $pat }
-	    else              { push(@retval, $pat) if -e $pat }
-	    next OUTER;
-	}
-	# wildcards with a drive prefix such as h:*.pm must be changed
-	# to h:./*.pm to expand correctly
-	if ($pat =~ m|^([A-Za-z]:)[^/\\]|s) {
-	    substr($pat,0,2) = $1 . "./";
-	    $fix_drive_relative_paths = 1;
-	}
-	if ($pat =~ m|^(.*)([\\/])([^\\/]*)\z|s) {
-	    ($head, $sepchr, $tail) = ($1,$2,$3);
-	    push (@retval, $pat), next OUTER if $tail eq '';
-	    if ($head =~ /[*?]/) {
-		@globdirs = doglob('d', $head);
-		push(@retval, doglob($cond, map {"$_$sepchr$tail"} @globdirs)),
-		    next OUTER if @globdirs;
-	    }
-	    $head .= $sepchr if $head eq '' or $head =~ /^[A-Za-z]:\z/s;
-	    $pat = $tail;
-	}
-	#
-	# If file component has no wildcards, we can avoid opendir
-	unless ($pat =~ /[*?]/) {
-	    $head = '' if $head eq '.';
-	    $head .= $sepchr unless $head eq '' or substr($head,-1) eq $sepchr;
-	    $head .= $pat;
-	    if ($cond eq 'd') { push(@retval,$head) if -d $head }
-	    else              { push(@retval,$head) if -e $head }
-	    next OUTER;
-	}
-	opendir(D, $head) or next OUTER;
-	my @leaves = readdir D;
-	closedir D;
-	$head = '' if $head eq '.';
-	$head .= $sepchr unless $head eq '' or substr($head,-1) eq $sepchr;
-
-	# escape regex metachars but not glob chars
-	$pat =~ s:([].+^\-\${}()[|]):\\$1:g;
-	# and convert DOS-style wildcards to regex
-	$pat =~ s/\*/.*/g;
-	$pat =~ s/\?/.?/g;
-
-	my $matchsub = sub { $_[0] =~ m|^$pat\z|is };
-      INNER:
-	for my $e (@leaves) {
-	    next INNER if $e eq '.' or $e eq '..';
-	    next INNER if $cond eq 'd' and ! -d "$head$e";
-	    push(@matched, "$head$e"), next INNER if &$matchsub($e);
-	    #
-	    # [DOS compatibility special case]
-	    # Failed, add a trailing dot and try again, but only
-	    # if name does not have a dot in it *and* pattern
-	    # has a dot *and* name is shorter than 9 chars.
-	    #
-	    if (index($e,'.') == -1 and length($e) < 9
-	        and index($pat,'\\.') != -1) {
-		push(@matched, "$head$e"), next INNER if &$matchsub("$e.");
-	    }
-	}
-	push @retval, @matched if @matched;
-    }
-    if ($fix_drive_relative_paths) {
-	s|^([A-Za-z]:)\./|$1| for @retval;
-    }
-    return @retval;
-}
-
-#
-# this can be used to override CORE::glob in a specific
-# package by saying C<use File::DosGlob 'glob';> in that
-# namespace.
-#
-
-# context (keyed by second cxix arg provided by core)
-my %entries;
-
-sub glob {
-    my($pat,$cxix) = @_;
-    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
-      if ($pat =~ /\s/) {
-	require Text::ParseWords;
-	@pat = Text::ParseWords::parse_line('\s+',0,$pat);
-      }
-      else {
-	push @pat, $pat;
-      }
-
-      # Mike Mestnik: made to do abc{1,2,3} == abc1 abc2 abc3.
-      #   abc3 will be the original {3} (and drop the {}).
-      #   abc1 abc2 will be put in @appendpat.
-      # This was just the easiest way, not nearly the best.
-      REHASH: {
-	my @appendpat = ();
-	for (@pat) {
-	    # There must be a "," I.E. abc{efg} is not what we want.
-	    while ( /^(.*)(?<!\\)\{(.*?)(?<!\\)\,.*?(?<!\\)\}(.*)$/ ) {
-		my ($start, $match, $end) = ($1, $2, $3);
-		#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/ ) {
-		    #  these expansions will be performed by the original,
-		    #  when we call REHASH.
-		}
-		push @appendpat, ("$tmp");
-		s/^\Q$start\E(?<!\\)\{\Q$match\E(?<!\\)\,/$start\{/;
-		if ( /^\Q$start\E(?<!\\)\{(?!.*?(?<!\\)\,.*?\Q$end\E$)(.*)(?<!\\)\}\Q$end\E$/ ) {
-		    $match = $1;
-		    #print "GOT: \n\t$start\n\t$match\n\t$end\n\n";
-		    $_ = "$start$match$end";
-		}
-	    }
-	    #print "Sould have "GOT" vs "Got"!\n";
-		#FIXME: There should be checking for this.
-		#  How or what should be done about failure is beond me.
-	}
-	if ( $#appendpat != -1
-		) {
-	    #FIXME: Max loop, no way! :")
-	    for ( @appendpat ) {
-	        push @pat, $_;
-	    }
-	    goto REHASH;
-	}
-      }
-      for ( @pat ) {
-	s/\\([{},])/$1/g;
-      }
- 
-      $entries{$cxix} = [doglob(1,@pat)];
-    }
-
-    # chuck it all out, quick or slow
-    if (wantarray) {
-	return @{delete $entries{$cxix}};
-    }
-    else {
-	if (scalar @{$entries{$cxix}}) {
-	    return shift @{$entries{$cxix}};
-	}
-	else {
-	    # return undef for EOL
-	    delete $entries{$cxix};
-	    return undef;
-	}
-    }
-}
-
-{
-    no strict 'refs';
-
-    sub import {
-    my $pkg = shift;
-    return unless @_;
-    my $sym = shift;
-    my $callpkg = ($sym =~ s/^GLOBAL_//s ? 'CORE::GLOBAL' : caller(0));
-    *{$callpkg.'::'.$sym} = \&{$pkg.'::'.$sym} if $sym eq 'glob';
-    }
-}
-1;
-
-__END__
-
-=head1 NAME
-
-File::DosGlob - DOS like globbing and then some
-
-=head1 SYNOPSIS
-
-    require 5.004;
-
-    # override CORE::glob in current package
-    use File::DosGlob 'glob';
-
-    # override CORE::glob in ALL packages (use with extreme caution!)
-    use File::DosGlob 'GLOBAL_glob';
-
-    @perlfiles = glob  "..\\pe?l/*.p?";
-    print <..\\pe?l/*.p?>;
-
-    # from the command line (overrides only in main::)
-    > perl -MFile::DosGlob=glob -e "print <../pe*/*p?>"
-
-=head1 DESCRIPTION
-
-A module that implements DOS-like globbing with a few enhancements.
-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
-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.
-You may have to double the backslashes if you are putting them in
-literally, due to double-quotish parsing of the pattern by perl.
-
-Spaces in the argument delimit distinct patterns, so
-C<glob('*.exe *.dll')> globs all filenames that end in C<.exe>
-or C<.dll>.  If you want to put in literal spaces in the glob
-pattern, you can escape them with either double quotes, or backslashes.
-e.g. C<glob('c:/"Program Files"/*/*.dll')>, or
-C<glob('c:/Program\ Files/*/*.dll')>.  The argument is tokenized using
-C<Text::ParseWords::parse_line()>, so see L<Text::ParseWords> for details
-of the quoting rules used.
-
-Extending it to csh patterns is left as an exercise to the reader.
-
-=head1 EXPORTS (by request only)
-
-glob()
-
-=head1 BUGS
-
-Should probably be built into the core, and needs to stop
-pandering to DOS habits.  Needs a dose of optimizium too.
-
-=head1 AUTHOR
-
-Gurusamy Sarathy <gsar@activestate.com>
-
-=head1 HISTORY
-
-=over 4
-
-=item *
-
-Support for globally overriding glob() (GSAR 3-JUN-98)
-
-=item *
-
-Scalar context, independent iterator context fixes (GSAR 15-SEP-97)
-
-=item *
-
-A few dir-vs-file optimizations result in glob importation being
-10 times faster than using perlglob.exe, and using perlglob.bat is
-only twice as slow as perlglob.exe (GSAR 28-MAY-97)
-
-=item *
-
-Several cleanups prompted by lack of compatible perlglob.exe
-under Borland (GSAR 27-MAY-97)
-
-=item *
-
-Initial version (GSAR 20-FEB-97)
-
-=back
-
-=head1 SEE ALSO
-
-perl
-
-perlglob.bat
-
-Text::ParseWords
-
-=cut
-
diff --git a/lib/File/DosGlob.t b/lib/File/DosGlob.t
deleted file mode 100644
index 9227cb9871..0000000000
--- a/lib/File/DosGlob.t
+++ /dev/null
@@ -1,132 +0,0 @@
-#!./perl
-
-#
-# test glob() in File::DosGlob
-#
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
-use Test::More tests => 20;
-
-# override it in main::
-use File::DosGlob 'glob';
-
-require Cwd;
-
-my $expected;
-$expected = $_ = "op/a*.t";
-my @r = glob;
-is ($_, $expected, 'test if $_ takes as the default');
-cmp_ok(@r, '>=', 9) or diag("|@r|");
-
-@r = <*/a*.t>;
-# atleast {argv,abbrev,anydbm,autoloader,append,arith,array,assignwarn,auto}.t
-cmp_ok(@r, '>=', 9, 'check <*/*>') or diag("|@r|");
-my $r = scalar @r;
-
-@r = ();
-while (defined($_ = <*/a*.t>)) {
-    print "# $_\n";
-    push @r, $_;
-}
-is(scalar @r, $r, 'check scalar context');
-
-@r = ();
-for (<*/a*.t>) {
-    print "# $_\n";
-    push @r, $_;
-}
-is(scalar @r, $r, 'check list context');
-
-@r = ();
-while (<*/a*.t>) {
-    print "# $_\n";
-    push @r, $_;
-}
-is(scalar @r, $r, 'implicit assign to $_ in while()');
-
-my @s = ();
-my $pat = '*/a*.t';
-while (glob ($pat)) {
-    print "# $_\n";
-    push @s, $_;
-}
-is("@r", "@s", 'explicit glob() gets assign magic too');
-
-package Foo;
-use File::DosGlob 'glob';
-use Test::More;
-@s = ();
-$pat = '*/a*.t';
-while (glob($pat)) {
-    print "# $_\n";
-    push @s, $_;
-}
-is("@r", "@s", 'in a different package');
-
-@s = ();
-while (<*/a*.t>) {
-    my $i = 0;
-    print "# $_ <";
-    push @s, $_;
-    while (<*/b*.t>) {
-	print " $_";
-	$i++;
-    }
-    print " >\n";
-}
-is("@r", "@s", 'different glob ops maintain independent contexts');
-
-@s = ();
-eval <<'EOT';
-use File::DosGlob 'GLOBAL_glob';
-package Bar;
-while (<*/a*.t>) {
-    my $i = 0;
-    print "# $_ <";
-    push @s, $_;
-    while (glob '*/b*.t') {
-	print " $_";
-	$i++;
-    }
-    print " >\n";
-}
-EOT
-is("@r", "@s", 'global override');
-
-# Test that a glob pattern containing ()'s works.
-# NB. The spaces in the glob patterns need to be backslash escaped.
-my $filename_containing_parens = "foo (123) bar";
-SKIP: {
-    skip("can't create '$filename_containing_parens': $!", 9)
-	unless open my $touch, ">", $filename_containing_parens;
-    close $touch;
-
-    foreach my $pattern ("foo\\ (*", "*)\\ bar", "foo\\ (1*3)\\ bar") {
-	@r = ();
-	eval { @r = File::DosGlob::glob($pattern) };
-	is($@, "", "eval for glob($pattern)");
-	is(scalar @r, 1);
-	is($r[0], $filename_containing_parens);
-    }
-
-    1 while unlink $filename_containing_parens;
-}
-
-# Test the globbing of a drive relative pattern such as "c:*.pl".
-# NB. previous versions of DosGlob inserted "./ after the drive letter to
-# make the expansion process work correctly. However, while it is harmless,
-# there is no reason for it to be in the result.
-my $cwd = Cwd::cwd();
-if ($cwd =~ /^([a-zA-Z]:)/) {
-    my $drive = $1;
-    @r = ();
-    # This assumes we're in the "t" directory.
-    eval { @r = File::DosGlob::glob("${drive}io/*.t") };
-    ok(@r and !grep !m|^${drive}io/[^/]*\.t$|, @r);
-} else {
-    pass();
-}