Commit ec078f8d0e93f9a22b37a8e97578e1bfffbc9fa0 - libfile-next-perl

New upstream version 1.18 Axel Beckert 4 years ago

8 changed file(s) with 102 addition(s) and 59 deletion(s). Raw diff Collapse all Expand all

+14

-0

Changes less more

1	1
2	2	File::Next does NOT use rt.cpan.org for bug tracking. Please report
3	3	problems at http://github.com/petdance/file-next/issues.
	4
	5	1.18 Tue Aug 27 17:08:38 CDT 2019
	6	[SPEEDUP]
	7	Updated the internals to minimize the number of times that stat()
	8	gets called on each file or directory.
	9
	10	[FIXES]
	11	t/from_file.t would fail under Windows because File::Temp would
	12	put a backslash in front of the name of the tempfile. Thanks,
	13	Varadinsky. (GH#32)
	14
	15	Had to specify a minimum version of File::Temp. Thanks, Justin Mohr.
	16	(GH#29)
	17
4	18
5	19	1.16 Thu Jul 7 22:41:30 CDT 2016
6	20	[FIXES]

-3

META.json less more

3	3	"Andy Lester <andy@petdance.com>"
4	4	],
5	5	"dynamic_config" : 1,
6		"generated_by" : "ExtUtils::MakeMaker version 7.18, CPAN::Meta::Converter version 2.143240",
	6	"generated_by" : "ExtUtils::MakeMaker version 7.24, CPAN::Meta::Converter version 2.150005",
7	7	"license" : [
8	8	"artistic_2"
9	9	],
10	10	"meta-spec" : {
11	11	"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
12		"version" : "2"
	12	"version" : 2
13	13	},
14	14	"name" : "File-Next",
15	15	"no_index" : {

31	31	},
32	32	"runtime" : {
33	33	"requires" : {
	34	"File::Copy" : "0",
34	35	"File::Spec" : "0",
	36	"File::Temp" : "0.22",
35	37	"Test::More" : "0.88"
36	38	}
37	39	}

48	50	"url" : "http://github.com/petdance/file-next/tree/master"
49	51	}
50	52	},
51		"version" : "1.16"
	53	"version" : "1.18",
	54	"x_serialization_backend" : "JSON::PP version 4.04"
52	55	}

-2

META.yml less more

6	6	configure_requires:
7	7	ExtUtils::MakeMaker: '0'
8	8	dynamic_config: 1
9		generated_by: 'ExtUtils::MakeMaker version 7.18, CPAN::Meta::Converter version 2.143240'
	9	generated_by: 'ExtUtils::MakeMaker version 7.24, CPAN::Meta::Converter version 2.150005'
10	10	license: artistic_2
11	11	meta-spec:
12	12	url: http://module-build.sourceforge.net/META-spec-v1.4.html

17	17	- t
18	18	- inc
19	19	requires:
	20	File::Copy: '0'
20	21	File::Spec: '0'
	22	File::Temp: '0.22'
21	23	Test::More: '0.88'
22	24	resources:
23	25	bugtracker: http://github.com/petdance/file-next/issues
24	26	license: http://dev.perl.org/licenses/
25	27	repository: http://github.com/petdance/file-next/tree/master
26		version: '1.16'
	28	version: '1.18'
	29	x_serialization_backend: 'CPAN::Meta::YAML version 0.018'

-0

Makefile.PL less more

14	14	LICENSE => 'artistic_2',
15	15	PREREQ_PM => {
16	16	'Test::More' => 0.88,
	17	'File::Copy' => 0,
17	18	'File::Spec' => 0,
	19	'File::Temp' => 0.22,
18	20	},
19	21	dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
20	22	clean => { FILES => 'File-Next-*' },

+43

-46

Next.pm less more

8	8
9	9	=head1 VERSION
10	10
11		Version 1.16
	11	Version 1.18
12	12
13	13	=cut
14	14
15		our $VERSION = '1.16';
	15	our $VERSION = '1.18';
16	16
17	17	=head1 SYNOPSIS
18	18
19	19	File::Next is a lightweight, taint-safe file-finding module.
20		It's lightweight and has no non-core prerequisites.
	20	It has no non-core prerequisites.
21	21
22	22	use File::Next;
23	23

261	261
262	262	my ($parms,@queue) = _setup( \%files_defaults, @_ );
263	263
	264	my $filter = $parms->{file_filter};
264	265	return sub {
265		my $filter = $parms->{file_filter};
266		while (@queue) {
267		my ($dirname,$file,$fullpath) = splice( @queue, 0, 3 );
268		if ( -f $fullpath \|\| -p _ \|\| $fullpath =~ m{^/dev/fd} ) {
	266	while ( my $entry = shift @queue ) {
	267	my ( $dirname, $file, $fullpath, $is_dir, $is_file, $is_fifo ) = @{$entry};
	268	if ( $is_file \|\| $is_fifo ) {
269	269	if ( $filter ) {
270	270	local $_ = $file;
271	271	local $File::Next::dir = $dirname;

274	274	}
275	275	return wantarray ? ($dirname,$file,$fullpath) : $fullpath;
276	276	}
277		if ( -d _ ) {
	277	if ( $is_dir ) {
278	278	unshift( @queue, _candidate_files( $parms, $fullpath ) );
279	279	}
280	280	} # while

290	290	my ($parms,@queue) = _setup( \%files_defaults, @_ );
291	291
292	292	return sub {
293		while (@queue) {
294		my (undef,undef,$fullpath) = splice( @queue, 0, 3 );
295		if ( -d $fullpath ) {
	293	while ( my $entry = shift @queue ) {
	294	my ( undef, undef, $fullpath, $is_dir, undef, undef ) = @{$entry};
	295	if ( $is_dir ) {
296	296	unshift( @queue, _candidate_files( $parms, $fullpath ) );
297	297	return $fullpath;
298	298	}

302	302	}; # iterator
303	303	}
304	304
	305
305	306	sub everything {
306	307	die _bad_invocation() if @_ && defined($_[0]) && ($_[0] eq __PACKAGE__);
307	308
308	309	my ($parms,@queue) = _setup( \%files_defaults, @_ );
309	310
	311	my $filter = $parms->{file_filter};
310	312	return sub {
311		my $filter = $parms->{file_filter};
312		while (@queue) {
313		my ($dirname,$file,$fullpath) = splice( @queue, 0, 3 );
314		if ( -d $fullpath ) {
	313	while ( my $entry = shift @queue ) {
	314	my ( $dirname, $file, $fullpath, $is_dir, $is_file, $is_fifo ) = @{$entry};
	315	if ( $is_dir ) {
315	316	unshift( @queue, _candidate_files( $parms, $fullpath ) );
316	317	}
317	318	if ( $filter ) {

334	335	my $err = $parms->{error_handler};
335	336	my $warn = $parms->{warning_handler};
336	337
337		my $filename = $queue[1];
	338	my $filename = $queue[0]->[1];
338	339
339	340	if ( !defined($filename) ) {
340	341	$err->( 'Must pass a filename to from_file()' );

352	353	}
353	354	}
354	355
	356	my $filter = $parms->{file_filter};
355	357	return sub {
356		my $filter = $parms->{file_filter};
357	358	local $/ = $parms->{nul_separated} ? "\x00" : $/;
358	359	while ( my $fullpath = <$fh> ) {
359	360	chomp $fullpath;

411	412	The queue prep stuff takes the strings in I<@starting_points> and
412	413	puts them in the format that queue needs.
413	414
414		The C<@queue> that gets passed around is an array that has three
415		elements for each of the entries in the queue: $dir, $file and
416		$fullpath. Items must be pushed and popped off the queue three at
417		a time (spliced, really).
	415	The C<@queue> that gets passed around is an array, with each entry an
	416	arrayref of $dir, $file and $fullpath.
418	417
419	418	=cut
420	419

433	432	}
434	433
435	434	# Any leftover keys are bogus
436		for my $badkey ( keys %passed_parms ) {
	435	for my $badkey ( sort keys %passed_parms ) {
437	436	my $sub = (caller(1))[3];
438	437	$parms->{error_handler}->( "Invalid option passed to $sub(): $badkey" );
439	438	}

446	445
447	446	for ( @_ ) {
448	447	my $start = reslash( $_ );
449		if (-d $start) {
450		push @queue, ($start,undef,$start);
451		}
452		else {
453		push @queue, (undef,$start,$start);
454		}
	448	my $is_dir = -d $start;
	449	my $is_file = -f _;
	450	my $is_fifo = (-p _) \|\| ($start =~ m{^/dev/fd});
	451	push @queue,
	452	$is_dir
	453	? [ $start, undef, $start, $is_dir, $is_file, $is_fifo ]
	454	: [ undef, $start, $start, $is_dir, $is_file, $is_fifo ];
455	455	}
456	456
457	457	return ($parms,@queue);

479	479	my @newfiles;
480	480	my $descend_filter = $parms->{descend_filter};
481	481	my $follow_symlinks = $parms->{follow_symlinks};
482		my $sort_sub = $parms->{sort_files};
483	482
484	483	for my $file ( grep { !exists $skip_dirs{$_} } readdir $dh ) {
485		my $has_stat;
486
487	484	my $fullpath = File::Spec->catdir( $dirname, $file );
488	485	if ( !$follow_symlinks ) {
489	486	next if -l $fullpath;
490		$has_stat = 1;
491	487	}
	488	else {
	489	stat($fullpath);
	490	}
	491	my $is_dir = -d _;
	492	my $is_file = -f _;
	493	my $is_fifo = (-p _) \|\| ($fullpath =~ m{^/dev/fd});
492	494
493	495	# Only do directory checking if we have a descend_filter
494	496	if ( $descend_filter ) {
495		if ( $has_stat ? (-d _) : (-d $fullpath) ) {
	497	if ( $is_dir ) {
496	498	local $File::Next::dir = $fullpath;
497	499	local $_ = $file;
498	500	next if not $descend_filter->();
499	501	}
500	502	}
501		if ( $sort_sub ) {
502		push( @newfiles, [ $dirname, $file, $fullpath ] );
503		}
504		else {
505		push( @newfiles, $dirname, $file, $fullpath );
506		}
	503	push @newfiles, [ $dirname, $file, $fullpath, $is_dir, $is_file, $is_fifo ];
507	504	}
508	505	closedir $dh;
509	506
	507	my $sort_sub = $parms->{sort_files};
510	508	if ( $sort_sub ) {
511		return map { @{$_} } sort $sort_sub @newfiles;
	509	@newfiles = sort $sort_sub @newfiles;
512	510	}
513	511
514	512	return @newfiles;
515	513	}
	514
516	515
517	516	=head1 DIAGNOSTICS
518	517

570	569
571	570	L<http://github.com/petdance/file-next/issues>
572	571
573		=item * AnnoCPAN: Annotated CPAN documentation
574
575		L<http://annocpan.org/dist/File-Next>
576
577	572	=item * CPAN Ratings
578	573
579	574	L<http://cpanratings.perl.org/d/File-Next>

593	588	All file-finding in this module is adapted from Mark Jason Dominus'
594	589	marvelous I<Higher Order Perl>, page 126.
595	590
596		Thanks also for bug fixes and typo finding to
	591	Thanks to these fine contributors:
	592	Varadinsky,
	593	Paulo Custodio,
597	594	Gerhard Poul,
598	595	Brian Fraser,
599	596	Todd Rinaldo,

604	601
605	602	=head1 COPYRIGHT & LICENSE
606	603
607		Copyright 2005-2016 Andy Lester.
	604	Copyright 2005-2017 Andy Lester.
608	605
609	606	This program is free software; you can redistribute it and/or modify
610	607	it under the terms of the Artistic License version 2.0.

-3

README.md less more

34	34	* Bug Tracker:
35	35	* http://github.com/petdance/file-next/issues
36	36
37		* AnnoCPAN, annotated CPAN documentation:
38		* http://annocpan.org/dist/File-Next
39
40	37	* CPAN Ratings:
41	38	* http://cpanratings.perl.org/d/File-Next
42	39

-2

perlcriticrc less more

12	12
13	13	[-ErrorHandling::RequireCarping]
14	14	[-ErrorHandling::RequireUseOfExceptions]
15
16		[-Miscellanea::RequireRcsKeywords]
17	15
18	16	[-Modules::RequireVersionVar]
19	17	[-Modules::RequirePerlVersion]

+32

-3

t/from_file.t less more

1	1
2	2	use strict;
3	3	use warnings;
4		use Test::More tests => 17;
	4	use Test::More tests => 22;
5	5
6	6	use lib 't';
7	7	use Util;

75	75	my $warn_called;
76	76	local $SIG{__WARN__} = sub { $warn_called = 1 };
77	77
78		my $tempfile = File::Temp->new;
	78	my $tempfile = File::Temp->new(TEMPLATE => 'XXXXXXXXXX');
79	79	File::Copy::copy('t/filelist.txt', $tempfile);
80	80	print {$tempfile} "t/non-existent-file.txt\n";
81	81	$tempfile->close;

93	93	my $warn_called;
94	94	local $SIG{__WARN__} = sub { $warn_called = 1 };
95	95
96		my $tempfile = File::Temp->new;
	96	my $tempfile = File::Temp->new(TEMPLATE => 'XXXXXXXXXX');
97	97	File::Copy::copy('t/filelist.txt', $tempfile);
98	98	print {$tempfile} "t/non-existent-file.txt\n";
99	99	$tempfile->close;

110	110	ok(!$warn_called, 'CORE::warn() should be not called if a warning occurs but a warning_handler is set');
111	111	ok($warning_handler_called, 'The set warning handler should be called if a warning occurs');
112	112	}
	113
	114
	115	FROM_MISSING_FILE_WITH_ERROR_HANDLER: {
	116	my $error_handler_message;
	117	my $error_handler = sub { $error_handler_message = shift; };
	118	my $iter = File::Next::from_file( { error_handler => $error_handler }, 'flargle-bargle.txt' );
	119
	120	ok( !defined($iter), 'Iterator should be null' );
	121	like( $error_handler_message, qr/\QUnable to open flargle-bargle.txt/, "Proper error message" );
	122	}
	123
	124
	125	FROM_OK_FILE_BUT_MISSING_WITH_WARNING_HANDLER: {
	126	my $warning_handler_message;
	127	my $warning_handler = sub { $warning_handler_message = shift; };
	128
	129	my $tempfile = File::Temp->new(TEMPLATE => 'XXXXXXXXXX');
	130	File::Copy::copy('t/filelist.txt', $tempfile);
	131	print {$tempfile} "t/non-existent-file.txt\n";
	132	$tempfile->close;
	133
	134	my $iter = File::Next::from_file( { warning_handler => $warning_handler }, $tempfile->filename );
	135	isa_ok( $iter, 'CODE' );
	136
	137	my @actual = slurp( $iter );
	138	sets_match( \@actual, \@expected, 'FROM_FILESYSTEM_FILE' );
	139
	140	like( $warning_handler_message, qr/\Qt\/non-existent-file.txt/, "Proper warning message" );
	141	}