/usr/lib/perl/5.14.2/File/Glob.pm is in perl-base 5.14.2-6ubuntu2.5.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 | package File::Glob;
use strict;
our($VERSION, @ISA, @EXPORT_OK, @EXPORT_FAIL, %EXPORT_TAGS, $DEFAULT_FLAGS);
require XSLoader;
use feature 'switch';
@ISA = qw(Exporter);
# NOTE: The glob() export is only here for compatibility with 5.6.0.
# csh_glob() should not be used directly, unless you know what you're doing.
%EXPORT_TAGS = (
'glob' => [ qw(
GLOB_ABEND
GLOB_ALPHASORT
GLOB_ALTDIRFUNC
GLOB_BRACE
GLOB_CSH
GLOB_ERR
GLOB_ERROR
GLOB_LIMIT
GLOB_MARK
GLOB_NOCASE
GLOB_NOCHECK
GLOB_NOMAGIC
GLOB_NOSORT
GLOB_NOSPACE
GLOB_QUOTE
GLOB_TILDE
glob
bsd_glob
) ],
);
@EXPORT_OK = (@{$EXPORT_TAGS{'glob'}}, 'csh_glob');
$VERSION = '1.13';
sub import {
require Exporter;
local $Exporter::ExportLevel = $Exporter::ExportLevel + 1;
Exporter::import(grep {
my $passthrough;
given ($_) {
$DEFAULT_FLAGS &= ~GLOB_NOCASE() when ':case';
$DEFAULT_FLAGS |= GLOB_NOCASE() when ':nocase';
when (':globally') {
no warnings 'redefine';
*CORE::GLOBAL::glob = \&File::Glob::csh_glob;
}
$passthrough = 1;
}
$passthrough;
} @_);
}
XSLoader::load();
$DEFAULT_FLAGS = GLOB_CSH();
if ($^O =~ /^(?:MSWin32|VMS|os2|dos|riscos)$/) {
$DEFAULT_FLAGS |= GLOB_NOCASE();
}
# File::Glob::glob() is deprecated because its prototype is different from
# CORE::glob() (use bsd_glob() instead)
sub glob {
splice @_, 1; # don't pass PL_glob_index as flags!
goto &bsd_glob;
}
## borrowed heavily from gsar's File::DosGlob
my %iter;
my %entries;
sub csh_glob {
my $pat = shift;
my $cxix = shift;
my @pat;
# glob without args defaults to $_
$pat = $_ unless defined $pat;
# extract patterns
$pat =~ s/^\s+//; # Protect against empty elements in
$pat =~ s/\s+$//; # things like < *.c> and <*.c >.
# These alone shouldn't trigger ParseWords.
if ($pat =~ /\s/) {
# XXX this is needed for compatibility with the csh
# implementation in Perl. Need to support a flag
# to disable this behavior.
require Text::ParseWords;
@pat = Text::ParseWords::parse_line('\s+',0,$pat);
}
# assume global context if not provided one
$cxix = '_G_' unless defined $cxix;
$iter{$cxix} = 0 unless exists $iter{$cxix};
# if we're just beginning, do it all first
if ($iter{$cxix} == 0) {
if (@pat) {
$entries{$cxix} = [ map { doglob($_, $DEFAULT_FLAGS) } @pat ];
}
else {
$entries{$cxix} = [ doglob($pat, $DEFAULT_FLAGS) ];
}
}
# chuck it all out, quick or slow
if (wantarray) {
delete $iter{$cxix};
return @{delete $entries{$cxix}};
}
else {
if ($iter{$cxix} = scalar @{$entries{$cxix}}) {
return shift @{$entries{$cxix}};
}
else {
# return undef for EOL
delete $iter{$cxix};
delete $entries{$cxix};
return undef;
}
}
}
1;
__END__
|