[p5sagit/p5-mst-13.2.git] / ext / File / Glob / Glob.pm

package File::Glob;

use strict;
use Carp;
use vars qw($VERSION @ISA @EXPORT_OK @EXPORT_FAIL %EXPORT_TAGS $AUTOLOAD);

require Exporter;
require DynaLoader;
require AutoLoader;

@ISA = qw(Exporter DynaLoader AutoLoader);

@EXPORT_OK   = qw(
    globally
    csh_glob
    glob
    GLOB_ABEND
    GLOB_ALTDIRFUNC
    GLOB_BRACE
    GLOB_ERR
    GLOB_ERROR
    GLOB_MARK
    GLOB_NOCHECK
    GLOB_NOMAGIC
    GLOB_NOSORT
    GLOB_NOSPACE
    GLOB_QUOTE
    GLOB_TILDE
);

@EXPORT_FAIL = ( 'globally' );

%EXPORT_TAGS = (
    'glob' => [ qw(
        GLOB_ABEND
        GLOB_ALTDIRFUNC
        GLOB_BRACE
        GLOB_ERR
        GLOB_ERROR
        GLOB_MARK
        GLOB_NOCHECK
        GLOB_NOMAGIC
        GLOB_NOSORT
        GLOB_NOSPACE
        GLOB_QUOTE
        GLOB_TILDE
        glob
    ) ],
);

$VERSION = '0.99';

sub export_fail {
    shift;

    if ($_[0] eq 'globally') {
        local $^W;
        *CORE::GLOBAL::glob = \&File::Glob::csh_glob;
        shift;
    }

    @_;
}

sub AUTOLOAD {
    # This AUTOLOAD is used to 'autoload' constants from the constant()
    # XS function.  If a constant is not found then control is passed
    # to the AUTOLOAD in AutoLoader.

    my $constname;
    ($constname = $AUTOLOAD) =~ s/.*:://;
    my $val = constant($constname, @_ ? $_[0] : 0);
    if ($! != 0) {
	if ($! =~ /Invalid/) {
	    $AutoLoader::AUTOLOAD = $AUTOLOAD;
	    goto &AutoLoader::AUTOLOAD;
	}
	else {
		croak "Your vendor has not defined File::Glob macro $constname";
	}
    }
    eval "sub $AUTOLOAD { $val }";
    goto &$AUTOLOAD;
}

bootstrap File::Glob $VERSION;

# Preloaded methods go here.

sub GLOB_ERROR {
    return constant('GLOB_ERROR', 0);
}

sub GLOB_CSH () { GLOB_BRACE() | GLOB_NOMAGIC() | GLOB_QUOTE() | GLOB_TILDE() }

# Autoload methods go after =cut, and are processed by the autosplit program.

sub glob {
    return doglob(@_);
}

## borrowed heavily from gsar's File::DosGlob
my %iter;
my %entries;

sub csh_glob {
    my $pat = shift;
    my $cxix = shift;
    my @pat;

    # glob without args defaults to $_
    $pat = $_ unless defined $pat;

    # extract patterns
    if ($pat =~ /\s/) {
        # XXX this is needed for compatibility with the csh
	# implementation in Perl.  Need to support a flag
	# to disable this behavior.
	require Text::ParseWords;
	@pat = Text::ParseWords::parse_line('\s+',0,$pat);
    }

    # assume global context if not provided one
    $cxix = '_G_' unless defined $cxix;
    $iter{$cxix} = 0 unless exists $iter{$cxix};

    # if we're just beginning, do it all first
    if ($iter{$cxix} == 0) {
	if (@pat) {
	    $entries{$cxix} = [ map { doglob($_, GLOB_CSH) } @pat ];
	}
	else {
	    $entries{$cxix} = [ doglob($pat, GLOB_CSH) ];
	}
    }

    # chuck it all out, quick or slow
    if (wantarray) {
        delete $iter{$cxix};
        return @{delete $entries{$cxix}};
    }
    else {
        if ($iter{$cxix} = scalar @{$entries{$cxix}}) {
            return shift @{$entries{$cxix}};
        }
        else {
            # return undef for EOL
            delete $iter{$cxix};
            delete $entries{$cxix};
            return undef;
        }
    }
}

1;
__END__

=head1 NAME

File::Glob - Perl extension for BSD glob routine

=head1 SYNOPSIS

  use File::Glob ':glob';
  @list = glob('*.[ch]');
  $homedir = glob('~gnat', GLOB_TILDE | GLOB_ERR);
  if (GLOB_ERROR) {
    # an error occurred reading $homedir
  }

  ## override the core glob (even with -T)
  use File::Glob 'globally';
  my @sources = <*.{c,h,y}>

=head1 DESCRIPTION

File::Glob implements the FreeBSD glob(3) routine, which is a superset
of the POSIX glob() (described in IEEE Std 1003.2 "POSIX.2").  The
glob() routine 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.  The POSIX defined flags are:

=over 4

=item C<GLOB_ERR>

Force glob() to return an error when it encounters a directory it
cannot open or read.  Ordinarily glob() continues to find matches.

=item C<GLOB_MARK>

Each pathname that is a directory that matches the pattern has a slash
appended.

=item C<GLOB_NOCHECK>

If the pattern does not match any pathname, then 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 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.

=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>.

=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.

=head1 DIAGNOSTICS

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 glob() has found some matching paths, but is
interrupted by an error, glob() will return a list of filenames B<and>
set &File::Glob::ERROR.

Note that glob() deviates from POSIX and FreeBSD glob(3) behaviour by
not considering C<ENOENT> and C<ENOTDIR> as errors - 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<glob "a* b*">, you should
probably throw them in a set as in C<glob "{a*,b*}>.  This is because
the argument to glob isn't subjected to parsing by the C shell.  Remember
that you can use a backslash to escape things.

=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.

=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> and Gurusamy Sarathy
E<lt>gsar@activestate.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:

    1. Redistributions of source code must retain the above copyright
       notice, this list of conditions and the following disclaimer.
    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.
    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.

    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
Commit	Line	Data
72b16652	1	package File::Glob;
	2
	3	use strict;
	4	use Carp;
	5	use vars qw($VERSION @ISA @EXPORT_OK @EXPORT_FAIL %EXPORT_TAGS $AUTOLOAD);
	6
	7	require Exporter;
	8	require DynaLoader;
	9	require AutoLoader;
	10
	11	@ISA = qw(Exporter DynaLoader AutoLoader);
	12
	13	@EXPORT_OK = qw(
	14	globally
	15	csh_glob
	16	glob
	17	GLOB_ABEND
	18	GLOB_ALTDIRFUNC
	19	GLOB_BRACE
	20	GLOB_ERR
	21	GLOB_ERROR
	22	GLOB_MARK
	23	GLOB_NOCHECK
	24	GLOB_NOMAGIC
	25	GLOB_NOSORT
	26	GLOB_NOSPACE
	27	GLOB_QUOTE
	28	GLOB_TILDE
	29	);
	30
	31	@EXPORT_FAIL = ( 'globally' );
	32
	33	%EXPORT_TAGS = (
	34	'glob' => [ qw(
	35	GLOB_ABEND
	36	GLOB_ALTDIRFUNC
	37	GLOB_BRACE
	38	GLOB_ERR
	39	GLOB_ERROR
	40	GLOB_MARK
	41	GLOB_NOCHECK
	42	GLOB_NOMAGIC
	43	GLOB_NOSORT
	44	GLOB_NOSPACE
	45	GLOB_QUOTE
	46	GLOB_TILDE
	47	glob
	48	) ],
	49	);
	50
	51	$VERSION = '0.99';
	52
	53	sub export_fail {
	54	shift;
	55
	56	if ($_[0] eq 'globally') {
	57	local $^W;
	58	*CORE::GLOBAL::glob = \&File::Glob::csh_glob;
	59	shift;
	60	}
	61
	62	@_;
	63	}
	64
65	sub AUTOLOAD {
66	# This AUTOLOAD is used to 'autoload' constants from the constant()
67	# XS function. If a constant is not found then control is passed
68	# to the AUTOLOAD in AutoLoader.
69
70	my $constname;
71	($constname = $AUTOLOAD) =~ s/.*:://;
72	my $val = constant($constname, @_ ? $_[0] : 0);
73	if ($! != 0) {
74	if ($! =~ /Invalid/) {
75	$AutoLoader::AUTOLOAD = $AUTOLOAD;
76	goto &AutoLoader::AUTOLOAD;
77	}
78	else {
79	croak "Your vendor has not defined File::Glob macro $constname";
80	}
81	}
82	eval "sub $AUTOLOAD { $val }";
83	goto &$AUTOLOAD;
84	}
85
86	bootstrap File::Glob $VERSION;
87
88	# Preloaded methods go here.
89
90	sub GLOB_ERROR {
91	return constant('GLOB_ERROR', 0);
92	}
93
94	sub GLOB_CSH () { GLOB_BRACE() \| GLOB_NOMAGIC() \| GLOB_QUOTE() \| GLOB_TILDE() }
95
96	# Autoload methods go after =cut, and are processed by the autosplit program.
97
98	sub glob {
99	return doglob(@_);
100	}
101
102	## borrowed heavily from gsar's File::DosGlob
103	my %iter;
104	my %entries;
105
106	sub csh_glob {
107	my $pat = shift;
108	my $cxix = shift;
109	my @pat;
110
111	# glob without args defaults to $_
112	$pat = $_ unless defined $pat;
113
114	# extract patterns
115	if ($pat =~ /\s/) {
116	# XXX this is needed for compatibility with the csh
117	# implementation in Perl. Need to support a flag
118	# to disable this behavior.
119	require Text::ParseWords;
120	@pat = Text::ParseWords::parse_line('\s+',0,$pat);
121	}
122
123	# assume global context if not provided one
124	$cxix = '_G_' unless defined $cxix;
125	$iter{$cxix} = 0 unless exists $iter{$cxix};
126
127	# if we're just beginning, do it all first
128	if ($iter{$cxix} == 0) {
129	if (@pat) {
130	$entries{$cxix} = [ map { doglob($_, GLOB_CSH) } @pat ];
131	}
132	else {
133	$entries{$cxix} = [ doglob($pat, GLOB_CSH) ];
134	}
135	}
136
137	# chuck it all out, quick or slow
138	if (wantarray) {
139	delete $iter{$cxix};
140	return @{delete $entries{$cxix}};
141	}
142	else {
143	if ($iter{$cxix} = scalar @{$entries{$cxix}}) {
144	return shift @{$entries{$cxix}};
145	}
146	else {
147	# return undef for EOL
148	delete $iter{$cxix};
149	delete $entries{$cxix};
150	return undef;
151	}
152	}
153	}
154
155	1;
156	__END__
157
158	=head1 NAME
159
160	File::Glob - Perl extension for BSD glob routine
161
162	=head1 SYNOPSIS
163
164	use File::Glob ':glob';
165	@list = glob('*.[ch]');
166	$homedir = glob('~gnat', GLOB_TILDE \| GLOB_ERR);
167	if (GLOB_ERROR) {
168	# an error occurred reading $homedir
169	}
170
171	## override the core glob (even with -T)
172	use File::Glob 'globally';
173	my @sources = <*.{c,h,y}>
174
175	=head1 DESCRIPTION
176
177	File::Glob implements the FreeBSD glob(3) routine, which is a superset
178	of the POSIX glob() (described in IEEE Std 1003.2 "POSIX.2"). The
179	glob() routine takes a mandatory C<pattern> argument, and an optional
180	C<flags> argument, and returns a list of filenames matching the
181	pattern, with interpretation of the pattern modified by the C<flags>
182	variable. The POSIX defined flags are:
183
184	=over 4
185
186	=item C<GLOB_ERR>
187
188	Force glob() to return an error when it encounters a directory it
189	cannot open or read. Ordinarily glob() continues to find matches.
190
191	=item C<GLOB_MARK>
192
193	Each pathname that is a directory that matches the pattern has a slash
194	appended.
195
196	=item C<GLOB_NOCHECK>
197
198	If the pattern does not match any pathname, then glob() returns a list
199	consisting of only the pattern. If C<GLOB_QUOTE> is set, its effect
200	is present in the pattern returned.
201
202	=item C<GLOB_NOSORT>
203
204	By default, the pathnames are sorted in ascending ASCII order; this
205	flag prevents that sorting (speeding up glob()).
206
207	=back
208
209	The FreeBSD extensions to the POSIX standard are the following flags:
210
211	=over 4
212
213	=item C<GLOB_BRACE>
214
215	Pre-process the string to expand C<{pat,pat,...} strings like csh(1).
216	The pattern '{}' is left unexpanded for historical reasons (and csh(1)
217	does the same thing to ease typing of find(1) patterns).
218
219	=item C<GLOB_NOMAGIC>
220
221	Same as C<GLOB_NOCHECK> but it only returns the pattern if it does not
222	contain any of the special characters "*", "?" or "[". C<NOMAGIC> is
223	provided to simplify implementing the historic csh(1) globbing
224	behaviour and should probably not be used anywhere else.
225
226	=item C<GLOB_QUOTE>
227
228	Use the backslash ('\') character for quoting: every occurrence of a
229	backslash followed by a character in the pattern is replaced by that
230	character, avoiding any special interpretation of the character.
231
232	=item C<GLOB_TILDE>
233
234	Expand patterns that start with '~' to user name home directories.
235
236	=item C<GLOB_CSH>
237
238	For convenience, C<GLOB_CSH> is a synonym for
239	C<GLOB_BRACE \| GLOB_NOMAGIC \| GLOB_QUOTE \| GLOB_TILDE>.
240
241	=back
242
243	The POSIX provided C<GLOB_APPEND>, C<GLOB_DOOFFS>, and the FreeBSD
244	extensions C<GLOB_ALTDIRFUNC>, and C<GLOB_MAGCHAR> flags have not been
245	implemented in the Perl version because they involve more complex
246	interaction with the underlying C structures.
247
248	=head1 DIAGNOSTICS
249
250	glob() returns a list of matching paths, possibly zero length. If an
251	error occurred, &File::Glob::GLOB_ERROR will be non-zero and C<$!> will be
252	set. &File::Glob::GLOB_ERROR is guaranteed to be zero if no error occurred,
253	or one of the following values otherwise:
254
255	=over 4
256
257	=item C<GLOB_NOSPACE>
258
259	An attempt to allocate memory failed.
260
261	=item C<GLOB_ABEND>
262
263	The glob was stopped because an error was encountered.
264
265	=back
266
267	In the case where glob() has found some matching paths, but is
268	interrupted by an error, glob() will return a list of filenames B<and>
269	set &File::Glob::ERROR.
270
271	Note that glob() deviates from POSIX and FreeBSD glob(3) behaviour by
272	not considering C<ENOENT> and C<ENOTDIR> as errors - glob() will
273	continue processing despite those errors, unless the C<GLOB_ERR> flag is
274	set.
275
276	Be aware that all filenames returned from File::Glob are tainted.
277
278	=head1 NOTES
279
280	=over 4
281
282	=item *
283
284	If you want to use multiple patterns, e.g. C<glob "a* b*">, you should
285	probably throw them in a set as in C<glob "{a,b}>. This is because
286	the argument to glob isn't subjected to parsing by the C shell. Remember
287	that you can use a backslash to escape things.
288
289	=item *
290
291	Win32 users should use the real slash. If you really want to use
292	backslashes, consider using Sarathy's File::DosGlob, which comes with
293	the standard Perl distribution.
294
295	=head1 AUTHOR
296
0e950d83	297	The Perl interface was written by Nathan Torkington E<lt>gnat@frii.comE<gt>,
72b16652	298	and is released under the artistic license. Further modifications were
	299	made by Greg Bacon E<lt>gbacon@cs.uah.eduE<gt> and Gurusamy Sarathy
	300	E<lt>gsar@activestate.comE<gt>. The C glob code has the
	301	following copyright:
	302
0e950d83	303	Copyright (c) 1989, 1993 The Regents of the University of California.
	304	All rights reserved.
	305
	306	This code is derived from software contributed to Berkeley by
	307	Guido van Rossum.
	308
	309	Redistribution and use in source and binary forms, with or without
	310	modification, are permitted provided that the following conditions
	311	are met:
	312
	313	1. Redistributions of source code must retain the above copyright
	314	notice, this list of conditions and the following disclaimer.
	315	2. Redistributions in binary form must reproduce the above copyright
	316	notice, this list of conditions and the following disclaimer in the
	317	documentation and/or other materials provided with the distribution.
	318	3. Neither the name of the University nor the names of its contributors
	319	may be used to endorse or promote products derived from this software
	320	without specific prior written permission.
	321
	322	THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
	323	ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
	324	IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
	325	ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
	326	FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
	327	DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
	328	OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
	329	HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
	330	LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
	331	OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
	332	SUCH DAMAGE.
72b16652	333
72b16652	334	=cut