| Current File : /home/mmdealscpanel/yummmdeals.com/File.tar |
Glob.pm 0000644 00000031533 15032757765 0006013 0 ustar 00 package File::Glob;
use strict;
our($VERSION, @ISA, @EXPORT_OK, @EXPORT_FAIL, %EXPORT_TAGS, $DEFAULT_FLAGS);
require XSLoader;
@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
bsd_glob
glob
) ],
);
$EXPORT_TAGS{bsd_glob} = [@{$EXPORT_TAGS{glob}}];
pop @{$EXPORT_TAGS{bsd_glob}}; # no "glob"
@EXPORT_OK = (@{$EXPORT_TAGS{'glob'}}, 'csh_glob');
$VERSION = '1.28';
sub import {
require Exporter;
local $Exporter::ExportLevel = $Exporter::ExportLevel + 1;
Exporter::import(grep {
my $passthrough;
if ($_ eq ':case') {
$DEFAULT_FLAGS &= ~GLOB_NOCASE()
}
elsif ($_ eq ':nocase') {
$DEFAULT_FLAGS |= GLOB_NOCASE();
}
elsif ($_ eq ':globally') {
no warnings 'redefine';
*CORE::GLOBAL::glob = \&File::Glob::csh_glob;
}
elsif ($_ eq ':bsd_glob') {
no strict; *{caller."::glob"} = \&bsd_glob_override;
$passthrough = 1;
}
else {
$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 {
use 5.024;
use warnings ();
warnings::warnif (deprecated =>
"File::Glob::glob() will disappear in perl 5.30. " .
"Use File::Glob::bsd_glob() instead.") unless state $warned ++;
splice @_, 1; # no flags
goto &bsd_glob;
}
1;
__END__
=head1 NAME
File::Glob - Perl extension for BSD glob routine
=head1 SYNOPSIS
use File::Glob ':bsd_glob';
@list = bsd_glob('*.[ch]');
$homedir = bsd_glob('~gnat', GLOB_TILDE | GLOB_ERR);
if (GLOB_ERROR) {
# an error occurred reading $homedir
}
## 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}>;
## 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}>;
## glob on all files in home directory
use File::Glob ':globally';
my @sources = <~gnat/*>;
=head1 DESCRIPTION
The glob angle-bracket operator C<< <> >> is a pathname generator that
implements the rules for file name pattern matching used by Unix-like shells
such as the Bourne shell or C shell.
File::Glob::bsd_glob() implements the FreeBSD glob(3) routine, which is
a superset of the POSIX glob() (described in IEEE Std 1003.2 "POSIX.2").
bsd_glob() takes a mandatory C<pattern> argument, and an optional
C<flags> argument, and returns a list of filenames matching the
pattern, with interpretation of the pattern modified by the C<flags>
variable.
Since v5.6.0, Perl's CORE::glob() is implemented in terms of bsd_glob().
Note that they don't share the same prototype--CORE::glob() only accepts
a single argument. Due to historical reasons, CORE::glob() will also
split its argument on whitespace, treating it as multiple patterns,
whereas bsd_glob() considers them as one pattern. But see C<:bsd_glob>
under L</EXPORTS>, below.
=head2 META CHARACTERS
\ Quote the next metacharacter
[] Character class
{} Multiple pattern
* Match any string of characters
? Match any single character
~ User name home directory
The metanotation C<a{b,c,d}e> is a shorthand for C<abe ace ade>. Left to
right order is preserved, with results of matches being sorted separately
at a low level to preserve this order. As a special case C<{>, C<}>, and
C<{}> are passed undisturbed.
=head2 EXPORTS
See also the L</POSIX FLAGS> below, which can be exported individually.
=head3 C<:bsd_glob>
The C<:bsd_glob> export tag exports bsd_glob() and the constants listed
below. It also overrides glob() in the calling package with one that
behaves like bsd_glob() with regard to spaces (the space is treated as part
of a file name), but supports iteration in scalar context; i.e., it
preserves the core function's feature of returning the next item each time
it is called.
=head3 C<:glob>
The C<:glob> tag, now discouraged, is the old version of C<:bsd_glob>. It
exports the same constants and functions, but its glob() override does not
support iteration; it returns the last file name in scalar context. That
means this will loop forever:
use File::Glob ':glob';
while (my $file = <* copy.txt>) {
...
}
=head3 C<bsd_glob>
This function, which is included in the two export tags listed above,
takes one or two arguments. The first is the glob pattern. The
second, if given, is a set of flags ORed together. The available
flags and the default set of flags are listed below under L</POSIX FLAGS>.
Remember that to use the named constants for flags you must import
them, for example with C<:bsd_glob> described above. If not imported,
and C<use strict> is not in effect, then the constants will be
treated as bareword strings, which won't do what you what.
=head3 C<:nocase> and C<:case>
These two export tags globally modify the default flags that bsd_glob()
and, except on VMS, Perl's built-in C<glob> operator use. C<GLOB_NOCASE>
is turned on or off, respectively.
=head3 C<csh_glob>
The csh_glob() function can also be exported, but you should not use it
directly unless you really know what you are doing. It splits the pattern
into words and feeds each one to bsd_glob(). Perl's own glob() function
uses this internally.
=head2 POSIX FLAGS
If no flags argument is give then C<GLOB_CSH> is set, and on VMS and
Windows systems, C<GLOB_NOCASE> too. Otherwise the flags to use are
determined solely by the flags argument. The POSIX defined flags are:
=over 4
=item C<GLOB_ERR>
Force bsd_glob() to return an error when it encounters a directory it
cannot open or read. Ordinarily bsd_glob() continues to find matches.
=item C<GLOB_LIMIT>
Make bsd_glob() return an error (GLOB_NOSPACE) when the pattern expands
to a size bigger than the system constant C<ARG_MAX> (usually found in
limits.h). If your system does not define this constant, bsd_glob() uses
C<sysconf(_SC_ARG_MAX)> or C<_POSIX_ARG_MAX> where available (in that
order). You can inspect these values using the standard C<POSIX>
extension.
=item C<GLOB_MARK>
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 bsd_glob() treat case differences as not significant.
=item C<GLOB_NOCHECK>
If the pattern does not match any pathname, then bsd_glob() returns a list
consisting of only the pattern. If C<GLOB_QUOTE> is set, its effect
is present in the pattern returned.
=item C<GLOB_NOSORT>
By default, the pathnames are sorted in ascending ASCII order; this
flag prevents that sorting (speeding up bsd_glob()).
=back
The FreeBSD extensions to the POSIX standard are the following flags:
=over 4
=item C<GLOB_BRACE>
Pre-process the string to expand C<{pat,pat,...}> strings like csh(1).
The pattern '{}' is left unexpanded for historical reasons (and csh(1)
does the same thing to ease typing of find(1) patterns).
=item C<GLOB_NOMAGIC>
Same as C<GLOB_NOCHECK> but it only returns the pattern if it does not
contain any of the special characters "*", "?" or "[". C<NOMAGIC> is
provided to simplify implementing the historic csh(1) globbing
behaviour and should probably not be used anywhere else.
=item C<GLOB_QUOTE>
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>
Expand patterns that start with '~' to user name home directories.
=item C<GLOB_CSH>
For convenience, C<GLOB_CSH> is a synonym for
C<GLOB_BRACE | GLOB_NOMAGIC | GLOB_QUOTE | GLOB_TILDE | GLOB_ALPHASORT>.
=back
The POSIX provided C<GLOB_APPEND>, C<GLOB_DOOFFS>, and the FreeBSD
extensions C<GLOB_ALTDIRFUNC>, and C<GLOB_MAGCHAR> flags have not been
implemented in the Perl version because they involve more complex
interaction with the underlying C structures.
The following flag has been added in the Perl implementation for
csh compatibility:
=over 4
=item C<GLOB_ALPHASORT>
If C<GLOB_NOSORT> is not in effect, sort filenames is alphabetical
order (case does not matter) rather than in ASCII order.
=back
=head1 DIAGNOSTICS
bsd_glob() returns a list of matching paths, possibly zero length. If an
error occurred, &File::Glob::GLOB_ERROR will be non-zero and C<$!> will be
set. &File::Glob::GLOB_ERROR is guaranteed to be zero if no error occurred,
or one of the following values otherwise:
=over 4
=item C<GLOB_NOSPACE>
An attempt to allocate memory failed.
=item C<GLOB_ABEND>
The glob was stopped because an error was encountered.
=back
In the case where bsd_glob() has found some matching paths, but is
interrupted by an error, it will return a list of filenames B<and>
set &File::Glob::ERROR.
Note that bsd_glob() deviates from POSIX and FreeBSD glob(3) behaviour
by not considering C<ENOENT> and C<ENOTDIR> as errors - bsd_glob() will
continue processing despite those errors, unless the C<GLOB_ERR> flag is
set.
Be aware that all filenames returned from File::Glob are tainted.
=head1 NOTES
=over 4
=item *
If you want to use multiple patterns, e.g. C<bsd_glob("a* b*")>, you should
probably throw them in a set as in C<bsd_glob("{a*,b*}")>. This is because
the argument to bsd_glob() isn't subjected to parsing by the C shell.
Remember that you can use a backslash to escape things.
=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.
=back
=head1 SEE ALSO
L<perlfunc/glob>, glob(3)
=head1 AUTHOR
The Perl interface was written by Nathan Torkington E<lt>gnat@frii.comE<gt>,
and is released under the artistic license. Further modifications were
made by Greg Bacon E<lt>gbacon@cs.uah.eduE<gt>, Gurusamy Sarathy
E<lt>gsar@activestate.comE<gt>, and Thomas Wegner
E<lt>wegner_thomas@yahoo.comE<gt>. The C glob code has the
following copyright:
Copyright (c) 1989, 1993 The Regents of the University of California.
All rights reserved.
This code is derived from software contributed to Berkeley by
Guido van Rossum.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions
are met:
=over 4
=item 1.
Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
=item 2.
Redistributions in binary form must reproduce the above copyright
notice, this list of conditions and the following disclaimer in the
documentation and/or other materials provided with the distribution.
=item 3.
Neither the name of the University nor the names of its contributors
may be used to endorse or promote products derived from this software
without specific prior written permission.
=back
THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS "AS IS" AND
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
SUCH DAMAGE.
=cut
DosGlob.pm 0000644 00000017472 15032757765 0006467 0 ustar 00 #!perl -w
#
# Documentation at the __END__
#
package File::DosGlob;
our $VERSION = '1.12';
use strict;
use warnings;
require XSLoader;
XSLoader::load();
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;
# 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;
# 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)
our %entries;
sub glob {
my($pat,$cxix) = ($_[0], _callsite());
my @pat;
# glob without args defaults to $_
$pat = $_ unless defined $pat;
# 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 beyond 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 optimization 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
stat.pm 0000644 00000023536 15036324715 0006074 0 ustar 00 package File::stat;
use 5.006;
use strict;
use warnings;
use warnings::register;
use Carp;
BEGIN { *warnif = \&warnings::warnif }
our(@EXPORT, @EXPORT_OK, %EXPORT_TAGS);
our $VERSION = '1.07';
my @fields;
BEGIN {
use Exporter ();
@EXPORT = qw(stat lstat);
@fields = qw( $st_dev $st_ino $st_mode
$st_nlink $st_uid $st_gid
$st_rdev $st_size
$st_atime $st_mtime $st_ctime
$st_blksize $st_blocks
);
@EXPORT_OK = ( @fields, "stat_cando" );
%EXPORT_TAGS = ( FIELDS => [ @fields, @EXPORT ] );
}
use vars @fields;
use Fcntl qw(S_IRUSR S_IWUSR S_IXUSR);
BEGIN {
# These constants will croak on use if the platform doesn't define
# them. It's important to avoid inflicting that on the user.
no strict 'refs';
for (qw(suid sgid svtx)) {
my $val = eval { &{"Fcntl::S_I\U$_"} };
*{"_$_"} = defined $val ? sub { $_[0] & $val ? 1 : "" } : sub { "" };
}
for (qw(SOCK CHR BLK REG DIR LNK)) {
*{"S_IS$_"} = defined eval { &{"Fcntl::S_IF$_"} }
? \&{"Fcntl::S_IS$_"} : sub { "" };
}
# FIFO flag and macro don't quite follow the S_IF/S_IS pattern above
# RT #111638
*{"S_ISFIFO"} = defined &Fcntl::S_IFIFO
? \&Fcntl::S_ISFIFO : sub { "" };
}
# from doio.c
sub _ingroup {
my ($gid, $eff) = @_;
# I am assuming that since VMS doesn't have getgroups(2), $) will
# always only contain a single entry.
$^O eq "VMS" and return $_[0] == $);
my ($egid, @supp) = split " ", $);
my ($rgid) = split " ", $(;
$gid == ($eff ? $egid : $rgid) and return 1;
grep $gid == $_, @supp and return 1;
return "";
}
# VMS uses the Unix version of the routine, even though this is very
# suboptimal. VMS has a permissions structure that doesn't really fit
# into struct stat, and unlike on Win32 the normal -X operators respect
# that, but unfortunately by the time we get here we've already lost the
# information we need. It looks to me as though if we were to preserve
# the st_devnam entry of vmsish.h's fake struct stat (which actually
# holds the filename) it might be possible to do this right, but both
# getting that value out of the struct (perl's stat doesn't return it)
# and interpreting it later would require this module to have an XS
# component (at which point we might as well just call Perl_cando and
# have done with it).
if (grep $^O eq $_, qw/os2 MSWin32 dos/) {
# from doio.c
*cando = sub { ($_[0][2] & $_[1]) ? 1 : "" };
}
else {
# from doio.c
*cando = sub {
my ($s, $mode, $eff) = @_;
my $uid = $eff ? $> : $<;
my ($stmode, $stuid, $stgid) = @$s[2,4,5];
# This code basically assumes that the rwx bits of the mode are
# the 0777 bits, but so does Perl_cando.
if ($uid == 0 && $^O ne "VMS") {
# If we're root on unix
# not testing for executable status => all file tests are true
return 1 if !($mode & 0111);
# testing for executable status =>
# for a file, any x bit will do
# for a directory, always true
return 1 if $stmode & 0111 || S_ISDIR($stmode);
return "";
}
if ($stuid == $uid) {
$stmode & $mode and return 1;
}
elsif (_ingroup($stgid, $eff)) {
$stmode & ($mode >> 3) and return 1;
}
else {
$stmode & ($mode >> 6) and return 1;
}
return "";
};
}
# alias for those who don't like objects
*stat_cando = \&cando;
my %op = (
r => sub { cando($_[0], S_IRUSR, 1) },
w => sub { cando($_[0], S_IWUSR, 1) },
x => sub { cando($_[0], S_IXUSR, 1) },
o => sub { $_[0][4] == $> },
R => sub { cando($_[0], S_IRUSR, 0) },
W => sub { cando($_[0], S_IWUSR, 0) },
X => sub { cando($_[0], S_IXUSR, 0) },
O => sub { $_[0][4] == $< },
e => sub { 1 },
z => sub { $_[0][7] == 0 },
s => sub { $_[0][7] },
f => sub { S_ISREG ($_[0][2]) },
d => sub { S_ISDIR ($_[0][2]) },
l => sub { S_ISLNK ($_[0][2]) },
p => sub { S_ISFIFO($_[0][2]) },
S => sub { S_ISSOCK($_[0][2]) },
b => sub { S_ISBLK ($_[0][2]) },
c => sub { S_ISCHR ($_[0][2]) },
u => sub { _suid($_[0][2]) },
g => sub { _sgid($_[0][2]) },
k => sub { _svtx($_[0][2]) },
M => sub { ($^T - $_[0][9] ) / 86400 },
C => sub { ($^T - $_[0][10]) / 86400 },
A => sub { ($^T - $_[0][8] ) / 86400 },
);
use constant HINT_FILETEST_ACCESS => 0x00400000;
# we need fallback=>1 or stringifying breaks
use overload
fallback => 1,
-X => sub {
my ($s, $op) = @_;
if (index("rwxRWX", $op) >= 0) {
(caller 0)[8] & HINT_FILETEST_ACCESS
and warnif("File::stat ignores use filetest 'access'");
$^O eq "VMS" and warnif("File::stat ignores VMS ACLs");
# It would be nice to have a warning about using -l on a
# non-lstat, but that would require an extra member in the
# object.
}
if ($op{$op}) {
return $op{$op}->($_[0]);
}
else {
croak "-$op is not implemented on a File::stat object";
}
};
# Class::Struct forbids use of @ISA
sub import { goto &Exporter::import }
use Class::Struct qw(struct);
struct 'File::stat' => [
map { $_ => '$' } qw{
dev ino mode nlink uid gid rdev size
atime mtime ctime blksize blocks
}
];
sub populate (@) {
return unless @_;
my $stob = new();
@$stob = (
$st_dev, $st_ino, $st_mode, $st_nlink, $st_uid, $st_gid, $st_rdev,
$st_size, $st_atime, $st_mtime, $st_ctime, $st_blksize, $st_blocks )
= @_;
return $stob;
}
sub lstat ($) { populate(CORE::lstat(shift)) }
sub stat ($) {
my $arg = shift;
my $st = populate(CORE::stat $arg);
return $st if defined $st;
my $fh;
{
local $!;
no strict 'refs';
require Symbol;
$fh = \*{ Symbol::qualify( $arg, caller() )};
return unless defined fileno $fh;
}
return populate(CORE::stat $fh);
}
1;
__END__
=head1 NAME
File::stat - by-name interface to Perl's built-in stat() functions
=head1 SYNOPSIS
use File::stat;
$st = stat($file) or die "No $file: $!";
if ( ($st->mode & 0111) && $st->nlink > 1) ) {
print "$file is executable with lotsa links\n";
}
if ( -x $st ) {
print "$file is executable\n";
}
use Fcntl "S_IRUSR";
if ( $st->cando(S_IRUSR, 1) ) {
print "My effective uid can read $file\n";
}
use File::stat qw(:FIELDS);
stat($file) or die "No $file: $!";
if ( ($st_mode & 0111) && ($st_nlink > 1) ) {
print "$file is executable with lotsa links\n";
}
=head1 DESCRIPTION
This module's default exports override the core stat()
and lstat() functions, replacing them with versions that return
"File::stat" objects. This object has methods that
return the similarly named structure field name from the
stat(2) function; namely,
dev,
ino,
mode,
nlink,
uid,
gid,
rdev,
size,
atime,
mtime,
ctime,
blksize,
and
blocks.
As of version 1.02 (provided with perl 5.12) the object provides C<"-X">
overloading, so you can call filetest operators (C<-f>, C<-x>, and so
on) on it. It also provides a C<< ->cando >> method, called like
$st->cando( ACCESS, EFFECTIVE )
where I<ACCESS> is one of C<S_IRUSR>, C<S_IWUSR> or C<S_IXUSR> from the
L<Fcntl|Fcntl> module, and I<EFFECTIVE> indicates whether to use
effective (true) or real (false) ids. The method interprets the C<mode>,
C<uid> and C<gid> fields, and returns whether or not the current process
would be allowed the specified access.
If you don't want to use the objects, you may import the C<< ->cando >>
method into your namespace as a regular function called C<stat_cando>.
This takes an arrayref containing the return values of C<stat> or
C<lstat> as its first argument, and interprets it for you.
You may also import all the structure fields directly into your namespace
as regular variables using the :FIELDS import tag. (Note that this still
overrides your stat() and lstat() functions.) Access these fields as
variables named with a preceding C<st_> in front their method names.
Thus, C<$stat_obj-E<gt>dev()> corresponds to $st_dev if you import
the fields.
To access this functionality without the core overrides,
pass the C<use> an empty import list, and then access
function functions with their full qualified names.
On the other hand, the built-ins are still available
via the C<CORE::> pseudo-package.
=head1 BUGS
As of Perl 5.8.0 after using this module you cannot use the implicit
C<$_> or the special filehandle C<_> with stat() or lstat(), trying
to do so leads into strange errors. The workaround is for C<$_> to
be explicit
my $stat_obj = stat $_;
and for C<_> to explicitly populate the object using the unexported
and undocumented populate() function with CORE::stat():
my $stat_obj = File::stat::populate(CORE::stat(_));
=head1 ERRORS
=over 4
=item -%s is not implemented on a File::stat object
The filetest operators C<-t>, C<-T> and C<-B> are not implemented, as
they require more information than just a stat buffer.
=back
=head1 WARNINGS
These can all be disabled with
no warnings "File::stat";
=over 4
=item File::stat ignores use filetest 'access'
You have tried to use one of the C<-rwxRWX> filetests with C<use
filetest 'access'> in effect. C<File::stat> will ignore the pragma, and
just use the information in the C<mode> member as usual.
=item File::stat ignores VMS ACLs
VMS systems have a permissions structure that cannot be completely
represented in a stat buffer, and unlike on other systems the builtin
filetest operators respect this. The C<File::stat> overloads, however,
do not, since the information required is not available.
=back
=head1 NOTE
While this class is currently implemented using the Class::Struct
module to build a struct-like class, you shouldn't rely upon this.
=head1 AUTHOR
Tom Christiansen
Copy.pm 0000644 00000037434 15036324715 0006035 0 ustar 00 # File/Copy.pm. Written in 1994 by Aaron Sherman <ajs@ajs.com>. This
# source code has been placed in the public domain by the author.
# Please be kind and preserve the documentation.
#
# Additions copyright 1996 by Charles Bailey. Permission is granted
# to distribute the revised code under the same terms as Perl itself.
package File::Copy;
use 5.006;
use strict;
use warnings; no warnings 'newline';
use File::Spec;
use Config;
# During perl build, we need File::Copy but Scalar::Util might not be built yet
# And then we need these games to avoid loading overload, as that will
# confuse miniperl during the bootstrap of perl.
my $Scalar_Util_loaded = eval q{ require Scalar::Util; require overload; 1 };
our(@ISA, @EXPORT, @EXPORT_OK, $VERSION, $Too_Big, $Syscopy_is_copy);
sub copy;
sub syscopy;
sub cp;
sub mv;
$VERSION = '2.32';
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(copy move);
@EXPORT_OK = qw(cp mv);
$Too_Big = 1024 * 1024 * 2;
sub croak {
require Carp;
goto &Carp::croak;
}
sub carp {
require Carp;
goto &Carp::carp;
}
sub _catname {
my($from, $to) = @_;
if (not defined &basename) {
require File::Basename;
import File::Basename 'basename';
}
return File::Spec->catfile($to, basename($from));
}
# _eq($from, $to) tells whether $from and $to are identical
sub _eq {
my ($from, $to) = map {
$Scalar_Util_loaded && Scalar::Util::blessed($_)
&& overload::Method($_, q{""})
? "$_"
: $_
} (@_);
return '' if ( (ref $from) xor (ref $to) );
return $from == $to if ref $from;
return $from eq $to;
}
sub copy {
croak("Usage: copy(FROM, TO [, BUFFERSIZE]) ")
unless(@_ == 2 || @_ == 3);
my $from = shift;
my $to = shift;
my $size;
if (@_) {
$size = shift(@_) + 0;
croak("Bad buffer size for copy: $size\n") unless ($size > 0);
}
my $from_a_handle = (ref($from)
? (ref($from) eq 'GLOB'
|| UNIVERSAL::isa($from, 'GLOB')
|| UNIVERSAL::isa($from, 'IO::Handle'))
: (ref(\$from) eq 'GLOB'));
my $to_a_handle = (ref($to)
? (ref($to) eq 'GLOB'
|| UNIVERSAL::isa($to, 'GLOB')
|| UNIVERSAL::isa($to, 'IO::Handle'))
: (ref(\$to) eq 'GLOB'));
if (_eq($from, $to)) { # works for references, too
carp("'$from' and '$to' are identical (not copied)");
return 0;
}
if (!$from_a_handle && !$to_a_handle && -d $to && ! -d $from) {
$to = _catname($from, $to);
}
if ((($Config{d_symlink} && $Config{d_readlink}) || $Config{d_link}) &&
!($^O eq 'MSWin32' || $^O eq 'os2')) {
my @fs = stat($from);
if (@fs) {
my @ts = stat($to);
if (@ts && $fs[0] == $ts[0] && $fs[1] == $ts[1] && !-p $from) {
carp("'$from' and '$to' are identical (not copied)");
return 0;
}
}
}
elsif (_eq($from, $to)) {
carp("'$from' and '$to' are identical (not copied)");
return 0;
}
if (defined &syscopy && !$Syscopy_is_copy
&& !$to_a_handle
&& !($from_a_handle && $^O eq 'os2' ) # OS/2 cannot handle handles
&& !($from_a_handle && $^O eq 'MSWin32')
&& !($from_a_handle && $^O eq 'NetWare')
)
{
if ($^O eq 'VMS' && -e $from
&& ! -d $to && ! -d $from) {
# VMS natively inherits path components from the source of a
# copy, but we want the Unixy behavior of inheriting from
# the current working directory. Also, default in a trailing
# dot for null file types.
$to = VMS::Filespec::rmsexpand(VMS::Filespec::vmsify($to), '.');
# Get rid of the old versions to be like UNIX
1 while unlink $to;
}
return syscopy($from, $to) || 0;
}
my $closefrom = 0;
my $closeto = 0;
my ($status, $r, $buf);
local($\) = '';
my $from_h;
if ($from_a_handle) {
$from_h = $from;
} else {
open $from_h, "<", $from or goto fail_open1;
binmode $from_h or die "($!,$^E)";
$closefrom = 1;
}
# Seems most logical to do this here, in case future changes would want to
# make this croak for some reason.
unless (defined $size) {
$size = tied(*$from_h) ? 0 : -s $from_h || 0;
$size = 1024 if ($size < 512);
$size = $Too_Big if ($size > $Too_Big);
}
my $to_h;
if ($to_a_handle) {
$to_h = $to;
} else {
$to_h = \do { local *FH }; # XXX is this line obsolete?
open $to_h, ">", $to or goto fail_open2;
binmode $to_h or die "($!,$^E)";
$closeto = 1;
}
$! = 0;
for (;;) {
my ($r, $w, $t);
defined($r = sysread($from_h, $buf, $size))
or goto fail_inner;
last unless $r;
for ($w = 0; $w < $r; $w += $t) {
$t = syswrite($to_h, $buf, $r - $w, $w)
or goto fail_inner;
}
}
close($to_h) || goto fail_open2 if $closeto;
close($from_h) || goto fail_open1 if $closefrom;
# Use this idiom to avoid uninitialized value warning.
return 1;
# All of these contortions try to preserve error messages...
fail_inner:
if ($closeto) {
$status = $!;
$! = 0;
close $to_h;
$! = $status unless $!;
}
fail_open2:
if ($closefrom) {
$status = $!;
$! = 0;
close $from_h;
$! = $status unless $!;
}
fail_open1:
return 0;
}
sub cp {
my($from,$to) = @_;
my(@fromstat) = stat $from;
my(@tostat) = stat $to;
my $perm;
return 0 unless copy(@_) and @fromstat;
if (@tostat) {
$perm = $tostat[2];
} else {
$perm = $fromstat[2] & ~(umask || 0);
@tostat = stat $to;
}
# Might be more robust to look for S_I* in Fcntl, but we're
# trying to avoid dependence on any XS-containing modules,
# since File::Copy is used during the Perl build.
$perm &= 07777;
if ($perm & 06000) {
croak("Unable to check setuid/setgid permissions for $to: $!")
unless @tostat;
if ($perm & 04000 and # setuid
$fromstat[4] != $tostat[4]) { # owner must match
$perm &= ~06000;
}
if ($perm & 02000 && $> != 0) { # if not root, setgid
my $ok = $fromstat[5] == $tostat[5]; # group must match
if ($ok) { # and we must be in group
$ok = grep { $_ == $fromstat[5] } split /\s+/, $)
}
$perm &= ~06000 unless $ok;
}
}
return 0 unless @tostat;
return 1 if $perm == ($tostat[2] & 07777);
return eval { chmod $perm, $to; } ? 1 : 0;
}
sub _move {
croak("Usage: move(FROM, TO) ") unless @_ == 3;
my($from,$to,$fallback) = @_;
my($fromsz,$tosz1,$tomt1,$tosz2,$tomt2,$sts,$ossts);
if (-d $to && ! -d $from) {
$to = _catname($from, $to);
}
($tosz1,$tomt1) = (stat($to))[7,9];
$fromsz = -s $from;
if ($^O eq 'os2' and defined $tosz1 and defined $fromsz) {
# will not rename with overwrite
unlink $to;
}
if ($^O eq 'VMS' && -e $from
&& ! -d $to && ! -d $from) {
# VMS natively inherits path components from the source of a
# copy, but we want the Unixy behavior of inheriting from
# the current working directory. Also, default in a trailing
# dot for null file types.
$to = VMS::Filespec::rmsexpand(VMS::Filespec::vmsify($to), '.');
# Get rid of the old versions to be like UNIX
1 while unlink $to;
}
return 1 if rename $from, $to;
# Did rename return an error even though it succeeded, because $to
# is on a remote NFS file system, and NFS lost the server's ack?
return 1 if defined($fromsz) && !-e $from && # $from disappeared
(($tosz2,$tomt2) = (stat($to))[7,9]) && # $to's there
((!defined $tosz1) || # not before or
($tosz1 != $tosz2 or $tomt1 != $tomt2)) && # was changed
$tosz2 == $fromsz; # it's all there
($tosz1,$tomt1) = (stat($to))[7,9]; # just in case rename did something
{
local $@;
eval {
local $SIG{__DIE__};
$fallback->($from,$to) or die;
my($atime, $mtime) = (stat($from))[8,9];
utime($atime, $mtime, $to);
unlink($from) or die;
};
return 1 unless $@;
}
($sts,$ossts) = ($! + 0, $^E + 0);
($tosz2,$tomt2) = ((stat($to))[7,9],0,0) if defined $tomt1;
unlink($to) if !defined($tomt1) or $tomt1 != $tomt2 or $tosz1 != $tosz2;
($!,$^E) = ($sts,$ossts);
return 0;
}
sub move { _move(@_,\©); }
sub mv { _move(@_,\&cp); }
# &syscopy is an XSUB under OS/2
unless (defined &syscopy) {
if ($^O eq 'VMS') {
*syscopy = \&rmscopy;
} elsif ($^O eq 'MSWin32' && defined &DynaLoader::boot_DynaLoader) {
# Win32::CopyFile() fill only work if we can load Win32.xs
*syscopy = sub {
return 0 unless @_ == 2;
return Win32::CopyFile(@_, 1);
};
} else {
$Syscopy_is_copy = 1;
*syscopy = \©
}
}
1;
__END__
=head1 NAME
File::Copy - Copy files or filehandles
=head1 SYNOPSIS
use File::Copy;
copy("sourcefile","destinationfile") or die "Copy failed: $!";
copy("Copy.pm",\*STDOUT);
move("/dev1/sourcefile","/dev2/destinationfile");
use File::Copy "cp";
$n = FileHandle->new("/a/file","r");
cp($n,"x");
=head1 DESCRIPTION
The File::Copy module provides two basic functions, C<copy> and
C<move>, which are useful for getting the contents of a file from
one place to another.
=over 4
=item copy
X<copy> X<cp>
The C<copy> function takes two
parameters: a file to copy from and a file to copy to. Either
argument may be a string, a FileHandle reference or a FileHandle
glob. Obviously, if the first argument is a filehandle of some
sort, it will be read from, and if it is a file I<name> it will
be opened for reading. Likewise, the second argument will be
written to. If the second argument does not exist but the parent
directory does exist, then it will be created. Trying to copy
a file into a non-existent directory is an error.
Trying to copy a file on top of itself is also an error.
C<copy> will not overwrite read-only files.
If the destination (second argument) already exists and is a directory,
and the source (first argument) is not a filehandle, then the source
file will be copied into the directory specified by the destination,
using the same base name as the source file. It's a failure to have a
filehandle as the source when the destination is a directory.
B<Note that passing in
files as handles instead of names may lead to loss of information
on some operating systems; it is recommended that you use file
names whenever possible.> Files are opened in binary mode where
applicable. To get a consistent behaviour when copying from a
filehandle to a file, use C<binmode> on the filehandle.
An optional third parameter can be used to specify the buffer
size used for copying. This is the number of bytes from the
first file, that will be held in memory at any given time, before
being written to the second file. The default buffer size depends
upon the file, but will generally be the whole file (up to 2MB), or
1k for filehandles that do not reference files (eg. sockets).
You may use the syntax C<use File::Copy "cp"> to get at the C<cp>
alias for this function. The syntax is I<exactly> the same. The
behavior is nearly the same as well: as of version 2.15, C<cp> will
preserve the source file's permission bits like the shell utility
C<cp(1)> would do, while C<copy> uses the default permissions for the
target file (which may depend on the process' C<umask>, file
ownership, inherited ACLs, etc.). If an error occurs in setting
permissions, C<cp> will return 0, regardless of whether the file was
successfully copied.
=item move
X<move> X<mv> X<rename>
The C<move> function also takes two parameters: the current name
and the intended name of the file to be moved. If the destination
already exists and is a directory, and the source is not a
directory, then the source file will be renamed into the directory
specified by the destination.
If possible, move() will simply rename the file. Otherwise, it copies
the file to the new location and deletes the original. If an error occurs
during this copy-and-delete process, you may be left with a (possibly partial)
copy of the file under the destination name.
You may use the C<mv> alias for this function in the same way that
you may use the C<cp> alias for C<copy>.
=item syscopy
X<syscopy>
File::Copy also provides the C<syscopy> routine, which copies the
file specified in the first parameter to the file specified in the
second parameter, preserving OS-specific attributes and file
structure. For Unix systems, this is equivalent to the simple
C<copy> routine, which doesn't preserve OS-specific attributes. For
VMS systems, this calls the C<rmscopy> routine (see below). For OS/2
systems, this calls the C<syscopy> XSUB directly. For Win32 systems,
this calls C<Win32::CopyFile>.
B<Special behaviour if C<syscopy> is defined (OS/2, VMS and Win32)>:
If both arguments to C<copy> are not file handles,
then C<copy> will perform a "system copy" of
the input file to a new output file, in order to preserve file
attributes, indexed file structure, I<etc.> The buffer size
parameter is ignored. If either argument to C<copy> is a
handle to an opened file, then data is copied using Perl
operators, and no effort is made to preserve file attributes
or record structure.
The system copy routine may also be called directly under VMS and OS/2
as C<File::Copy::syscopy> (or under VMS as C<File::Copy::rmscopy>, which
is the routine that does the actual work for syscopy).
=item rmscopy($from,$to[,$date_flag])
X<rmscopy>
The first and second arguments may be strings, typeglobs, typeglob
references, or objects inheriting from IO::Handle;
they are used in all cases to obtain the
I<filespec> of the input and output files, respectively. The
name and type of the input file are used as defaults for the
output file, if necessary.
A new version of the output file is always created, which
inherits the structure and RMS attributes of the input file,
except for owner and protections (and possibly timestamps;
see below). All data from the input file is copied to the
output file; if either of the first two parameters to C<rmscopy>
is a file handle, its position is unchanged. (Note that this
means a file handle pointing to the output file will be
associated with an old version of that file after C<rmscopy>
returns, not the newly created version.)
The third parameter is an integer flag, which tells C<rmscopy>
how to handle timestamps. If it is E<lt> 0, none of the input file's
timestamps are propagated to the output file. If it is E<gt> 0, then
it is interpreted as a bitmask: if bit 0 (the LSB) is set, then
timestamps other than the revision date are propagated; if bit 1
is set, the revision date is propagated. If the third parameter
to C<rmscopy> is 0, then it behaves much like the DCL COPY command:
if the name or type of the output file was explicitly specified,
then no timestamps are propagated, but if they were taken implicitly
from the input filespec, then all timestamps other than the
revision date are propagated. If this parameter is not supplied,
it defaults to 0.
C<rmscopy> is VMS specific and cannot be exported; it must be
referenced by its full name, e.g.:
File::Copy::rmscopy($from, $to) or die $!;
Like C<copy>, C<rmscopy> returns 1 on success. If an error occurs,
it sets C<$!>, deletes the output file, and returns 0.
=back
=head1 RETURN
All functions return 1 on success, 0 on failure.
$! will be set if an error was encountered.
=head1 NOTES
Before calling copy() or move() on a filehandle, the caller should
close or flush() the file to avoid writes being lost. Note that this
is the case even for move(), because it may actually copy the file,
depending on the OS-specific inplementation, and the underlying
filesystem(s).
=head1 AUTHOR
File::Copy was written by Aaron Sherman I<E<lt>ajs@ajs.comE<gt>> in 1995,
and updated by Charles Bailey I<E<lt>bailey@newman.upenn.eduE<gt>> in 1996.
=cut
GlobMapper.pm 0000644 00000036476 15036324715 0007160 0 ustar 00 package File::GlobMapper;
use strict;
use warnings;
use Carp;
our ($CSH_GLOB);
BEGIN
{
if ($] < 5.006)
{
require File::BSDGlob; import File::BSDGlob qw(:glob) ;
$CSH_GLOB = File::BSDGlob::GLOB_CSH() ;
*globber = \&File::BSDGlob::csh_glob;
}
else
{
require File::Glob; import File::Glob qw(:glob) ;
$CSH_GLOB = File::Glob::GLOB_CSH() ;
#*globber = \&File::Glob::bsd_glob;
*globber = \&File::Glob::csh_glob;
}
}
our ($Error);
our ($VERSION, @EXPORT_OK);
$VERSION = '1.001';
@EXPORT_OK = qw( globmap );
our ($noPreBS, $metachars, $matchMetaRE, %mapping, %wildCount);
$noPreBS = '(?<!\\\)' ; # no preceding backslash
$metachars = '.*?[](){}';
$matchMetaRE = '[' . quotemeta($metachars) . ']';
%mapping = (
'*' => '([^/]*)',
'?' => '([^/])',
'.' => '\.',
'[' => '([',
'(' => '(',
')' => ')',
);
%wildCount = map { $_ => 1 } qw/ * ? . { ( [ /;
sub globmap ($$;)
{
my $inputGlob = shift ;
my $outputGlob = shift ;
my $obj = new File::GlobMapper($inputGlob, $outputGlob, @_)
or croak "globmap: $Error" ;
return $obj->getFileMap();
}
sub new
{
my $class = shift ;
my $inputGlob = shift ;
my $outputGlob = shift ;
# TODO -- flags needs to default to whatever File::Glob does
my $flags = shift || $CSH_GLOB ;
#my $flags = shift ;
$inputGlob =~ s/^\s*\<\s*//;
$inputGlob =~ s/\s*\>\s*$//;
$outputGlob =~ s/^\s*\<\s*//;
$outputGlob =~ s/\s*\>\s*$//;
my %object =
( InputGlob => $inputGlob,
OutputGlob => $outputGlob,
GlobFlags => $flags,
Braces => 0,
WildCount => 0,
Pairs => [],
Sigil => '#',
);
my $self = bless \%object, ref($class) || $class ;
$self->_parseInputGlob()
or return undef ;
$self->_parseOutputGlob()
or return undef ;
my @inputFiles = globber($self->{InputGlob}, $flags) ;
if (GLOB_ERROR)
{
$Error = $!;
return undef ;
}
#if (whatever)
{
my $missing = grep { ! -e $_ } @inputFiles ;
if ($missing)
{
$Error = "$missing input files do not exist";
return undef ;
}
}
$self->{InputFiles} = \@inputFiles ;
$self->_getFiles()
or return undef ;
return $self;
}
sub _retError
{
my $string = shift ;
$Error = "$string in input fileglob" ;
return undef ;
}
sub _unmatched
{
my $delimeter = shift ;
_retError("Unmatched $delimeter");
return undef ;
}
sub _parseBit
{
my $self = shift ;
my $string = shift ;
my $out = '';
my $depth = 0 ;
while ($string =~ s/(.*?)$noPreBS(,|$matchMetaRE)//)
{
$out .= quotemeta($1) ;
$out .= $mapping{$2} if defined $mapping{$2};
++ $self->{WildCount} if $wildCount{$2} ;
if ($2 eq ',')
{
return _unmatched("(")
if $depth ;
$out .= '|';
}
elsif ($2 eq '(')
{
++ $depth ;
}
elsif ($2 eq ')')
{
return _unmatched(")")
if ! $depth ;
-- $depth ;
}
elsif ($2 eq '[')
{
# TODO -- quotemeta & check no '/'
# TODO -- check for \] & other \ within the []
$string =~ s#(.*?\])##
or return _unmatched("[");
$out .= "$1)" ;
}
elsif ($2 eq ']')
{
return _unmatched("]");
}
elsif ($2 eq '{' || $2 eq '}')
{
return _retError("Nested {} not allowed");
}
}
$out .= quotemeta $string;
return _unmatched("(")
if $depth ;
return $out ;
}
sub _parseInputGlob
{
my $self = shift ;
my $string = $self->{InputGlob} ;
my $inGlob = '';
# Multiple concatenated *'s don't make sense
#$string =~ s#\*\*+#*# ;
# TODO -- Allow space to delimit patterns?
#my @strings = split /\s+/, $string ;
#for my $str (@strings)
my $out = '';
my $depth = 0 ;
while ($string =~ s/(.*?)$noPreBS($matchMetaRE)//)
{
$out .= quotemeta($1) ;
$out .= $mapping{$2} if defined $mapping{$2};
++ $self->{WildCount} if $wildCount{$2} ;
if ($2 eq '(')
{
++ $depth ;
}
elsif ($2 eq ')')
{
return _unmatched(")")
if ! $depth ;
-- $depth ;
}
elsif ($2 eq '[')
{
# TODO -- quotemeta & check no '/' or '(' or ')'
# TODO -- check for \] & other \ within the []
$string =~ s#(.*?\])##
or return _unmatched("[");
$out .= "$1)" ;
}
elsif ($2 eq ']')
{
return _unmatched("]");
}
elsif ($2 eq '}')
{
return _unmatched("}");
}
elsif ($2 eq '{')
{
# TODO -- check no '/' within the {}
# TODO -- check for \} & other \ within the {}
my $tmp ;
unless ( $string =~ s/(.*?)$noPreBS\}//)
{
return _unmatched("{");
}
#$string =~ s#(.*?)\}##;
#my $alt = join '|',
# map { quotemeta $_ }
# split "$noPreBS,", $1 ;
my $alt = $self->_parseBit($1);
defined $alt or return 0 ;
$out .= "($alt)" ;
++ $self->{Braces} ;
}
}
return _unmatched("(")
if $depth ;
$out .= quotemeta $string ;
$self->{InputGlob} =~ s/$noPreBS[\(\)]//g;
$self->{InputPattern} = $out ;
#print "# INPUT '$self->{InputGlob}' => '$out'\n";
return 1 ;
}
sub _parseOutputGlob
{
my $self = shift ;
my $string = $self->{OutputGlob} ;
my $maxwild = $self->{WildCount};
if ($self->{GlobFlags} & GLOB_TILDE)
#if (1)
{
$string =~ s{
^ ~ # find a leading tilde
( # save this in $1
[^/] # a non-slash character
* # repeated 0 or more times (0 means me)
)
}{
$1
? (getpwnam($1))[7]
: ( $ENV{HOME} || $ENV{LOGDIR} )
}ex;
}
# max #1 must be == to max no of '*' in input
while ( $string =~ m/#(\d)/g )
{
croak "Max wild is #$maxwild, you tried #$1"
if $1 > $maxwild ;
}
my $noPreBS = '(?<!\\\)' ; # no preceding backslash
#warn "noPreBS = '$noPreBS'\n";
#$string =~ s/${noPreBS}\$(\d)/\${$1}/g;
$string =~ s/${noPreBS}#(\d)/\${$1}/g;
$string =~ s#${noPreBS}\*#\${inFile}#g;
$string = '"' . $string . '"';
#print "OUTPUT '$self->{OutputGlob}' => '$string'\n";
$self->{OutputPattern} = $string ;
return 1 ;
}
sub _getFiles
{
my $self = shift ;
my %outInMapping = ();
my %inFiles = () ;
foreach my $inFile (@{ $self->{InputFiles} })
{
next if $inFiles{$inFile} ++ ;
my $outFile = $inFile ;
if ( $inFile =~ m/$self->{InputPattern}/ )
{
no warnings 'uninitialized';
eval "\$outFile = $self->{OutputPattern};" ;
if (defined $outInMapping{$outFile})
{
$Error = "multiple input files map to one output file";
return undef ;
}
$outInMapping{$outFile} = $inFile;
push @{ $self->{Pairs} }, [$inFile, $outFile];
}
}
return 1 ;
}
sub getFileMap
{
my $self = shift ;
return $self->{Pairs} ;
}
sub getHash
{
my $self = shift ;
return { map { $_->[0] => $_->[1] } @{ $self->{Pairs} } } ;
}
1;
__END__
=head1 NAME
File::GlobMapper - Extend File Glob to Allow Input and Output Files
=head1 SYNOPSIS
use File::GlobMapper qw( globmap );
my $aref = globmap $input => $output
or die $File::GlobMapper::Error ;
my $gm = new File::GlobMapper $input => $output
or die $File::GlobMapper::Error ;
=head1 DESCRIPTION
This module needs Perl5.005 or better.
This module takes the existing C<File::Glob> module as a starting point and
extends it to allow new filenames to be derived from the files matched by
C<File::Glob>.
This can be useful when carrying out batch operations on multiple files that
have both an input filename and output filename and the output file can be
derived from the input filename. Examples of operations where this can be
useful include, file renaming, file copying and file compression.
=head2 Behind The Scenes
To help explain what C<File::GlobMapper> does, consider what code you
would write if you wanted to rename all files in the current directory
that ended in C<.tar.gz> to C<.tgz>. So say these files are in the
current directory
alpha.tar.gz
beta.tar.gz
gamma.tar.gz
and they need renamed to this
alpha.tgz
beta.tgz
gamma.tgz
Below is a possible implementation of a script to carry out the rename
(error cases have been omitted)
foreach my $old ( glob "*.tar.gz" )
{
my $new = $old;
$new =~ s#(.*)\.tar\.gz$#$1.tgz# ;
rename $old => $new
or die "Cannot rename '$old' to '$new': $!\n;
}
Notice that a file glob pattern C<*.tar.gz> was used to match the
C<.tar.gz> files, then a fairly similar regular expression was used in
the substitute to allow the new filename to be created.
Given that the file glob is just a cut-down regular expression and that it
has already done a lot of the hard work in pattern matching the filenames,
wouldn't it be handy to be able to use the patterns in the fileglob to
drive the new filename?
Well, that's I<exactly> what C<File::GlobMapper> does.
Here is same snippet of code rewritten using C<globmap>
for my $pair (globmap '<*.tar.gz>' => '<#1.tgz>' )
{
my ($from, $to) = @$pair;
rename $from => $to
or die "Cannot rename '$old' to '$new': $!\n;
}
So how does it work?
Behind the scenes the C<globmap> function does a combination of a
file glob to match existing filenames followed by a substitute
to create the new filenames.
Notice how both parameters to C<globmap> are strings that are delimited by <>.
This is done to make them look more like file globs - it is just syntactic
sugar, but it can be handy when you want the strings to be visually
distinctive. The enclosing <> are optional, so you don't have to use them - in
fact the first thing globmap will do is remove these delimiters if they are
present.
The first parameter to C<globmap>, C<*.tar.gz>, is an I<Input File Glob>.
Once the enclosing "< ... >" is removed, this is passed (more or
less) unchanged to C<File::Glob> to carry out a file match.
Next the fileglob C<*.tar.gz> is transformed behind the scenes into a
full Perl regular expression, with the additional step of wrapping each
transformed wildcard metacharacter sequence in parenthesis.
In this case the input fileglob C<*.tar.gz> will be transformed into
this Perl regular expression
([^/]*)\.tar\.gz
Wrapping with parenthesis allows the wildcard parts of the Input File
Glob to be referenced by the second parameter to C<globmap>, C<#1.tgz>,
the I<Output File Glob>. This parameter operates just like the replacement
part of a substitute command. The difference is that the C<#1> syntax
is used to reference sub-patterns matched in the input fileglob, rather
than the C<$1> syntax that is used with perl regular expressions. In
this case C<#1> is used to refer to the text matched by the C<*> in the
Input File Glob. This makes it easier to use this module where the
parameters to C<globmap> are typed at the command line.
The final step involves passing each filename matched by the C<*.tar.gz>
file glob through the derived Perl regular expression in turn and
expanding the output fileglob using it.
The end result of all this is a list of pairs of filenames. By default
that is what is returned by C<globmap>. In this example the data structure
returned will look like this
( ['alpha.tar.gz' => 'alpha.tgz'],
['beta.tar.gz' => 'beta.tgz' ],
['gamma.tar.gz' => 'gamma.tgz']
)
Each pair is an array reference with two elements - namely the I<from>
filename, that C<File::Glob> has matched, and a I<to> filename that is
derived from the I<from> filename.
=head2 Limitations
C<File::GlobMapper> has been kept simple deliberately, so it isn't intended to
solve all filename mapping operations. Under the hood C<File::Glob> (or for
older versions of Perl, C<File::BSDGlob>) is used to match the files, so you
will never have the flexibility of full Perl regular expression.
=head2 Input File Glob
The syntax for an Input FileGlob is identical to C<File::Glob>, except
for the following
=over 5
=item 1.
No nested {}
=item 2.
Whitespace does not delimit fileglobs.
=item 3.
The use of parenthesis can be used to capture parts of the input filename.
=item 4.
If an Input glob matches the same file more than once, only the first
will be used.
=back
The syntax
=over 5
=item B<~>
=item B<~user>
=item B<.>
Matches a literal '.'.
Equivalent to the Perl regular expression
\.
=item B<*>
Matches zero or more characters, except '/'. Equivalent to the Perl
regular expression
[^/]*
=item B<?>
Matches zero or one character, except '/'. Equivalent to the Perl
regular expression
[^/]?
=item B<\>
Backslash is used, as usual, to escape the next character.
=item B<[]>
Character class.
=item B<{,}>
Alternation
=item B<()>
Capturing parenthesis that work just like perl
=back
Any other character it taken literally.
=head2 Output File Glob
The Output File Glob is a normal string, with 2 glob-like features.
The first is the '*' metacharacter. This will be replaced by the complete
filename matched by the input file glob. So
*.c *.Z
The second is
Output FileGlobs take the
=over 5
=item "*"
The "*" character will be replaced with the complete input filename.
=item #1
Patterns of the form /#\d/ will be replaced with the
=back
=head2 Returned Data
=head1 EXAMPLES
=head2 A Rename script
Below is a simple "rename" script that uses C<globmap> to determine the
source and destination filenames.
use File::GlobMapper qw(globmap) ;
use File::Copy;
die "rename: Usage rename 'from' 'to'\n"
unless @ARGV == 2 ;
my $fromGlob = shift @ARGV;
my $toGlob = shift @ARGV;
my $pairs = globmap($fromGlob, $toGlob)
or die $File::GlobMapper::Error;
for my $pair (@$pairs)
{
my ($from, $to) = @$pair;
move $from => $to ;
}
Here is an example that renames all c files to cpp.
$ rename '*.c' '#1.cpp'
=head2 A few example globmaps
Below are a few examples of globmaps
To copy all your .c file to a backup directory
'</my/home/*.c>' '</my/backup/#1.c>'
If you want to compress all
'</my/home/*.[ch]>' '<*.gz>'
To uncompress
'</my/home/*.[ch].gz>' '</my/home/#1.#2>'
=head1 SEE ALSO
L<File::Glob|File::Glob>
=head1 AUTHOR
The I<File::GlobMapper> module was written by Paul Marquess, F<pmqs@cpan.org>.
=head1 COPYRIGHT AND LICENSE
Copyright (c) 2005 Paul Marquess. All rights reserved.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
Basename.pm 0000644 00000025672 15036324715 0006637 0 ustar 00 =head1 NAME
File::Basename - Parse file paths into directory, filename and suffix.
=head1 SYNOPSIS
use File::Basename;
($name,$path,$suffix) = fileparse($fullname,@suffixlist);
$name = fileparse($fullname,@suffixlist);
$basename = basename($fullname,@suffixlist);
$dirname = dirname($fullname);
=head1 DESCRIPTION
These routines allow you to parse file paths into their directory, filename
and suffix.
B<NOTE>: C<dirname()> and C<basename()> emulate the behaviours, and
quirks, of the shell and C functions of the same name. See each
function's documentation for details. If your concern is just parsing
paths it is safer to use L<File::Spec>'s C<splitpath()> and
C<splitdir()> methods.
It is guaranteed that
# Where $path_separator is / for Unix, \ for Windows, etc...
dirname($path) . $path_separator . basename($path);
is equivalent to the original path for all systems but VMS.
=cut
package File::Basename;
# File::Basename is used during the Perl build, when the re extension may
# not be available, but we only actually need it if running under tainting.
BEGIN {
if (${^TAINT}) {
require re;
re->import('taint');
}
}
use strict;
use 5.006;
use warnings;
our(@ISA, @EXPORT, $VERSION, $Fileparse_fstype, $Fileparse_igncase);
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(fileparse fileparse_set_fstype basename dirname);
$VERSION = "2.85";
fileparse_set_fstype($^O);
=over 4
=item C<fileparse>
X<fileparse>
my($filename, $dirs, $suffix) = fileparse($path);
my($filename, $dirs, $suffix) = fileparse($path, @suffixes);
my $filename = fileparse($path, @suffixes);
The C<fileparse()> routine divides a file path into its $dirs, $filename
and (optionally) the filename $suffix.
$dirs contains everything up to and including the last
directory separator in the $path including the volume (if applicable).
The remainder of the $path is the $filename.
# On Unix returns ("baz", "/foo/bar/", "")
fileparse("/foo/bar/baz");
# On Windows returns ("baz", 'C:\foo\bar\', "")
fileparse('C:\foo\bar\baz');
# On Unix returns ("", "/foo/bar/baz/", "")
fileparse("/foo/bar/baz/");
If @suffixes are given each element is a pattern (either a string or a
C<qr//>) matched against the end of the $filename. The matching
portion is removed and becomes the $suffix.
# On Unix returns ("baz", "/foo/bar/", ".txt")
fileparse("/foo/bar/baz.txt", qr/\.[^.]*/);
If type is non-Unix (see L</fileparse_set_fstype>) then the pattern
matching for suffix removal is performed case-insensitively, since
those systems are not case-sensitive when opening existing files.
You are guaranteed that C<$dirs . $filename . $suffix> will
denote the same location as the original $path.
=cut
sub fileparse {
my($fullname,@suffices) = @_;
unless (defined $fullname) {
require Carp;
Carp::croak("fileparse(): need a valid pathname");
}
my $orig_type = '';
my($type,$igncase) = ($Fileparse_fstype, $Fileparse_igncase);
my($taint) = substr($fullname,0,0); # Is $fullname tainted?
if ($type eq "VMS" and $fullname =~ m{/} ) {
# We're doing Unix emulation
$orig_type = $type;
$type = 'Unix';
}
my($dirpath, $basename);
if (grep { $type eq $_ } qw(MSDOS DOS MSWin32 Epoc)) {
($dirpath,$basename) = ($fullname =~ /^((?:.*[:\\\/])?)(.*)/s);
$dirpath .= '.\\' unless $dirpath =~ /[\\\/]\z/;
}
elsif ($type eq "OS2") {
($dirpath,$basename) = ($fullname =~ m#^((?:.*[:\\/])?)(.*)#s);
$dirpath = './' unless $dirpath; # Can't be 0
$dirpath .= '/' unless $dirpath =~ m#[\\/]\z#;
}
elsif ($type eq "MacOS") {
($dirpath,$basename) = ($fullname =~ /^(.*:)?(.*)/s);
$dirpath = ':' unless $dirpath;
}
elsif ($type eq "AmigaOS") {
($dirpath,$basename) = ($fullname =~ /(.*[:\/])?(.*)/s);
$dirpath = './' unless $dirpath;
}
elsif ($type eq 'VMS' ) {
($dirpath,$basename) = ($fullname =~ /^(.*[:>\]])?(.*)/s);
$dirpath ||= ''; # should always be defined
}
else { # Default to Unix semantics.
($dirpath,$basename) = ($fullname =~ m{^(.*/)?(.*)}s);
if ($orig_type eq 'VMS' and $fullname =~ m{^(/[^/]+/000000(/|$))(.*)}) {
# dev:[000000] is top of VMS tree, similar to Unix '/'
# so strip it off and treat the rest as "normal"
my $devspec = $1;
my $remainder = $3;
($dirpath,$basename) = ($remainder =~ m{^(.*/)?(.*)}s);
$dirpath ||= ''; # should always be defined
$dirpath = $devspec.$dirpath;
}
$dirpath = './' unless $dirpath;
}
my $tail = '';
my $suffix = '';
if (@suffices) {
foreach $suffix (@suffices) {
my $pat = ($igncase ? '(?i)' : '') . "($suffix)\$";
if ($basename =~ s/$pat//s) {
$taint .= substr($suffix,0,0);
$tail = $1 . $tail;
}
}
}
# Ensure taint is propagated from the path to its pieces.
$tail .= $taint;
wantarray ? ($basename .= $taint, $dirpath .= $taint, $tail)
: ($basename .= $taint);
}
=item C<basename>
X<basename> X<filename>
my $filename = basename($path);
my $filename = basename($path, @suffixes);
This function is provided for compatibility with the Unix shell command
C<basename(1)>. It does B<NOT> always return the file name portion of a
path as you might expect. To be safe, if you want the file name portion of
a path use C<fileparse()>.
C<basename()> returns the last level of a filepath even if the last
level is clearly directory. In effect, it is acting like C<pop()> for
paths. This differs from C<fileparse()>'s behaviour.
# Both return "bar"
basename("/foo/bar");
basename("/foo/bar/");
@suffixes work as in C<fileparse()> except all regex metacharacters are
quoted.
# These two function calls are equivalent.
my $filename = basename("/foo/bar/baz.txt", ".txt");
my $filename = fileparse("/foo/bar/baz.txt", qr/\Q.txt\E/);
Also note that in order to be compatible with the shell command,
C<basename()> does not strip off a suffix if it is identical to the
remaining characters in the filename.
=cut
sub basename {
my($path) = shift;
# From BSD basename(1)
# The basename utility deletes any prefix ending with the last slash '/'
# character present in string (after first stripping trailing slashes)
_strip_trailing_sep($path);
my($basename, $dirname, $suffix) = fileparse( $path, map("\Q$_\E",@_) );
# From BSD basename(1)
# The suffix is not stripped if it is identical to the remaining
# characters in string.
if( length $suffix and !length $basename ) {
$basename = $suffix;
}
# Ensure that basename '/' == '/'
if( !length $basename ) {
$basename = $dirname;
}
return $basename;
}
=item C<dirname>
X<dirname>
This function is provided for compatibility with the Unix shell
command C<dirname(1)> and has inherited some of its quirks. In spite of
its name it does B<NOT> always return the directory name as you might
expect. To be safe, if you want the directory name of a path use
C<fileparse()>.
Only on VMS (where there is no ambiguity between the file and directory
portions of a path) and AmigaOS (possibly due to an implementation quirk in
this module) does C<dirname()> work like C<fileparse($path)>, returning just the
$dirs.
# On VMS and AmigaOS
my $dirs = dirname($path);
When using Unix or MSDOS syntax this emulates the C<dirname(1)> shell function
which is subtly different from how C<fileparse()> works. It returns all but
the last level of a file path even if the last level is clearly a directory.
In effect, it is not returning the directory portion but simply the path one
level up acting like C<chop()> for file paths.
Also unlike C<fileparse()>, C<dirname()> does not include a trailing slash on
its returned path.
# returns /foo/bar. fileparse() would return /foo/bar/
dirname("/foo/bar/baz");
# also returns /foo/bar despite the fact that baz is clearly a
# directory. fileparse() would return /foo/bar/baz/
dirname("/foo/bar/baz/");
# returns '.'. fileparse() would return 'foo/'
dirname("foo/");
Under VMS, if there is no directory information in the $path, then the
current default device and directory is used.
=cut
sub dirname {
my $path = shift;
my($type) = $Fileparse_fstype;
if( $type eq 'VMS' and $path =~ m{/} ) {
# Parse as Unix
local($File::Basename::Fileparse_fstype) = '';
return dirname($path);
}
my($basename, $dirname) = fileparse($path);
if ($type eq 'VMS') {
$dirname ||= $ENV{DEFAULT};
}
elsif ($type eq 'MacOS') {
if( !length($basename) && $dirname !~ /^[^:]+:\z/) {
_strip_trailing_sep($dirname);
($basename,$dirname) = fileparse $dirname;
}
$dirname .= ":" unless $dirname =~ /:\z/;
}
elsif (grep { $type eq $_ } qw(MSDOS DOS MSWin32 OS2)) {
_strip_trailing_sep($dirname);
unless( length($basename) ) {
($basename,$dirname) = fileparse $dirname;
_strip_trailing_sep($dirname);
}
}
elsif ($type eq 'AmigaOS') {
if ( $dirname =~ /:\z/) { return $dirname }
chop $dirname;
$dirname =~ s{[^:/]+\z}{} unless length($basename);
}
else {
_strip_trailing_sep($dirname);
unless( length($basename) ) {
($basename,$dirname) = fileparse $dirname;
_strip_trailing_sep($dirname);
}
}
$dirname;
}
# Strip the trailing path separator.
sub _strip_trailing_sep {
my $type = $Fileparse_fstype;
if ($type eq 'MacOS') {
$_[0] =~ s/([^:]):\z/$1/s;
}
elsif (grep { $type eq $_ } qw(MSDOS DOS MSWin32 OS2)) {
$_[0] =~ s/([^:])[\\\/]*\z/$1/;
}
else {
$_[0] =~ s{(.)/*\z}{$1}s;
}
}
=item C<fileparse_set_fstype>
X<filesystem>
my $type = fileparse_set_fstype();
my $previous_type = fileparse_set_fstype($type);
Normally File::Basename will assume a file path type native to your current
operating system (ie. /foo/bar style on Unix, \foo\bar on Windows, etc...).
With this function you can override that assumption.
Valid $types are "MacOS", "VMS", "AmigaOS", "OS2", "RISCOS",
"MSWin32", "DOS" (also "MSDOS" for backwards bug compatibility),
"Epoc" and "Unix" (all case-insensitive). If an unrecognized $type is
given "Unix" will be assumed.
If you've selected VMS syntax, and the file specification you pass to
one of these routines contains a "/", they assume you are using Unix
emulation and apply the Unix syntax rules instead, for that function
call only.
=back
=cut
BEGIN {
my @Ignore_Case = qw(MacOS VMS AmigaOS OS2 RISCOS MSWin32 MSDOS DOS Epoc);
my @Types = (@Ignore_Case, qw(Unix));
sub fileparse_set_fstype {
my $old = $Fileparse_fstype;
if (@_) {
my $new_type = shift;
$Fileparse_fstype = 'Unix'; # default
foreach my $type (@Types) {
$Fileparse_fstype = $type if $new_type =~ /^$type/i;
}
$Fileparse_igncase =
(grep $Fileparse_fstype eq $_, @Ignore_Case) ? 1 : 0;
}
return $old;
}
}
1;
=head1 SEE ALSO
L<dirname(1)>, L<basename(1)>, L<File::Spec>
Find.pm 0000644 00000102144 15036324715 0005772 0 ustar 00 package File::Find;
use 5.006;
use strict;
use warnings;
use warnings::register;
our $VERSION = '1.34';
require Exporter;
require Cwd;
our @ISA = qw(Exporter);
our @EXPORT = qw(find finddepth);
use strict;
my $Is_VMS;
my $Is_Win32;
require File::Basename;
require File::Spec;
# Should ideally be my() not our() but local() currently
# refuses to operate on lexicals
our %SLnkSeen;
our ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow,
$follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat,
$pre_process, $post_process, $dangling_symlinks);
sub contract_name {
my ($cdir,$fn) = @_;
return substr($cdir,0,rindex($cdir,'/')) if $fn eq $File::Find::current_dir;
$cdir = substr($cdir,0,rindex($cdir,'/')+1);
$fn =~ s|^\./||;
my $abs_name= $cdir . $fn;
if (substr($fn,0,3) eq '../') {
1 while $abs_name =~ s!/[^/]*/\.\./+!/!;
}
return $abs_name;
}
sub PathCombine($$) {
my ($Base,$Name) = @_;
my $AbsName;
if (substr($Name,0,1) eq '/') {
$AbsName= $Name;
}
else {
$AbsName= contract_name($Base,$Name);
}
# (simple) check for recursion
my $newlen= length($AbsName);
if ($newlen <= length($Base)) {
if (($newlen == length($Base) || substr($Base,$newlen,1) eq '/')
&& $AbsName eq substr($Base,0,$newlen))
{
return undef;
}
}
return $AbsName;
}
sub Follow_SymLink($) {
my ($AbsName) = @_;
my ($NewName,$DEV, $INO);
($DEV, $INO)= lstat $AbsName;
while (-l _) {
if ($SLnkSeen{$DEV, $INO}++) {
if ($follow_skip < 2) {
die "$AbsName is encountered a second time";
}
else {
return undef;
}
}
$NewName= PathCombine($AbsName, readlink($AbsName));
unless(defined $NewName) {
if ($follow_skip < 2) {
die "$AbsName is a recursive symbolic link";
}
else {
return undef;
}
}
else {
$AbsName= $NewName;
}
($DEV, $INO) = lstat($AbsName);
return undef unless defined $DEV; # dangling symbolic link
}
if ($full_check && defined $DEV && $SLnkSeen{$DEV, $INO}++) {
if ( ($follow_skip < 1) || ((-d _) && ($follow_skip < 2)) ) {
die "$AbsName encountered a second time";
}
else {
return undef;
}
}
return $AbsName;
}
our($dir, $name, $fullname, $prune);
sub _find_dir_symlnk($$$);
sub _find_dir($$$);
# check whether or not a scalar variable is tainted
# (code straight from the Camel, 3rd ed., page 561)
sub is_tainted_pp {
my $arg = shift;
my $nada = substr($arg, 0, 0); # zero-length
local $@;
eval { eval "# $nada" };
return length($@) != 0;
}
sub _find_opt {
my $wanted = shift;
return unless @_;
die "invalid top directory" unless defined $_[0];
# This function must local()ize everything because callbacks may
# call find() or finddepth()
local %SLnkSeen;
local ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow,
$follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat,
$pre_process, $post_process, $dangling_symlinks);
local($dir, $name, $fullname, $prune);
local *_ = \my $a;
my $cwd = $wanted->{bydepth} ? Cwd::fastcwd() : Cwd::getcwd();
if ($Is_VMS) {
# VMS returns this by default in VMS format which just doesn't
# work for the rest of this module.
$cwd = VMS::Filespec::unixpath($cwd);
# Apparently this is not expected to have a trailing space.
# To attempt to make VMS/UNIX conversions mostly reversible,
# a trailing slash is needed. The run-time functions ignore the
# resulting double slash, but it causes the perl tests to fail.
$cwd =~ s#/\z##;
# This comes up in upper case now, but should be lower.
# In the future this could be exact case, no need to change.
}
my $cwd_untainted = $cwd;
my $check_t_cwd = 1;
$wanted_callback = $wanted->{wanted};
$bydepth = $wanted->{bydepth};
$pre_process = $wanted->{preprocess};
$post_process = $wanted->{postprocess};
$no_chdir = $wanted->{no_chdir};
$full_check = $Is_Win32 ? 0 : $wanted->{follow};
$follow = $Is_Win32 ? 0 :
$full_check || $wanted->{follow_fast};
$follow_skip = $wanted->{follow_skip};
$untaint = $wanted->{untaint};
$untaint_pat = $wanted->{untaint_pattern};
$untaint_skip = $wanted->{untaint_skip};
$dangling_symlinks = $wanted->{dangling_symlinks};
# for compatibility reasons (find.pl, find2perl)
local our ($topdir, $topdev, $topino, $topmode, $topnlink);
# a symbolic link to a directory doesn't increase the link count
$avoid_nlink = $follow || $File::Find::dont_use_nlink;
my ($abs_dir, $Is_Dir);
Proc_Top_Item:
foreach my $TOP (@_) {
my $top_item = $TOP;
$top_item = VMS::Filespec::unixify($top_item) if $Is_VMS;
($topdev,$topino,$topmode,$topnlink) = $follow ? stat $top_item : lstat $top_item;
if ($Is_Win32) {
$top_item =~ s|[/\\]\z||
unless $top_item =~ m{^(?:\w:)?[/\\]$};
}
else {
$top_item =~ s|/\z|| unless $top_item eq '/';
}
$Is_Dir= 0;
if ($follow) {
if (substr($top_item,0,1) eq '/') {
$abs_dir = $top_item;
}
elsif ($top_item eq $File::Find::current_dir) {
$abs_dir = $cwd;
}
else { # care about any ../
$top_item =~ s/\.dir\z//i if $Is_VMS;
$abs_dir = contract_name("$cwd/",$top_item);
}
$abs_dir= Follow_SymLink($abs_dir);
unless (defined $abs_dir) {
if ($dangling_symlinks) {
if (ref $dangling_symlinks eq 'CODE') {
$dangling_symlinks->($top_item, $cwd);
} else {
warnings::warnif "$top_item is a dangling symbolic link\n";
}
}
next Proc_Top_Item;
}
if (-d _) {
$top_item =~ s/\.dir\z//i if $Is_VMS;
_find_dir_symlnk($wanted, $abs_dir, $top_item);
$Is_Dir= 1;
}
}
else { # no follow
$topdir = $top_item;
unless (defined $topnlink) {
warnings::warnif "Can't stat $top_item: $!\n";
next Proc_Top_Item;
}
if (-d _) {
$top_item =~ s/\.dir\z//i if $Is_VMS;
_find_dir($wanted, $top_item, $topnlink);
$Is_Dir= 1;
}
else {
$abs_dir= $top_item;
}
}
unless ($Is_Dir) {
unless (($_,$dir) = File::Basename::fileparse($abs_dir)) {
($dir,$_) = ('./', $top_item);
}
$abs_dir = $dir;
if (( $untaint ) && (is_tainted($dir) )) {
( $abs_dir ) = $dir =~ m|$untaint_pat|;
unless (defined $abs_dir) {
if ($untaint_skip == 0) {
die "directory $dir is still tainted";
}
else {
next Proc_Top_Item;
}
}
}
unless ($no_chdir || chdir $abs_dir) {
warnings::warnif "Couldn't chdir $abs_dir: $!\n";
next Proc_Top_Item;
}
$name = $abs_dir . $_; # $File::Find::name
$_ = $name if $no_chdir;
{ $wanted_callback->() }; # protect against wild "next"
}
unless ( $no_chdir ) {
if ( ($check_t_cwd) && (($untaint) && (is_tainted($cwd) )) ) {
( $cwd_untainted ) = $cwd =~ m|$untaint_pat|;
unless (defined $cwd_untainted) {
die "insecure cwd in find(depth)";
}
$check_t_cwd = 0;
}
unless (chdir $cwd_untainted) {
die "Can't cd to $cwd: $!\n";
}
}
}
}
# API:
# $wanted
# $p_dir : "parent directory"
# $nlink : what came back from the stat
# preconditions:
# chdir (if not no_chdir) to dir
sub _find_dir($$$) {
my ($wanted, $p_dir, $nlink) = @_;
my ($CdLvl,$Level) = (0,0);
my @Stack;
my @filenames;
my ($subcount,$sub_nlink);
my $SE= [];
my $dir_name= $p_dir;
my $dir_pref;
my $dir_rel = $File::Find::current_dir;
my $tainted = 0;
my $no_nlink;
if ($Is_Win32) {
$dir_pref
= ($p_dir =~ m{^(?:\w:[/\\]?|[/\\])$} ? $p_dir : "$p_dir/" );
} elsif ($Is_VMS) {
# VMS is returning trailing .dir on directories
# and trailing . on files and symbolic links
# in UNIX syntax.
#
$p_dir =~ s/\.(dir)?$//i unless $p_dir eq '.';
$dir_pref = ($p_dir =~ m/[\]>]+$/ ? $p_dir : "$p_dir/" );
}
else {
$dir_pref= ( $p_dir eq '/' ? '/' : "$p_dir/" );
}
local ($dir, $name, $prune, *DIR);
unless ( $no_chdir || ($p_dir eq $File::Find::current_dir)) {
my $udir = $p_dir;
if (( $untaint ) && (is_tainted($p_dir) )) {
( $udir ) = $p_dir =~ m|$untaint_pat|;
unless (defined $udir) {
if ($untaint_skip == 0) {
die "directory $p_dir is still tainted";
}
else {
return;
}
}
}
unless (chdir ($Is_VMS && $udir !~ /[\/\[<]+/ ? "./$udir" : $udir)) {
warnings::warnif "Can't cd to $udir: $!\n";
return;
}
}
# push the starting directory
push @Stack,[$CdLvl,$p_dir,$dir_rel,-1] if $bydepth;
while (defined $SE) {
unless ($bydepth) {
$dir= $p_dir; # $File::Find::dir
$name= $dir_name; # $File::Find::name
$_= ($no_chdir ? $dir_name : $dir_rel ); # $_
# prune may happen here
$prune= 0;
{ $wanted_callback->() }; # protect against wild "next"
next if $prune;
}
# change to that directory
unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
my $udir= $dir_rel;
if ( ($untaint) && (($tainted) || ($tainted = is_tainted($dir_rel) )) ) {
( $udir ) = $dir_rel =~ m|$untaint_pat|;
unless (defined $udir) {
if ($untaint_skip == 0) {
die "directory (" . ($p_dir ne '/' ? $p_dir : '') . "/) $dir_rel is still tainted";
} else { # $untaint_skip == 1
next;
}
}
}
unless (chdir ($Is_VMS && $udir !~ /[\/\[<]+/ ? "./$udir" : $udir)) {
warnings::warnif "Can't cd to (" .
($p_dir ne '/' ? $p_dir : '') . "/) $udir: $!\n";
next;
}
$CdLvl++;
}
$dir= $dir_name; # $File::Find::dir
# Get the list of files in the current directory.
unless (opendir DIR, ($no_chdir ? $dir_name : $File::Find::current_dir)) {
warnings::warnif "Can't opendir($dir_name): $!\n";
next;
}
@filenames = readdir DIR;
closedir(DIR);
@filenames = $pre_process->(@filenames) if $pre_process;
push @Stack,[$CdLvl,$dir_name,"",-2] if $post_process;
# default: use whatever was specified
# (if $nlink >= 2, and $avoid_nlink == 0, this will switch back)
$no_nlink = $avoid_nlink;
# if dir has wrong nlink count, force switch to slower stat method
$no_nlink = 1 if ($nlink < 2);
if ($nlink == 2 && !$no_nlink) {
# This dir has no subdirectories.
for my $FN (@filenames) {
if ($Is_VMS) {
# Big hammer here - Compensate for VMS trailing . and .dir
# No win situation until this is changed, but this
# will handle the majority of the cases with breaking the fewest
$FN =~ s/\.dir\z//i;
$FN =~ s#\.$## if ($FN ne '.');
}
next if $FN =~ $File::Find::skip_pattern;
$name = $dir_pref . $FN; # $File::Find::name
$_ = ($no_chdir ? $name : $FN); # $_
{ $wanted_callback->() }; # protect against wild "next"
}
}
else {
# This dir has subdirectories.
$subcount = $nlink - 2;
# HACK: insert directories at this position, so as to preserve
# the user pre-processed ordering of files (thus ensuring
# directory traversal is in user sorted order, not at random).
my $stack_top = @Stack;
for my $FN (@filenames) {
next if $FN =~ $File::Find::skip_pattern;
if ($subcount > 0 || $no_nlink) {
# Seen all the subdirs?
# check for directoriness.
# stat is faster for a file in the current directory
$sub_nlink = (lstat ($no_chdir ? $dir_pref . $FN : $FN))[3];
if (-d _) {
--$subcount;
$FN =~ s/\.dir\z//i if $Is_VMS;
# HACK: replace push to preserve dir traversal order
#push @Stack,[$CdLvl,$dir_name,$FN,$sub_nlink];
splice @Stack, $stack_top, 0,
[$CdLvl,$dir_name,$FN,$sub_nlink];
}
else {
$name = $dir_pref . $FN; # $File::Find::name
$_= ($no_chdir ? $name : $FN); # $_
{ $wanted_callback->() }; # protect against wild "next"
}
}
else {
$name = $dir_pref . $FN; # $File::Find::name
$_= ($no_chdir ? $name : $FN); # $_
{ $wanted_callback->() }; # protect against wild "next"
}
}
}
}
continue {
while ( defined ($SE = pop @Stack) ) {
($Level, $p_dir, $dir_rel, $nlink) = @$SE;
if ($CdLvl > $Level && !$no_chdir) {
my $tmp;
if ($Is_VMS) {
$tmp = '[' . ('-' x ($CdLvl-$Level)) . ']';
}
else {
$tmp = join('/',('..') x ($CdLvl-$Level));
}
die "Can't cd to $tmp from $dir_name: $!"
unless chdir ($tmp);
$CdLvl = $Level;
}
if ($Is_Win32) {
$dir_name = ($p_dir =~ m{^(?:\w:[/\\]?|[/\\])$}
? "$p_dir$dir_rel" : "$p_dir/$dir_rel");
$dir_pref = "$dir_name/";
}
elsif ($^O eq 'VMS') {
if ($p_dir =~ m/[\]>]+$/) {
$dir_name = $p_dir;
$dir_name =~ s/([\]>]+)$/.$dir_rel$1/;
$dir_pref = $dir_name;
}
else {
$dir_name = "$p_dir/$dir_rel";
$dir_pref = "$dir_name/";
}
}
else {
$dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
$dir_pref = "$dir_name/";
}
if ( $nlink == -2 ) {
$name = $dir = $p_dir; # $File::Find::name / dir
$_ = $File::Find::current_dir;
$post_process->(); # End-of-directory processing
}
elsif ( $nlink < 0 ) { # must be finddepth, report dirname now
$name = $dir_name;
if ( substr($name,-2) eq '/.' ) {
substr($name, length($name) == 2 ? -1 : -2) = '';
}
$dir = $p_dir;
$_ = ($no_chdir ? $dir_name : $dir_rel );
if ( substr($_,-2) eq '/.' ) {
substr($_, length($_) == 2 ? -1 : -2) = '';
}
{ $wanted_callback->() }; # protect against wild "next"
}
else {
push @Stack,[$CdLvl,$p_dir,$dir_rel,-1] if $bydepth;
last;
}
}
}
}
# API:
# $wanted
# $dir_loc : absolute location of a dir
# $p_dir : "parent directory"
# preconditions:
# chdir (if not no_chdir) to dir
sub _find_dir_symlnk($$$) {
my ($wanted, $dir_loc, $p_dir) = @_; # $dir_loc is the absolute directory
my @Stack;
my @filenames;
my $new_loc;
my $updir_loc = $dir_loc; # untainted parent directory
my $SE = [];
my $dir_name = $p_dir;
my $dir_pref;
my $loc_pref;
my $dir_rel = $File::Find::current_dir;
my $byd_flag; # flag for pending stack entry if $bydepth
my $tainted = 0;
my $ok = 1;
$dir_pref = ( $p_dir eq '/' ? '/' : "$p_dir/" );
$loc_pref = ( $dir_loc eq '/' ? '/' : "$dir_loc/" );
local ($dir, $name, $fullname, $prune, *DIR);
unless ($no_chdir) {
# untaint the topdir
if (( $untaint ) && (is_tainted($dir_loc) )) {
( $updir_loc ) = $dir_loc =~ m|$untaint_pat|; # parent dir, now untainted
# once untainted, $updir_loc is pushed on the stack (as parent directory);
# hence, we don't need to untaint the parent directory every time we chdir
# to it later
unless (defined $updir_loc) {
if ($untaint_skip == 0) {
die "directory $dir_loc is still tainted";
}
else {
return;
}
}
}
$ok = chdir($updir_loc) unless ($p_dir eq $File::Find::current_dir);
unless ($ok) {
warnings::warnif "Can't cd to $updir_loc: $!\n";
return;
}
}
push @Stack,[$dir_loc,$updir_loc,$p_dir,$dir_rel,-1] if $bydepth;
while (defined $SE) {
unless ($bydepth) {
# change (back) to parent directory (always untainted)
unless ($no_chdir) {
unless (chdir $updir_loc) {
warnings::warnif "Can't cd to $updir_loc: $!\n";
next;
}
}
$dir= $p_dir; # $File::Find::dir
$name= $dir_name; # $File::Find::name
$_= ($no_chdir ? $dir_name : $dir_rel ); # $_
$fullname= $dir_loc; # $File::Find::fullname
# prune may happen here
$prune= 0;
lstat($_); # make sure file tests with '_' work
{ $wanted_callback->() }; # protect against wild "next"
next if $prune;
}
# change to that directory
unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
$updir_loc = $dir_loc;
if ( ($untaint) && (($tainted) || ($tainted = is_tainted($dir_loc) )) ) {
# untaint $dir_loc, what will be pushed on the stack as (untainted) parent dir
( $updir_loc ) = $dir_loc =~ m|$untaint_pat|;
unless (defined $updir_loc) {
if ($untaint_skip == 0) {
die "directory $dir_loc is still tainted";
}
else {
next;
}
}
}
unless (chdir $updir_loc) {
warnings::warnif "Can't cd to $updir_loc: $!\n";
next;
}
}
$dir = $dir_name; # $File::Find::dir
# Get the list of files in the current directory.
unless (opendir DIR, ($no_chdir ? $dir_loc : $File::Find::current_dir)) {
warnings::warnif "Can't opendir($dir_loc): $!\n";
next;
}
@filenames = readdir DIR;
closedir(DIR);
for my $FN (@filenames) {
if ($Is_VMS) {
# Big hammer here - Compensate for VMS trailing . and .dir
# No win situation until this is changed, but this
# will handle the majority of the cases with breaking the fewest.
$FN =~ s/\.dir\z//i;
$FN =~ s#\.$## if ($FN ne '.');
}
next if $FN =~ $File::Find::skip_pattern;
# follow symbolic links / do an lstat
$new_loc = Follow_SymLink($loc_pref.$FN);
# ignore if invalid symlink
unless (defined $new_loc) {
if (!defined -l _ && $dangling_symlinks) {
$fullname = undef;
if (ref $dangling_symlinks eq 'CODE') {
$dangling_symlinks->($FN, $dir_pref);
} else {
warnings::warnif "$dir_pref$FN is a dangling symbolic link\n";
}
}
else {
$fullname = $loc_pref . $FN;
}
$name = $dir_pref . $FN;
$_ = ($no_chdir ? $name : $FN);
{ $wanted_callback->() };
next;
}
if (-d _) {
if ($Is_VMS) {
$FN =~ s/\.dir\z//i;
$FN =~ s#\.$## if ($FN ne '.');
$new_loc =~ s/\.dir\z//i;
$new_loc =~ s#\.$## if ($new_loc ne '.');
}
push @Stack,[$new_loc,$updir_loc,$dir_name,$FN,1];
}
else {
$fullname = $new_loc; # $File::Find::fullname
$name = $dir_pref . $FN; # $File::Find::name
$_ = ($no_chdir ? $name : $FN); # $_
{ $wanted_callback->() }; # protect against wild "next"
}
}
}
continue {
while (defined($SE = pop @Stack)) {
($dir_loc, $updir_loc, $p_dir, $dir_rel, $byd_flag) = @$SE;
$dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
$dir_pref = "$dir_name/";
$loc_pref = "$dir_loc/";
if ( $byd_flag < 0 ) { # must be finddepth, report dirname now
unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
unless (chdir $updir_loc) { # $updir_loc (parent dir) is always untainted
warnings::warnif "Can't cd to $updir_loc: $!\n";
next;
}
}
$fullname = $dir_loc; # $File::Find::fullname
$name = $dir_name; # $File::Find::name
if ( substr($name,-2) eq '/.' ) {
substr($name, length($name) == 2 ? -1 : -2) = ''; # $File::Find::name
}
$dir = $p_dir; # $File::Find::dir
$_ = ($no_chdir ? $dir_name : $dir_rel); # $_
if ( substr($_,-2) eq '/.' ) {
substr($_, length($_) == 2 ? -1 : -2) = '';
}
lstat($_); # make sure file tests with '_' work
{ $wanted_callback->() }; # protect against wild "next"
}
else {
push @Stack,[$dir_loc, $updir_loc, $p_dir, $dir_rel,-1] if $bydepth;
last;
}
}
}
}
sub wrap_wanted {
my $wanted = shift;
if ( ref($wanted) eq 'HASH' ) {
# RT #122547
my %valid_options = map {$_ => 1} qw(
wanted
bydepth
preprocess
postprocess
follow
follow_fast
follow_skip
dangling_symlinks
no_chdir
untaint
untaint_pattern
untaint_skip
);
my @invalid_options = ();
for my $v (keys %{$wanted}) {
push @invalid_options, $v unless exists $valid_options{$v};
}
warn "Invalid option(s): @invalid_options" if @invalid_options;
unless( exists $wanted->{wanted} and ref( $wanted->{wanted} ) eq 'CODE' ) {
die 'no &wanted subroutine given';
}
if ( $wanted->{follow} || $wanted->{follow_fast}) {
$wanted->{follow_skip} = 1 unless defined $wanted->{follow_skip};
}
if ( $wanted->{untaint} ) {
$wanted->{untaint_pattern} = $File::Find::untaint_pattern
unless defined $wanted->{untaint_pattern};
$wanted->{untaint_skip} = 0 unless defined $wanted->{untaint_skip};
}
return $wanted;
}
elsif( ref( $wanted ) eq 'CODE' ) {
return { wanted => $wanted };
}
else {
die 'no &wanted subroutine given';
}
}
sub find {
my $wanted = shift;
_find_opt(wrap_wanted($wanted), @_);
}
sub finddepth {
my $wanted = wrap_wanted(shift);
$wanted->{bydepth} = 1;
_find_opt($wanted, @_);
}
# default
$File::Find::skip_pattern = qr/^\.{1,2}\z/;
$File::Find::untaint_pattern = qr|^([-+@\w./]+)$|;
# These are hard-coded for now, but may move to hint files.
if ($^O eq 'VMS') {
$Is_VMS = 1;
$File::Find::dont_use_nlink = 1;
}
elsif ($^O eq 'MSWin32') {
$Is_Win32 = 1;
}
# this _should_ work properly on all platforms
# where File::Find can be expected to work
$File::Find::current_dir = File::Spec->curdir || '.';
$File::Find::dont_use_nlink = 1
if $^O eq 'os2' || $^O eq 'dos' || $^O eq 'amigaos' || $Is_Win32 ||
$^O eq 'interix' || $^O eq 'cygwin' || $^O eq 'qnx' || $^O eq 'nto';
# Set dont_use_nlink in your hint file if your system's stat doesn't
# report the number of links in a directory as an indication
# of the number of files.
# See e.g. hints/haiku.sh for Haiku.
unless ($File::Find::dont_use_nlink) {
require Config;
$File::Find::dont_use_nlink = 1 if ($Config::Config{'dont_use_nlink'});
}
# We need a function that checks if a scalar is tainted. Either use the
# Scalar::Util module's tainted() function or our (slower) pure Perl
# fallback is_tainted_pp()
{
local $@;
eval { require Scalar::Util };
*is_tainted = $@ ? \&is_tainted_pp : \&Scalar::Util::tainted;
}
1;
__END__
=head1 NAME
File::Find - Traverse a directory tree.
=head1 SYNOPSIS
use File::Find;
find(\&wanted, @directories_to_search);
sub wanted { ... }
use File::Find;
finddepth(\&wanted, @directories_to_search);
sub wanted { ... }
use File::Find;
find({ wanted => \&process, follow => 1 }, '.');
=head1 DESCRIPTION
These are functions for searching through directory trees doing work
on each file found similar to the Unix I<find> command. File::Find
exports two functions, C<find> and C<finddepth>. They work similarly
but have subtle differences.
=over 4
=item B<find>
find(\&wanted, @directories);
find(\%options, @directories);
C<find()> does a depth-first search over the given C<@directories> in
the order they are given. For each file or directory found, it calls
the C<&wanted> subroutine. (See below for details on how to use the
C<&wanted> function). Additionally, for each directory found, it will
C<chdir()> into that directory and continue the search, invoking the
C<&wanted> function on each file or subdirectory in the directory.
=item B<finddepth>
finddepth(\&wanted, @directories);
finddepth(\%options, @directories);
C<finddepth()> works just like C<find()> except that it invokes the
C<&wanted> function for a directory I<after> invoking it for the
directory's contents. It does a postorder traversal instead of a
preorder traversal, working from the bottom of the directory tree up
where C<find()> works from the top of the tree down.
=back
=head2 %options
The first argument to C<find()> is either a code reference to your
C<&wanted> function, or a hash reference describing the operations
to be performed for each file. The
code reference is described in L</The wanted function> below.
Here are the possible keys for the hash:
=over 3
=item C<wanted>
The value should be a code reference. This code reference is
described in L</The wanted function> below. The C<&wanted> subroutine is
mandatory.
=item C<bydepth>
Reports the name of a directory only AFTER all its entries
have been reported. Entry point C<finddepth()> is a shortcut for
specifying C<< { bydepth => 1 } >> in the first argument of C<find()>.
=item C<preprocess>
The value should be a code reference. This code reference is used to
preprocess the current directory. The name of the currently processed
directory is in C<$File::Find::dir>. Your preprocessing function is
called after C<readdir()>, but before the loop that calls the C<wanted()>
function. It is called with a list of strings (actually file/directory
names) and is expected to return a list of strings. The code can be
used to sort the file/directory names alphabetically, numerically,
or to filter out directory entries based on their name alone. When
I<follow> or I<follow_fast> are in effect, C<preprocess> is a no-op.
=item C<postprocess>
The value should be a code reference. It is invoked just before leaving
the currently processed directory. It is called in void context with no
arguments. The name of the current directory is in C<$File::Find::dir>. This
hook is handy for summarizing a directory, such as calculating its disk
usage. When I<follow> or I<follow_fast> are in effect, C<postprocess> is a
no-op.
=item C<follow>
Causes symbolic links to be followed. Since directory trees with symbolic
links (followed) may contain files more than once and may even have
cycles, a hash has to be built up with an entry for each file.
This might be expensive both in space and time for a large
directory tree. See L</follow_fast> and L</follow_skip> below.
If either I<follow> or I<follow_fast> is in effect:
=over 6
=item *
It is guaranteed that an I<lstat> has been called before the user's
C<wanted()> function is called. This enables fast file checks involving C<_>.
Note that this guarantee no longer holds if I<follow> or I<follow_fast>
are not set.
=item *
There is a variable C<$File::Find::fullname> which holds the absolute
pathname of the file with all symbolic links resolved. If the link is
a dangling symbolic link, then fullname will be set to C<undef>.
=back
This is a no-op on Win32.
=item C<follow_fast>
This is similar to I<follow> except that it may report some files more
than once. It does detect cycles, however. Since only symbolic links
have to be hashed, this is much cheaper both in space and time. If
processing a file more than once (by the user's C<wanted()> function)
is worse than just taking time, the option I<follow> should be used.
This is also a no-op on Win32.
=item C<follow_skip>
C<follow_skip==1>, which is the default, causes all files which are
neither directories nor symbolic links to be ignored if they are about
to be processed a second time. If a directory or a symbolic link
are about to be processed a second time, File::Find dies.
C<follow_skip==0> causes File::Find to die if any file is about to be
processed a second time.
C<follow_skip==2> causes File::Find to ignore any duplicate files and
directories but to proceed normally otherwise.
=item C<dangling_symlinks>
Specifies what to do with symbolic links whose target doesn't exist.
If true and a code reference, will be called with the symbolic link
name and the directory it lives in as arguments. Otherwise, if true
and warnings are on, a warning of the form C<"symbolic_link_name is a dangling
symbolic link\n"> will be issued. If false, the dangling symbolic link
will be silently ignored.
=item C<no_chdir>
Does not C<chdir()> to each directory as it recurses. The C<wanted()>
function will need to be aware of this, of course. In this case,
C<$_> will be the same as C<$File::Find::name>.
=item C<untaint>
If find is used in L<taint-mode|perlsec/Taint mode> (-T command line switch or
if EUID != UID or if EGID != GID), then internally directory names have to be
untainted before they can be C<chdir>'d to. Therefore they are checked against
a regular expression I<untaint_pattern>. Note that all names passed to the
user's C<wanted()> function are still tainted. If this option is used while not
in taint-mode, C<untaint> is a no-op.
=item C<untaint_pattern>
See above. This should be set using the C<qr> quoting operator.
The default is set to C<qr|^([-+@\w./]+)$|>.
Note that the parentheses are vital.
=item C<untaint_skip>
If set, a directory which fails the I<untaint_pattern> is skipped,
including all its sub-directories. The default is to C<die> in such a case.
=back
=head2 The wanted function
The C<wanted()> function does whatever verifications you want on
each file and directory. Note that despite its name, the C<wanted()>
function is a generic callback function, and does B<not> tell
File::Find if a file is "wanted" or not. In fact, its return value
is ignored.
The wanted function takes no arguments but rather does its work
through a collection of variables.
=over 4
=item C<$File::Find::dir> is the current directory name,
=item C<$_> is the current filename within that directory
=item C<$File::Find::name> is the complete pathname to the file.
=back
The above variables have all been localized and may be changed without
affecting data outside of the wanted function.
For example, when examining the file F</some/path/foo.ext> you will have:
$File::Find::dir = /some/path/
$_ = foo.ext
$File::Find::name = /some/path/foo.ext
You are chdir()'d to C<$File::Find::dir> when the function is called,
unless C<no_chdir> was specified. Note that when changing to
directories is in effect, the root directory (F</>) is a somewhat
special case inasmuch as the concatenation of C<$File::Find::dir>,
C<'/'> and C<$_> is not literally equal to C<$File::Find::name>. The
table below summarizes all variants:
$File::Find::name $File::Find::dir $_
default / / .
no_chdir=>0 /etc / etc
/etc/x /etc x
no_chdir=>1 / / /
/etc / /etc
/etc/x /etc /etc/x
When C<follow> or C<follow_fast> are in effect, there is
also a C<$File::Find::fullname>. The function may set
C<$File::Find::prune> to prune the tree unless C<bydepth> was
specified. Unless C<follow> or C<follow_fast> is specified, for
compatibility reasons (find.pl, find2perl) there are in addition the
following globals available: C<$File::Find::topdir>,
C<$File::Find::topdev>, C<$File::Find::topino>,
C<$File::Find::topmode> and C<$File::Find::topnlink>.
This library is useful for the C<find2perl> tool (distributed as part of the
App-find2perl CPAN distribution), which when fed,
find2perl / -name .nfs\* -mtime +7 \
-exec rm -f {} \; -o -fstype nfs -prune
produces something like:
sub wanted {
/^\.nfs.*\z/s &&
(($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($_)) &&
int(-M _) > 7 &&
unlink($_)
||
($nlink || (($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($_))) &&
$dev < 0 &&
($File::Find::prune = 1);
}
Notice the C<_> in the above C<int(-M _)>: the C<_> is a magical
filehandle that caches the information from the preceding
C<stat()>, C<lstat()>, or filetest.
Here's another interesting wanted function. It will find all symbolic
links that don't resolve:
sub wanted {
-l && !-e && print "bogus link: $File::Find::name\n";
}
Note that you may mix directories and (non-directory) files in the list of
directories to be searched by the C<wanted()> function.
find(\&wanted, "./foo", "./bar", "./baz/epsilon");
In the example above, no file in F<./baz/> other than F<./baz/epsilon> will be
evaluated by C<wanted()>.
See also the script C<pfind> on CPAN for a nice application of this
module.
=head1 WARNINGS
If you run your program with the C<-w> switch, or if you use the
C<warnings> pragma, File::Find will report warnings for several weird
situations. You can disable these warnings by putting the statement
no warnings 'File::Find';
in the appropriate scope. See L<warnings> for more info about lexical
warnings.
=head1 CAVEAT
=over 2
=item $dont_use_nlink
You can set the variable C<$File::Find::dont_use_nlink> to 1 if you want to
force File::Find to always stat directories. This was used for file systems
that do not have an C<nlink> count matching the number of sub-directories.
Examples are ISO-9660 (CD-ROM), AFS, HPFS (OS/2 file system), FAT (DOS file
system) and a couple of others.
You shouldn't need to set this variable, since File::Find should now detect
such file systems on-the-fly and switch itself to using stat. This works even
for parts of your file system, like a mounted CD-ROM.
If you do set C<$File::Find::dont_use_nlink> to 1, you will notice slow-downs.
=item symlinks
Be aware that the option to follow symbolic links can be dangerous.
Depending on the structure of the directory tree (including symbolic
links to directories) you might traverse a given (physical) directory
more than once (only if C<follow_fast> is in effect).
Furthermore, deleting or changing files in a symbolically linked directory
might cause very unpleasant surprises, since you delete or change files
in an unknown directory.
=back
=head1 BUGS AND CAVEATS
Despite the name of the C<finddepth()> function, both C<find()> and
C<finddepth()> perform a depth-first search of the directory
hierarchy.
=head1 HISTORY
File::Find used to produce incorrect results if called recursively.
During the development of perl 5.8 this bug was fixed.
The first fixed version of File::Find was 1.01.
=head1 SEE ALSO
L<find(1)>, find2perl.
=cut
Compare.pm 0000644 00000010354 15036324715 0006501 0 ustar 00 package File::Compare;
use 5.006;
use strict;
use warnings;
our($VERSION, @ISA, @EXPORT, @EXPORT_OK, $Too_Big);
require Exporter;
$VERSION = '1.1006';
@ISA = qw(Exporter);
@EXPORT = qw(compare);
@EXPORT_OK = qw(cmp compare_text);
$Too_Big = 1024 * 1024 * 2;
sub croak {
require Carp;
goto &Carp::croak;
}
sub compare {
croak("Usage: compare( file1, file2 [, buffersize]) ")
unless(@_ == 2 || @_ == 3);
my ($from,$to,$size) = @_;
my $text_mode = defined($size) && (ref($size) eq 'CODE' || $size < 0);
my ($fromsize,$closefrom,$closeto);
local (*FROM, *TO);
croak("from undefined") unless (defined $from);
croak("to undefined") unless (defined $to);
if (ref($from) &&
(UNIVERSAL::isa($from,'GLOB') || UNIVERSAL::isa($from,'IO::Handle'))) {
*FROM = *$from;
} elsif (ref(\$from) eq 'GLOB') {
*FROM = $from;
} else {
open(FROM,"<",$from) or goto fail_open1;
unless ($text_mode) {
binmode FROM;
$fromsize = -s FROM;
}
$closefrom = 1;
}
if (ref($to) &&
(UNIVERSAL::isa($to,'GLOB') || UNIVERSAL::isa($to,'IO::Handle'))) {
*TO = *$to;
} elsif (ref(\$to) eq 'GLOB') {
*TO = $to;
} else {
open(TO,"<",$to) or goto fail_open2;
binmode TO unless $text_mode;
$closeto = 1;
}
if (!$text_mode && $closefrom && $closeto) {
# If both are opened files we know they differ if their size differ
goto fail_inner if $fromsize != -s TO;
}
if ($text_mode) {
local $/ = "\n";
my ($fline,$tline);
while (defined($fline = <FROM>)) {
goto fail_inner unless defined($tline = <TO>);
if (ref $size) {
# $size contains ref to comparison function
goto fail_inner if &$size($fline, $tline);
} else {
goto fail_inner if $fline ne $tline;
}
}
goto fail_inner if defined($tline = <TO>);
}
else {
unless (defined($size) && $size > 0) {
$size = $fromsize || -s TO || 0;
$size = 1024 if $size < 512;
$size = $Too_Big if $size > $Too_Big;
}
my ($fr,$tr,$fbuf,$tbuf);
$fbuf = $tbuf = '';
while(defined($fr = read(FROM,$fbuf,$size)) && $fr > 0) {
unless (defined($tr = read(TO,$tbuf,$fr)) && $tbuf eq $fbuf) {
goto fail_inner;
}
}
goto fail_inner if defined($tr = read(TO,$tbuf,$size)) && $tr > 0;
}
close(TO) || goto fail_open2 if $closeto;
close(FROM) || goto fail_open1 if $closefrom;
return 0;
# All of these contortions try to preserve error messages...
fail_inner:
close(TO) || goto fail_open2 if $closeto;
close(FROM) || goto fail_open1 if $closefrom;
return 1;
fail_open2:
if ($closefrom) {
my $status = $!;
$! = 0;
close FROM;
$! = $status unless $!;
}
fail_open1:
return -1;
}
sub cmp;
*cmp = \&compare;
sub compare_text {
my ($from,$to,$cmp) = @_;
croak("Usage: compare_text( file1, file2 [, cmp-function])")
unless @_ == 2 || @_ == 3;
croak("Third arg to compare_text() function must be a code reference")
if @_ == 3 && ref($cmp) ne 'CODE';
# Using a negative buffer size puts compare into text_mode too
$cmp = -1 unless defined $cmp;
compare($from, $to, $cmp);
}
1;
__END__
=head1 NAME
File::Compare - Compare files or filehandles
=head1 SYNOPSIS
use File::Compare;
if (compare("file1","file2") == 0) {
print "They're equal\n";
}
=head1 DESCRIPTION
The File::Compare::compare function compares the contents of two
sources, each of which can be a file or a file handle. It is exported
from File::Compare by default.
File::Compare::cmp is a synonym for File::Compare::compare. It is
exported from File::Compare only by request.
File::Compare::compare_text does a line by line comparison of the two
files. It stops as soon as a difference is detected. compare_text()
accepts an optional third argument: This must be a CODE reference to
a line comparison function, which returns 0 when both lines are considered
equal. For example:
compare_text($file1, $file2)
is basically equivalent to
compare_text($file1, $file2, sub {$_[0] ne $_[1]} )
=head1 RETURN
File::Compare::compare and its sibling functions return 0 if the files
are equal, 1 if the files are unequal, or -1 if an error was encountered.
=head1 AUTHOR
File::Compare was written by Nick Ing-Simmons.
Its original documentation was written by Chip Salzenberg.
=cut
DosGlob/DosGlob.so 0000755 00000017120 15056246613 0010005 0 ustar 00 ELF > � @ @ 8 @ � � h
h
h
� � �
�
�
8 8 8 $ $ p p p S�td p p p P�td T T T 4 4 Q�td R�td h
h
h
� � GNU ��1v�C��P� ��g>�
�@
BE���|�8{�qX � � � � � e , � F " | 0 � `
� $ __gmon_start__ _ITM_deregisterTMCloneTable _ITM_registerTMCloneTable __cxa_finalize libpthread.so.0 Perl_hv_common_key_len Perl_get_hv Perl_newSVpvn Perl_sv_2mortal boot_File__DosGlob Perl_xs_handshake Perl_newXS_deffile Perl_my_cxt_init Perl_xs_boot_epilog libperl.so.5.26 libc.so.6 _edata __bss_start _end GLIBC_2.2.5 ui 5 h
@ p
x
x
� � � � � � � � � � �
� � � �H��H�� H��t��H��� �5" �%# � �h ������ �h ������� �h ������ �h ������ �h ������ �h ������ �h ������ �h ��q����� �h ��a����� ��%� D � ��%� D � ��%} D � ��%u D � ��%m D � ��%e D � ��%] D � ��%U D � ��%M D H�=q H�j H9�tH�6 H��t �� � � � H�=A H�5: H)�H��H��H��?H�H�tH� H��t��f D � � � ��=� u+UH�=� H��t H�=V �I����d����� ]� � � � ��w��� � � �USH����� H�t$tTHc� H��� H��H�,�H�u H��tBH�T$H��E1�H��j A�D � ���XZH�EH��t
H�t$H���H��[]� D H�5> 1����H��H�E H��t��ff. � �� �USH��H��H�GxH�P�H�Wx�H��� �jHcP H�4R� H��HpH��0�-���H��H����H�KHc�H��H�CH��H�H��[]� D � �UL�� H��1�SH�
� H��H�� ���
H�����H��H�U���H�5� ���w���H�ߺ H�5H �C���H��� ��H��Hc0 H��H� H��� H�PH�c���H��� H��[]���� � �H��H���File::DosGlob::entries 1.12 v5.26.0 DosGlob.c File::DosGlob::_callsite ;0 ���L ����t ����� ����� ���� zR x � $ ����� FJ w� ?:*3$" D 0���� 4 \ h���� E�A�D0u8H@Q8A0W
AAF $ � ���k E�A�G [AA$ � ���� E�M�Z lAA GNU � @ x
U 8
h
p
���o ` 0 �
A � � ` � � ���o ���o � ���o �o r ���o �
p � � � � � � � � ���� GA$3a1 8
GA$3p1113 P �
GA* GA$annobin gcc 8.5.0 20210514 GA$plugin name: gcc-annobin GA$running gcc 8.5.0 20210514 GA* GA* GA!
GA*FORTIFY GA+GLIBCXX_ASSERTIONS GA*GOW *� GA*cf_protection GA+omit_frame_pointer GA+stack_clash GA!stack_realign
GA*FORTIFY P � GA+GLIBCXX_ASSERTIONS DosGlob.so-5.26.3-423.el8_10.x86_64.debug �#5��7zXZ �ִF ! t/��o*] ?�E�h=��ڊ�2N��ߵN ����jf��y���F {��!> �/�!ܙ s`(Kg��KC��c�ҁ��Wd�,_�~N͜^�G����ϣBiu�X�{���L��A:B��#�U�gO��/�H�$�D;&X�<��\�T�����nͻ ��1���^�aa��� ��� ~��0x�{�AZZOat��"�N���^\
�M�A�$���ih� ��� ET�� ��ÁJet�
�`W,���! )��&O0��D���̥����=��� ��(��� �
����rA�t9�<N�6��2髷E�hU�1�+�s������������ �)n��s@�!�h��~շ53m�f�!]d�o?L�o�yM2ܸ� XO��f�$���c{,>�b1�`�\�y��z���H��v�? 6��9r�]UVf���m��i�v�B�o���_����[3��� ܹ��߿�ʊ�w��D��M�����2�C\x�����6���s�;_Q!'�A���7�M�@�m�w|�5��V������=@8�TL3�� ��x|�w���Hb�u*4� {��#�^�N:ź���T?%�qiGcu�C��Y���~����Gx��<Q� O�^D�ӌ�ꬼh� ��Ƭ��RL����MHoZ{%�|��Aܕ��{���L����:3'��q�L��)� �Qb@���� ���v-� ,�����H�G���Q��m't��j�(^'àkL�zT-�j�4����L�#��B�.�~d� ,�c6�& �� g����g� YZ .shstrtab .note.gnu.build-id .gnu.hash .dynsym .dynstr .gnu.version .gnu.version_r .rela.dyn .rela.plt .init .plt.sec .text .fini .rodata .eh_frame_hdr .eh_frame .note.gnu.property .init_array .fini_array .data.rel.ro .dynamic .got .data .bss .gnu.build.attributes .gnu_debuglink .gnu_debugdata 8 8 $ ���o ` ` 4 ( � � � 0 0 0 A 8 ���o r r " E ���o � � T � � � ^ B ` ` � h 8 8 c ` ` � n � w � � o }
� 2
G � T T 4 � � � � � p p � h
h
� p
p
� x
x
� �
�
� � � � � � � ` H
L 0 | l � ( Glob/Glob.so 0000755 00000100470 15056246613 0006672 0 ustar 00 ELF > � @ �y @ 8 @ �Y �Y �i �i �i �k �k �k 8 8 8 $ $ �Y �Y �Y S�td �Y �Y �Y P�td R R R � � Q�td R�td �i �i �i GNU �[S�z�R�W-��*�� * E �@ E G I BE���|�qX C��^:� ��^�q b s
W 4 \ � � � � B p B � i � 1 � � l J � � e S � � � � 2 � � g � � � � � � y � � � � I � � � � I f , � X F " . � W p j p ^ p � �6 i t �M a y �5 , __gmon_start__ _ITM_deregisterTMCloneTable _ITM_registerTMCloneTable __cxa_finalize libpthread.so.0 strcmp PL_charclass readdir64 __lxstat64 __stack_chk_fail __xstat64 Perl_safesysrealloc Perl_safesysmalloc Perl_safesysfree sysconf PL_memory_wrap Perl_croak_nocontext __errno_location Perl_my_strlcpy __ctype_tolower_loc opendir closedir getpwnam qsort getenv getuid getpwuid bsd_glob bsd_globfree Perl_hv_common_key_len Perl_croak_xs_usage Perl_newSVpvn_flags Perl_newSVpvf_nocontext Perl_sv_2mortal Perl_croak_sv Perl_sv_dup_inc Perl_newSV Perl_sv_newmortal Perl_sv_setiv_mg strlen Perl_sv_magic Perl_stack_grow Perl_get_sv Perl_sv_2iv_flags Perl_sv_upgrade Perl_av_push Perl_block_gimme Perl_markstack_grow Perl_sv_2pv_flags memchr Perl_av_shift memcpy Perl_newSV_type Perl_ck_warner Perl_mg_get Perl_gv_add_by_type Perl_sv_catpvn_flags Perl_sv_setpvn Perl_newSVpvn Perl_sv_free2 boot_File__Glob Perl_xs_handshake Perl_newXS_deffile Perl_my_cxt_init PL_thr_key pthread_getspecific Perl_get_hv Perl_newCONSTSUB Perl_newSViv Perl_mro_method_changed_in Perl_xs_boot_epilog Perl_croak libperl.so.5.26 libc.so.6 _edata __bss_start _end GLIBC_2.2.5 GLIBC_2.3 GLIBC_2.14 GLIBC_2.4 U ui o M ii
{ ��� � ii
� ui o �i � �i @ j j j �P 8j �P Pj �P hj Q �j Q �j Q �j "Q �j ,Q �j 8Q �j EQ k RQ (k ^Q @k kQ Xk vQ pk �Q �o �o �o �o �o $ �o = �o A �m �m �m �m �m �m �m �m �m
n n n
n n (n 0n 8n @n Hn Pn Xn `n hn pn xn �n �n �n �n ! �n " �n # �n % �n & �n ' �n ( �n ) �n * �n + �n , �n - �n . o / o 0 o 1 o 2 o 3 (o 4 0o 5 8o 6 @o 7 Ho 8 Po 9 Xo : `o H ho ; po < xo > �o J �o ? �o @ �o A �o B �o C �o D � �H��H�!X H��t��H��� �5�U �%�U � �h ������ �h ������� �h ������ �h ������ �h ������ �h ������ �h ������ �h ��q����� �h ��a����� �h ��Q����� �h
��A����� �h ��1����� �h ��!����� �h
������� �h ������� �h ����� �h ������ �h ������� �h ������ �h ������ �h ������ �h ������ �h ������ �h ��q����� �h ��a����� �h ��Q����� �h ��A����� �h ��1����� �h ��!����� �h ������� �h ������� �h ����� �h ������ �h! ������� �h" ������ �h# ������ �h$ ������ �h% ������ �h& ������ �h' ��q����� �h( ��a����� �h) ��Q����� �h* ��A����� �h+ ��1����� �h, ��!����� �h- ������� �h. ������� �h/ ����� �h0 ������ �h1 ������� �h2 ������ �h3 ������ �h4 ������ �h5 ������ �h6 ������ �h7 ��q����� �h8 ��a����� �h9 ��Q����� �h: ��A����� �h; ��1����� �h< ��!����� �h= ������� �h> ������� �h? ����� ��%�Q D � ��%�Q D � ��%�Q D � ��%�Q D � ��%�Q D � ��%�Q D � ��%�Q D � ��%�Q D � ��%�Q D � ��%�Q D � ��%�Q D � ��%�Q D � ��%}Q D � ��%uQ D � ��%mQ D � ��%eQ D � ��%]Q D � ��%UQ D � ��%MQ D � ��%EQ D � ��%=Q D � ��%5Q D � ��%-Q D � ��%%Q D � ��% Q D � ��%Q D � ��%
Q D � ��%Q D � ��%�P D � ��%�P D � ��%�P D � ��%�P D � ��%�P D � ��%�P D � ��%�P D � ��%�P D � ��%�P D � ��%�P D � ��%�P D � ��%�P D � ��%�P D � ��%�P D � ��%�P D � ��%�P D � ��%}P D � ��%uP D � ��%mP D � ��%eP D � ��%]P D � ��%UP D � ��%MP D � ��%EP D � ��%=P D � ��%5P D � ��%-P D � ��%%P D � ��% P D � ��%P D � ��%
P D � ��%P D � ��%�O D � ��%�O D � ��%�O D � ��%�O D H�=1P H�*P H9�tH��O H��t �� � � � H�=P H�5�O H)�H��H��H��?H�H�tH��O H��t��f D � � � ��=�O u+UH�=�O H��t H�=�I �)����d�����O ]� � � � ��w��� � � �H�6H�?������ �UL� O SH�?H�6����� ��H��H��E����u$�o @ H���E H�����tU��E����tM�H A��@ D��A��@ ��AD�D��G��D�J ��E��A��@ A��@ AD�9�t���
E�A��@ �H A��@ ����D���E���J ����A��@ A��@ D�)�t[]� []����� ����� � H�� H� $ H��dH�%( H��$ 1�I��L��M�� D�H��D�@�E��t/H��L9�u����H��$ dH3 %( u0H�� �f D �@t L���� @ H�� L�������y���f � H�� H� $ H��dH�%( H��$ 1�I��L��M�� D�H��D�@�E��t/H��L9�u����H��$ dH3 %( u0H�� �f D �@t L���� @ H�� L����������f � H�������� AWAVI��AUI��ATUH��SH���vAu ��I�}Hc�L�$� H���� I9��� H������I�EH��H��H���� H���/ I�ML�� � H��f�� u�L)�H�L$H��H�H] H������H�L$I��1�M��u � � A�FA�H����tH9�u�L�����������5 A�E �PAEH�A�U L�<�A�E AEH�H�� A�E % @ u[H��[]A\A]A^A_� � I9��� H��H���+���I�}H������ � A�E AEH�H�� A�E
@�� 1�Le �0���I9�sh1�M����H��[��]A\A]A^A_�f�A�U������Hc�H��H��H� � H��H� H9�u���� H�5K H�=2+ 1��3���� ���� ���������H��t��T���I�E ��������f�AWA� AVAUATI��UH��SH��H�� A�dH�%( H��$� 1�L��$� L��$� f���� H��L��1�f��/u�qH��f�P��f��tpf��/tjf��AH�H��H9�vڸ H��$� dH34%( �2 H�ĸ []A\A]A^A_� @ �/ H��H��f�P��f��/u'H��H9�s�� @ ���� f��/t�H�� � I���G���1�M�E L�|$L��f�M L��I�M8L��L�D$�z�����1����Y���A�E t#f�}�/t �D$(L�D$% � = @ ti= � t<A�EL��L��L���q�������H��H��L��AVAUAQI��H���Q H�� ��I�M@L��L��L�������u��D$(% � = @ u�H�EH9�������E / ����� � AWAVAUATUSH�� H� $ H�� � H��$� H��$� H��$� H�|$pH�D$hH��$� H�t$xH�T$8H�L$@L�D$HL�L$H��$� dH�%( H��$� 1�H9�v+H��$� dH3 %( ���� H�Ĩ []A\A]A^A_�E1�I��fD��Q�� A�H��f���� H��$� H�L$pH��H�� �f��H��H���P���trH9�u�H�D$hH�� H�T$pL�@H��M���5 � H���r�H��@�p�@���� H9�u�����-���H��$� � H�5�' H�����H�D$hH��@ @�q �P0H�D$PH�|$P �m���H�L$hH�=
���H�|$X�A A��A�� �@�F E�� D H�|$PH�D$X��H���7 �x.u H�L$Hf�9.u�H�t$8H�|$@H9��3 �HL�nf�f��tWH��H���f D �I��H��fA�U�f��t3L9�w�M��1�� fA�?H�D$hH�|$P�@ @�� �P �!��� @ L;l$@s�E1�L�l$`H�D$HE��H�l$8M��H�D$ �%f D f�} � M���� H�\$L��H��H9D$v�D� H�XfA��?��~ fA��[��� fA��*��� D�u E���� A��� = ����H� B� �A�č�� �� � $���� $H� B��9���H�����j���M���Y��� D H�D$81�E��f�0�^���f D H9\$�- f�} t�L�}H�D$�$���H�u�m H�t$(f��t��P1�f��!�@�lj|$0u�PH�XD��E1�L�|$ E��J�� D��A����H�D$A��$� �$D��I��D�d$I�܉��qf D E��� D��A��$� = �T$4��T$4H� D�$��<$ �D$�T$4��H�t$�T$4H� �0A9������ E���M��I��f��]��� A�T$f��-��u���E���� D��A��� = � �H� D�4��<$ �l$��H�L$H� �,A9�-A�D$��� I�Ɓ� ���H� B��9Ÿ N�M�t$A�T$�T��� � fD9����7��� @ fD9�w�fE;l$� F���f. � f�} H�E�����H���M���f � E����L�|$ L��9D$0� ���H�l$(�#��� � fE9������ @ E��L�l$`��$� �t$pL��$� I�U�L�D$H�L$PH��$� H��$� �:���ZY���������Q�����H�D$P���H�A(H�D$X���H�D$h1�H�|$P�@ @�2����1��Q���L�|$8����3H��A�Ѕ�� ���H�D$h�@ ��1��!����g� � AVAUATUSL��$ ���H�� H� $ L9�u�H�� D�n dH�%( H��$@ 1��H��H��H�D$ L�t$f��~�� A�� �� L�gL��I��� � A�$f��/tf��tH��I���P�H9�u�� �|$ �B L���z�H���[ H�@ L��I��� f����d H��H��f�Q�H9�u�H��1�D�k L��f�:�D$�;H��L��Lc�� f�f��*�� f%� H��H��f�A��H�rf���� f��?tAf��[u�D�JL�AA��!�� L�RH��fE���� �[ H��f�L��� � �?����K H��H��f�A�� � �K L9�tf�y�*�H���n����*���H��H��f�A��Y���1�f�f�|$ �g �C D9��� � � D�k 1�H��$@ dH3<%( �� H�� @ []A\A]A^�f D f�z u�[ f�H��L�����f D L�RH��L��� H��f���[ �0f��]u�[���f�1A��!�� �L��� � H����]tMI��f%� I�pfA� �f��-u��Bf��]�! f%� �-���I�pH��fA�HfA�@�H����]u��]����K H�Nf��+���f�H�SH�������0H�
9�H�"�HD�HcCD)�Hc�I�J�<� �����f D H�D$H��$ M��PH��� M��� H��SH���=�A[A^���1 �;�C D9��`����u�� �� �H���D�k H�T$H��H������=���f�A�[ fD�A��!�f���H���]��� H���- ���f�H�=� ��H��������f����/�H�������D�k �E �����!���L�Af�q�G��� � I��� H9������A�4$I�D$H�Qf�1f�������I��� H)�H��H��I�tL� � H���H�H��f�J�f���O���H9�u��E��� D D�k �B�����f�AWAVAUATUSH�� H� $ H�� H� $ H��(H��H��I��dH� %( H��$ 1�H9��% L�l$I��L��f�H9�u�H�P�L)�H��M�|U1�L�`fA��Pf��t@L���1�� � f��}tj�CH��f��t f��[tgf��{u��C��H��f��u�L��L���v����E 1�H��$ dH3 %( �� H��( []A\A]A^A_� � ���� ��� �CL�Kf��]tbf��t]L��� � L���~L�Ff��]tf��u�f��t�FH�^�F��� � L���;��� � L�l$M����� f���6����CH������M��1�I9�v&�Ff D f��}u
��tP�� H9�r+A�T$I��I�L$f��[�� v!f��{u˃�H9�s� �E ���� @ f��,u���u�M9��� L��L�� � f�L9�r�I�D$�L)�H��I�tG1� � �Tf�H��f��u�L��L��H�L$�v H�L$1��E I���L��� @ A�D$H��f��t$f��]u� f. � f��t
H���f��]u�f���
���H�JI������L���p������ff. � �AUATI��UH��SH��dH�%( H�D$1��f��{t<H��L�l$� D H��f��t7�f��{u�L��L��H��H��������u�D$� f�}u�f� u� D L��H�����H�T$dH3%( u H��[]A\A]��-�ff. � f�� �H�� H� $ H�� H� $ H��dH�%( H��$ 1���I��H���H�A L��� �A H��H�QH� �A �� tdL��� �f. � f�P�M��L9�tMA�M�PD��E��t<H��A��\u�A�P��t`I����@f�P��� H��f�P�I��L9�tA���u�1ҁ� H��f�t7�b���H��$ dH34%( u&H�� � � M�к\@ �f D �������� @ � �H�GH��t[ATI��USHcWH� Ћ��t)�B�H�l�f D H�;H��t�C�H��H9�u�I�D$H���-�I�D$ []A\� � � � � �� ��w� ��H��H�Ѓ�Ð� �USH����� H�t$tJHc�8 H��� H��H�,�H�uH��tH�D$�@ f%�f��t'f=� t!H�EH��t
H�t$H���H��[]� � H�T$H��E1�H��j A�D � ���XZ�ff. � � �SH��H��H�CxH� H�P�H�SxHcH�CH��H)�H��H����t H�5 �a��N H�H��H�vH�P�� �� �O�H��� H�=1 H��1��J$H�R0��H��H����H��H�����f. � � �ATUSH��H��0dH�%( H�D$(1�H�GxH�P�H�WxHc>7 �(H��� H�Ѓ�L�`M��t(H�$ H�D$ H�H�T$H�pH��� �I�ľ H��Hc��M�H��� Hc
�6 H�@H� �H�H��oB@H�RL�`H�PH�H�CH�D�H�H�D$(dH3%( u H��0[]A\��?�ff. � @ � �AVAUATUSH��H��H�CxH�3H�P�H�SxH�SHc �hH��H)�H��H������ H��� Hc
16 L�4�H�C�@#t[H�HH�CL�$�A�D$ Hc�L�l�IcV��������uI��� t@��I�T$A�D$ M�eH�CH��H�[]A\A]A^� H���`�H�SI��� � L��H�����H�5� �'� � AVf�AUATUH��H����SH��`Hcq5 L�e dH�%( H�D$X1�H��� L�l$L��H� �H�s���)D$)D$ )D$0)D$@H�D$P ���T$�CHcʅ��� H�E L)�H��H9��� ��~P1� D H�T$ Hc�L�4�L���|�� L��H��H���i���� ��� ��u@I��I�$��9\$�L�e L����H�D$XdH3%( uUH��`[]A\A]A^�f D H��E1�E1��t 1�H��H�D$��H�D$� @ L��L��H���B��T$I���;�������� �AWAVAUI��H�5 ATI�Ժ UH��SH��H� ����P �� �� �� H� �P H�ExH��H�ExH;�� �� H��H+uH��H���0L��H�] �!���H�ExL�e L�}H�P�H�UxHcH�E�@"���� <A��E��t>L�e H��D��[]A\A]A^A_� � � H��H���0�����c���f � � L��I�\�H�����I9�r�f D H�L��H��H���@H�S����I9�s�� � H������b��� H��T$ �|��T$ ���� AWAVAUATUSH��H��HHc�2 H�/H�t$dH�%( H�D$81�H��� H��H�D$H�GH�D$H�G�@"���� ��L�m�L�u �D$H�D$H�pH���5 H��E1�A�0 H��j � H�S���AYAZL�8A� �� A�F � �� ��uo<tk�� ��
t[H��� H�FL�0M���l A�F � �� ��u0<t,�� ��
t H�D$0 E1�L�
� E1��� ��� �� u0I�A��M�NA�� L�bD����L�d$0�L$'��tEC�<! tv�<�H��H�T$01�L���n��L�d$0I��A�F A��A�� D�ǃ�@�|$'��tM9Nt�L�� L��H������P �� �� �m H�L�HL�bL�d$0I��v"1�L��I�T$�L�L$(�3��L�L$(H���� D�D$'L�+L��L��L��H��H�D$��L�+�|$I�m�g I�H�x�� L��H�����H��H�����I�EH�+H�D$8dH3%( �M H��H[]A\A]A^A_�f � �|$u�I�H�HH���tRH���� H�C L)�H��H9��� H�������� H9��� I�wI�}H�� ���I�H�@M�l�H�D$H��E1�H�S� A�@ H��L��H�pj �^��Y^�8��� � �{��� ���f D H�T$01�H��H�����L�d$0I������H�D$H��H�SE1�A�D � H��H�pj ���H��8 I�EXZ���� D ���N������ � H������H��H�D$H�p���f�H�D$L�L$����H��H��L�P H�T$ � �9 1�H�
� H��RL�L$H�� ���_AX�|$tH��8 I��H�E L�+�(��� @ L��H�����A�F �h��� @ 1�H������H�@L�0�~���f�L��L��H���R��I��I�H�HH���1��� � L��H���]��A�F �O��� @ H�5�- H�=
1�� �����f D � �H�55 � ���� �SH�WxH��H�H�J�H�OxHc
H��H�WH��H)�H��H��Hc�H��H)ȅ�tH�PH�H��H�5� [���� @ H�W H)�H��~H��8 H�PH�H�� � H��H���h����f D � �SH�WxH��H�H�J�H�OxHc
H��H�WH��H)�H��H��Hc�H��H)ȅ�tH�PH�H��H�5��[�<��� @ H�W H)�H��~H��8 H�PH�H�� � H��H��������f D � �AWAVAUATUSH��H��(L�'H�OdH�%( H�D$1�H�GxM��H�P�H�WxHcH�ՍBH��I)�I��E���� H�Ic�H�4�L�<� H��I)ԋF % = �� H�L�nH�PH�T$H��vH��1�L�����H���� A���� H�C��Hc�H�4�F % = uAH��P ����L�#L��H���O���H�D$dH3%( �� H��([]A\A]A^A_� @ � H�������� � H�T$� ���H�T$I���G��� @ � H�5t H���\���P �� �� ukH� �P �c���H�D$�6��H��M��H��H�T$� 1�L�� H�
; �9 H��RH�� ���H�CJ�D8�H�XZ���� � � H��H�������������H��H�5�
�U�� D � �AWAVAUATUSH��H��XH�/H�t$0H�5�
H�T$ � H�L$8D�D$LD�D$�n���P �� �� �� H� �@ �D$H�C�@"��� H�t$0��� H��L�t$ L�|$8�D$H���E1�H�D$ H�D$( M�M�n� � M�eM9�vQE�uA��'�� A��\�n A��"�� H��) B��% D = D �9 M��M��MD�M�eM9�w�H�D$L�L$8H���D$LI �L�L$ H�|$( �� H�L$(H�L�iH�@����� ��L�t$0L�d$@I��I�D�H�D$f D I�D$xH��I�D$xI;�$� �� H��I+T$I��L��H����T$I�,$I�E�H�p�z�I�D$xI�T$I�,$H�p�I�t$xHc H��I��H�\I��H9�w' H�L��L��H���@H�S����H9�s�I�T$J�,�L;l$�U���L��L�d$@H�|$ � H�+1�H��X[]A\A]A^A_� D M��MD�M�eM9��� A�E<"t M��<'�H���L��L)�H�|$ H�J��� H�t$L��H��M��A� �1��M������f � H�|$ �� M��t L��H�t$L��H��L)�A� ����I�U� D A8�� M��M�l$M9�vBA�D$<\u�M�l$M9�v�E:t$u�L��H�t$A� H��H)�H�����L��� D H�A' A�W�H�t$ ������� D ���� D �� D �7 H������� D �� D t�H�|$8H�t$ H�H���� D � I9��K H�T$ H�D$I)�H��� L��H��H�����H�|$( �( H�D$M���D$LH�D$8 H�D$ �7��� � M�����L��H�t$A� H��H)����E1���� � M���� L��L)�H�|$ �� H�t$A� L��H���g��H�|$( �� H�T$H�t$(H��M�����E1�H�D$ � ��� D 1�H�5H H��L�L$@����|$ L�L$@H�D$���H ���L��H��H��L�L$@�V���|$ L�L$@H�D$�� H�|$ M�������H�|$( �[���� H���i��H��H�����H�D$(�9��� @ L������?���H�t$H���� H�T$8H��tL��A� H��H)��W��H�D$H�SxH�@H�D$8H�BH�CxH;�� �� H��H+CH�t$8H��H���B�T$H�+�n�H�D$�P���@ ���PH�sxH�|$( L�#H�KH�F�H�Cx���|$H�� ��/���Hc.L�,� J�l)L9�w*L�t$0�H�E L��H��H���@H�U��U��I9�s�H�KJ�,)���� H��H���C���D$H�C�@"��� ���H���&����H��L��H������|$ H�D$tL�H M��M���
���L���� D uFf. � I��A�W����� D �� D t�I9������M��M�������H �m���H�D$H���� �P��� ���PH�D$ M���D$L H�D$ H�D$8��H�SxH�BH�CxH;�� t'H��H+CH�t$8H��H���B�T$H�+���a���H������H��H+SH��H��H�t$8��T$H�+���|$L �-������� � H�D$ M���D$L H�D$8�]����L$LH�t$ L��H��M��� �w��H�D$8 H��H�D$ �D$LH�D$�#����D$L�f���H�t$H���������H�t$H���������f � � �AWL�� H��1�AVH�
� H�� AUI�����
ATUSH� i H�����H���H�5x L��D$�6��H�O���H�5u L��� ��H��H�5t L���
��H���H�5s L������H�m�H�5{ L������H���H�5w L������H��� L��I��� H�5�! ����I��� Hc�! H��H�@ I��� L�(H�PH���I��� H�! �8�2��H�5 � H��H�����H�����I���' @ L��L��L��H���g��H��H�; �� H�sH���M��H��L�3�Kj E1�A� L��L��H��I�����ZYH���� H�H�A ��u��Ѝr���v��Ɓ� ��
�y�����tM��H��L�y�A A�O H�; �t���L��H������t$H��L��[]A\A]A^A_��� � H�κ H��H�L$� ��H�L$�A �L��H�5 H������ � �H��H��� %s HOME File::Glob::DEFAULT_FLAGS pattern pattern_sv, ... 1.28 v5.26.0 Glob.c File::Glob::GLOB_ERROR File::Glob::bsd_glob File::Glob::csh_glob File::Glob::bsd_glob_override File::Glob::CLONE File::Glob::AUTOLOAD File::Glob:: 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_CSH %-p is not a valid File::Glob macro at %s line %lu
Invalid \0 character in %s for %s: %s\0%s Couldn't add key '%s' to %%File::Glob:: ;� ��� ���8 p��P ���d p��� ���� ��� ���� ���H ���� 0�� ���x ��� p� ��, �` 0�t ��� p�� `�� P�8 ��| �� ��\ ��p �� � � `���X zR x � $ ��� FJ w� ?:*3$" D p�� \ �� ( p ��� E�H��
AD AA � ��� � ���� G� I� Y
G � T��� G� I� Y
G ` � ��� L�B�E �E(�A0�D8�DP�
8A0A(B BBBH a
8A0C(B BBBC ` T ���� B�H�B �B(�D0�D8�J��
8A0A(B BBBE ��H�B�B�O� ` � ��i B�B�B �B(�A0�A8�G� L�!�
8A0A(B BBBA �!D�!l�!A�! d ��� B�B�B �A(�A0�H ��Q
DЀ�
0A(A BBBG 1R�JBЀ P � p��� B�B�B �B(�A0�A8�G� L�@I�@�
8A0A(B BBBI 8 � ���� B�B�D �D(�D@�
(A ABBA `��, K� L�@I�@�
H 0 8 l�i O�D�A �IABH��� l �� 4 � ��� E�A�D0\
AAH I8H@Q8A0 � �� E� 0 � ��� F�A�A �GP�
AABA < `�� F�B�B �A(�A0��
(A BBBD @ D �_ B�F�B �A(�I0�D��
0A(A BBBG H � ,�] F�B�B �L(�I0�D8�DP�
8D0A(B BBBI � � @�� B�B�B �B(�A0�A8�G�n�N�P�B��
8A0A(B BBBJ o�^�F�A�E�[�Q�A�M�h�R�B� h |� | x�� E�J
I � ��� E�J
I T � X� F�B�B �B(�A0�A8�G`�
8A0A(B BBBE vhkpYhA`L �7 F�B�B �B(�A0�A8�G�#
8A0A(B BBBF X d �a F�N�P �J(�A0�A8�KPLXH`[XAPk
8D0A(B BBBM GNU � � @ j �P
���������P �P @ Q
� Q Q
@ "Q ,Q 8Q EQ RQ ^Q ��������kQ
vQ
�Q �. U = M �
�O �i �i ���o ` � �
� �m � H X ���o ���o � ���o �o B ���o �k � � � 0 @ P ` p � � � � � � � � 0 @ P ` p � � � � � � � � 0 @ P ` p � � � � � � � � 0 @ P ` p � � � � � ���� GA$3a1 � �O GA$3p1113 � )7 GA* GA$annobin gcc 8.5.0 20210514 GA$plugin name: gcc-annobin GA$running gcc 8.5.0 20210514 GA* GA* GA!
GA*FORTIFY GA+GLIBCXX_ASSERTIONS GA*GOW *� GA*cf_protection GA+omit_frame_pointer GA+stack_clash GA!stack_realign GA$3p1113 07 �O GA* GA$annobin gcc 8.5.0 20210514 GA$plugin name: gcc-annobin GA$running gcc 8.5.0 20210514 GA* GA* GA!
GA*FORTIFY GA+GLIBCXX_ASSERTIONS GA*GOW *� GA*cf_protection GA+omit_frame_pointer GA+stack_clash GA!stack_realign
GA*FORTIFY � O7 GA+GLIBCXX_ASSERTIONS Glob.so-5.26.3-423.el8_10.x86_64.debug II���7zXZ �ִF ! t/���>] ?�E�h=��ڊ�2N�`��� ��Ӭ1v��VQ�}�1}��H/��gؾ"^`���h}�|��d��wd��}�r�w�;g�f��q�8Z�'�z��^�T�m %��1�L��$J�H��
��o���|�m�9$Bw ,6ݡ���k �y�)��Q�^�p[�M$oS.���@�ac��.������H�A�� ;z{}�,n��D����/:�P��ܬ��μ�V��8 u ]9�@ӈң:7�7��{ �ݦ|JB]���p��E.��Dk�thL�
�X2$+/x����Əҍ<�MP����������*8u��/�u�
�{b��E%G$?�#9��'��;
������C��������ZSB�_�0EϚV��ԨBN����e��s#=y�� �Y@�'�����s˰��� ���<�7&w�������W�I5���e�5���D���a2LS\4�P� �|�]��ԏA�ݺO��\rH��_Z%P?�6�0���L~;$��@e�e�%i��z}EnA?-]B]�����N� �X�j��v�zJ��9o(���b���$�~u�%]�D"���' 9��0�'���z��Ƒ� jt~�����j9�fO�(���2+�},�g��j. �1 hn�%�B�R�����&���Ma'ƞ��$Z�`=r3(�:+'*O� � �4[\5�����g��qz� ��ͯ��l�x?*D� �=�ዐ�����hS(��H��}�ғ�Aq���s��h k�*���f�������z� 8�k�m��$ck3'tJ�W�
blW (�p"��N ��1몆2�;X
m�'�+�y_��%Di���8z��IC��H����վ�QP
J����~(-v��I8x�D�AM����w���c�����ST���,sF�62.d��� q{5�X埰B+�]�`��F�ƚ�h�ЏM=�\�"��*i�@٤`��ӋXv z�cQ����a���_��dˢ3x�酰j|�b9�i k� LGY� �:$��Ek�{U��*"�N � �RPY�@s!�{Z<��J�?HSn�����W���d Tђ�?�, ��# u��\��g� YZ .shstrtab .note.gnu.build-id .gnu.hash .dynsym .dynstr .gnu.version .gnu.version_r .rela.dyn .rela.plt .init .plt.sec .text .fini .rodata .eh_frame_hdr .eh_frame .note.gnu.property .init_array .fini_array .data.rel.ro .dynamic .got .data .bss .gnu.build.attributes .gnu_debuglink .gnu_debugdata 8 8 $ ���o ` ` < ( � � 0 � � � 8 ���o B B � E ���o � � p T H H X ^ B � � h � � c � � n � � w � � 0 } �O �O
� 2 �O �O ( � R R � � S S � � �Y �Y � �i �i � �i �i � j j � � �k �k � �m �m P � p p � p p � p` p
t , Lt � �x (