File-Next-1.12/0000755000076400007640000000000012065422323011707 5ustar andyandyFile-Next-1.12/perlcriticrc0000644000076400007640000000143511752020444014322 0ustar andyandy[-CodeLayout::ProhibitParensWithBuiltins] [CodeLayout::ProhibitHardTabs] allow_leading_tabs = 0 [-CodeLayout::RequireTidyCode] [-ControlStructures::ProhibitPostfixControls] [-Documentation::RequirePodAtEnd] [-Documentation::RequirePodLinksIncludeText] [-Documentation::RequirePodSections] [-ErrorHandling::RequireCarping] [-Miscellanea::RequireRcsKeywords] [-Modules::RequireVersionVar] [-RegularExpressions::RequireDotMatchAnything] [-RegularExpressions::RequireExtendedFormatting] [-RegularExpressions::RequireLineBoundaryMatching] [-ValuesAndExpressions::ProhibitConstantPragma] [-ValuesAndExpressions::ProhibitEmptyQuotes] [-ValuesAndExpressions::ProhibitNoisyQuotes] [-Variables::ProhibitPunctuationVars] [-Variables::ProhibitPackageVars] # The API for File::Next is all package vars File-Next-1.12/MANIFEST0000644000076400007640000000147012065422323013042 0ustar andyandyREADME.md Changes MANIFEST Makefile.PL Next.pm perlcriticrc t/00-load.t t/api.t t/basic.t t/dirs.t t/dot.t t/everything.t t/filelist.txt t/filelist-nul.txt t/first-and-last-lines-via-process-pipe.pl t/follow.t t/from_file.t t/from_stdin.t t/methods.t t/named-pipe.t t/parms.t t/pod-coverage.t t/pod.t t/sort.t t/stdin-iterator.pl t/zero.t t/Util.pm t/swamp/0 t/swamp/Makefile t/swamp/Makefile.PL t/swamp/c-header.h t/swamp/c-source.c t/swamp/javascript.js t/swamp/parrot.pir t/swamp/perl-test.t t/swamp/perl-without-extension t/swamp/perl.pl t/swamp/perl.pm t/swamp/perl.pod t/swamp/a/a1 t/swamp/a/a2 t/swamp/b/b1 t/swamp/b/b2 t/swamp/c/c1 t/swamp/c/c2 META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) File-Next-1.12/Makefile.PL0000644000076400007640000000304412065416203013662 0ustar andyandypackage main; use 5.006001; use strict; use warnings; use ExtUtils::MakeMaker; my %parms = ( NAME => 'File::Next', AUTHOR => 'Andy Lester ', ## no critic (RequireInterpolationOfMetachars) VERSION_FROM => 'Next.pm', ABSTRACT_FROM => 'Next.pm', PL_FILES => {}, PREREQ_PM => { 'Test::More' => 0.88, 'File::Spec' => 0, }, dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, clean => { FILES => 'File-Next-*' }, ); if ( $ExtUtils::MakeMaker::VERSION =~ /^\d\.\d\d$/ and $ExtUtils::MakeMaker::VERSION > 6.30 ) { $parms{LICENSE} = 'perl'; } if ( $ExtUtils::MakeMaker::VERSION ge '6.46' ) { $parms{META_MERGE} = { resources => { bugtracker => 'http://github.com/petdance/file-next/issues', repository => 'http://github.com/petdance/file-next/tree/master', license => 'http://dev.perl.org/licenses/', } }; } WriteMakefile( %parms ); sub MY::postamble { return <<'MAKE_FRAG'; .PHONY: tags critic tags: ctags -f tags --recurse --totals \ --exclude=blib \ --exclude=.git \ --exclude=.svn \ --exclude='*~' \ --languages=Perl --langmap=Perl:+.t \ critic: perlcritic -profile perlcriticrc -1 -quiet *.pm t/*.t TARGET_DIRS=~/parrot /usr/local/minicpan ~/bin prof: all perl -d:DProf -Mblib ./stress $(TARGET_DIRS) > /dev/null dprofpp -R nytprof: all perl -d:NYTProf -Mblib ./stress $(TARGET_DIRS) > /dev/null nytprofhtml MAKE_FRAG } 1; File-Next-1.12/t/0000755000076400007640000000000012065422323012152 5ustar andyandyFile-Next-1.12/t/everything.t0000644000076400007640000000351511765533520014537 0ustar andyandy#!perl -T use strict; use warnings; use Test::More tests => 4; use lib 't'; use Util; use File::Next; NO_PARMS: { my $iter = File::Next::everything( 't/' ); isa_ok( $iter, 'CODE' ); my @actual = slurp( $iter ); my @expected = qw( t/ t/00-load.t t/api.t t/basic.t t/dirs.t t/dot.t t/everything.t t/filelist.txt t/filelist-nul.txt t/first-and-last-lines-via-process-pipe.pl t/follow.t t/from_file.t t/from_stdin.t t/methods.t t/named-pipe.t t/parms.t t/pod-coverage.t t/pod.t t/sort.t t/stdin-iterator.pl t/swamp t/swamp/0 t/swamp/a t/swamp/a/a1 t/swamp/a/a2 t/swamp/b t/swamp/b/b1 t/swamp/b/b2 t/swamp/c t/swamp/c/c1 t/swamp/c/c2 t/swamp/c-header.h t/swamp/c-source.c t/swamp/javascript.js t/swamp/Makefile t/swamp/Makefile.PL t/swamp/parrot.pir t/swamp/perl-test.t t/swamp/perl-without-extension t/swamp/perl.pl t/swamp/perl.pm t/swamp/perl.pod t/Util.pm t/zero.t ); sets_match( \@actual, \@expected, 'NO_PARMS' ); } FILTERED: { my $file_filter = sub { # Arbitrary filter: "z" anywhere, ends in "b" or digit return $File::Next::name =~ /(z|b$|\d$)/; }; my $iter = File::Next::everything( {file_filter => $file_filter}, 't/' ); isa_ok( $iter, 'CODE' ); my @actual = slurp( $iter ); my @expected = qw( t/swamp/0 t/swamp/a/a1 t/swamp/a/a2 t/swamp/b t/swamp/b/b1 t/swamp/b/b2 t/swamp/c/c1 t/swamp/c/c2 t/zero.t ); sets_match( \@actual, \@expected, 'NO_PARMS' ); } File-Next-1.12/t/parms.t0000644000076400007640000000360711756321774013505 0ustar andyandy#!perl -T use strict; use warnings; use Test::More tests => 10; use File::Next; BAD_PARMS_CAUGHT: { my @errors; sub error_catcher { my $error = shift; push( @errors, $error ); return; } my $iter = File::Next::files( { error_handler => \&error_catcher, wango => 'ze tango', }, 't/pod.t' ); is( scalar @errors, 1, 'Caught one error' ); like( $errors[0], qr/Invalid.+files.+wango/, 'And it looks reasonable' ); } BAD_PARMS_UNCAUGHT: { my $bad_iterator = eval { my $iter = File::Next::dirs( { wango => 'ze tango', }, 't/pod.t' ); }; ok( !defined($bad_iterator), 'Constructor fails with bad parameters' ); like( $@, qr/Invalid.+dirs.+wango/, 'And it looks reasonable' ); } FILES_AS_METHOD: { my $bad_iterator = eval { my $iter = File::Next->files( { wango => 'ze tango', }, 't/pod.t' ); }; ok( !defined($bad_iterator), 'Constructor fails with bad parameters' ); like( $@, qr/File::Next::files must not be invoked as File::Next->files/, 'And it looks reasonable' ); } DIRS_AS_METHOD: { my $bad_iterator = eval { my $iter = File::Next->dirs( { wango => 'ze tango', }, 't/pod.t' ); }; ok( !defined($bad_iterator), 'Constructor fails with bad parameters' ); like( $@, qr/File::Next::dirs must not be invoked as File::Next->dirs/, 'And it looks reasonable' ); } EVERYTHING_AS_METHOD: { my $bad_iterator = eval { my $iter = File::Next->everything( { wango => 'ze tango', }, 't/pod.t' ); }; ok( !defined($bad_iterator), 'Constructor fails with bad parameters' ); like( $@, qr/File::Next::everything must not be invoked as File::Next->everything/, 'And it looks reasonable' ); } File-Next-1.12/t/pod-coverage.t0000644000076400007640000000040311752017525014715 0ustar andyandy#!perl -T use strict; use warnings; use Test::More; my $module = 'Test::Pod::Coverage 1.04'; if ( eval "use $module; 1;" ) { ## no critic (ProhibitStringyEval) all_pod_coverage_ok(); } else { plan skip_all => "$module required for testing POD"; } File-Next-1.12/t/Util.pm0000644000076400007640000000130011756331533013427 0ustar andyandypackage main; use File::Next; sub slurp { my $iter = shift; my @files; while ( defined ( my $file = $iter->() ) ) { push( @files, $file ); } return @files; } sub sets_match { my @actual = @{+shift}; my @expected = @{+shift}; my $msg = shift; # Normalize all the paths for my $path ( @expected, @actual ) { $path = File::Next::reslash( $path ); } local $Test::Builder::Level = $Test::Builder::Level + 1; ## no critic eval 'use Test::Differences'; if ( !$@ ) { return eq_or_diff( [sort @actual], [sort @expected], $msg ); } else { return is_deeply( [sort @actual], [sort @expected], $msg ); } } 1; File-Next-1.12/t/swamp/0000755000076400007640000000000012065422323013301 5ustar andyandyFile-Next-1.12/t/swamp/perl.pm0000644000076400007640000000024311752021114014573 0ustar andyandy#!perl -T use warnings; use strict; use Test::More tests => 1; BEGIN { use_ok( 'App::Ack' ); } diag( "Testing App::Ack $App::Ack::VERSION, Perl $], $^X" ); File-Next-1.12/t/swamp/parrot.pir0000644000076400007640000000266511752017525015343 0ustar andyandy=head1 INFORMATION This example shows the usage of C. =head1 FUNCTIONS =over 4 =item _main =cut .sub _main :main .local pmc stream load_bytecode "library/Stream/Sub.pir" load_bytecode "library/Stream/Replay.pir" find_type $I0, "Stream::Sub" new $P0, $I0 # set the stream's source sub .const .Sub temp = "_hello" assign $P0, $P1 find_type $I0,"Stream::Replay" stream = new $I0 assign stream, $P0 $S0 = stream."read_bytes"( 3 ) print "'hel': [" print $S0 print "]\n" stream = clone stream $P0 = clone stream $S0 = stream."read_bytes"( 4 ) print "'lowo': [" print $S0 print "] = " $S0 = $P0."read_bytes"( 4 ) print "[" print $S0 print "]\n" $S0 = stream."read"() print "'rld!': [" print $S0 print "]\n" $S0 = stream."read_bytes"( 100 ) print "'parrotis cool': [" print $S0 print "]\n" end .end =item _hello This sub is used as the source for the stream. It just writes some text to the stream. =cut .sub _hello :method self."write"( "hello" ) self."write"( "world!" ) self."write"( "parrot" ) self."write"( "is cool" ) .end =back =head1 AUTHOR Jens Rieks Eparrot at jensbeimsurfen dot deE is the author and maintainer. Please send patches and suggestions to the Perl 6 Internals mailing list. =head1 COPYRIGHT Copyright (C) 2004, The Perl Foundation. =cut File-Next-1.12/t/swamp/00000644000076400007640000000017211752017525013371 0ustar andyandy#!/usr/bin/perl -w print "Every Perl programmer knows that 0 evaluates to false, and that it is a recipe for DANGER!\n"; File-Next-1.12/t/swamp/c-header.h0000644000076400007640000000052411752017525015131 0ustar andyandy/* perl.h * * Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, * 2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. * */ #ifndef H_PERL #define H_PERL 1 File-Next-1.12/t/swamp/perl-without-extension0000644000076400007640000000014111752017525017703 0ustar andyandy#!/usr/bin/perl -w use warnings; use strict; print "I'm a Perl program without an extension\n"; File-Next-1.12/t/swamp/c/0000755000076400007640000000000012065422323013523 5ustar andyandyFile-Next-1.12/t/swamp/c/c10000644000076400007640000000000011752017525013745 0ustar andyandyFile-Next-1.12/t/swamp/c/c20000644000076400007640000000000011752017525013746 0ustar andyandyFile-Next-1.12/t/swamp/Makefile0000644000076400007640000000156011752017525014751 0ustar andyandy# This Makefile is for the ack extension to perl. # # It was generated automatically by MakeMaker version # 6.30 (Revision: Revision: 4535 ) from the contents of # Makefile.PL. Don't edit this file, edit Makefile.PL instead. # # ANY CHANGES MADE HERE WILL BE LOST! # # MakeMaker ARGV: () # # MakeMaker Parameters: # ABSTRACT => q[A grep-like program specifically for large source trees] # AUTHOR => q[Andy Lester ] # EXE_FILES => [q[ack]] # MAN3PODS => { } # NAME => q[ack] # PM => { Ack.pm=>q[$(INST_LIBDIR)/App/Ack.pm] } # PREREQ_PM => { Test::More=>q[0], Getopt::Long=>q[0], Term::ANSIColor=>q[0] } # VERSION_FROM => q[Ack.pm] # clean => { FILES=>q[ack-*] } # dist => { COMPRESS=>q[gzip -9f], SUFFIX=>q[gz] } There's not really anything here. It's just to have something that starts out like a makefile. File-Next-1.12/t/swamp/perl.pod0000644000076400007640000000024311752021121014737 0ustar andyandy#!perl -T use warnings; use strict; use Test::More tests => 1; BEGIN { use_ok( 'App::Ack' ); } diag( "Testing App::Ack $App::Ack::VERSION, Perl $], $^X" ); File-Next-1.12/t/swamp/perl.pl0000644000076400007640000000024311752021113014571 0ustar andyandy#!perl -T use warnings; use strict; use Test::More tests => 1; BEGIN { use_ok( 'App::Ack' ); } diag( "Testing App::Ack $App::Ack::VERSION, Perl $], $^X" ); File-Next-1.12/t/swamp/Makefile.PL0000644000076400007640000000024311752021111015242 0ustar andyandy#!perl -T use warnings; use strict; use Test::More tests => 1; BEGIN { use_ok( 'App::Ack' ); } diag( "Testing App::Ack $App::Ack::VERSION, Perl $], $^X" ); File-Next-1.12/t/swamp/c-source.c0000644000076400007640000000330011752017525015167 0ustar andyandy/* A Bison parser, made from plural.y by GNU Bison version 1.28 */ #define YYBISON 1 /* Identify Bison output. */ #define yyparse __gettextparse #define yylex __gettextlex #define yyerror __gettexterror #define yylval __gettextlval #define yychar __gettextchar #define yydebug __gettextdebug #define yynerrs __gettextnerrs #define EQUOP2 257 #define CMPOP2 258 #define ADDOP2 259 #define MULOP2 260 #define NUMBER 261 #line 1 "plural.y" /* Expression parsing for plural form selection. Copyright (C) 2000, 2001 Free Software Foundation, Inc. Written by Ulrich Drepper , 2000. This program is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ /* The bison generated parser uses alloca. AIX 3 forces us to put this declaration at the beginning of the file. The declaration in bison's skeleton file comes too late. This must come before because may include arbitrary system headers. */ static void yyerror (str) const char *str; { /* Do nothing. We don't print error messages here. */ } File-Next-1.12/t/swamp/a/0000755000076400007640000000000012065422323013521 5ustar andyandyFile-Next-1.12/t/swamp/a/a20000644000076400007640000000000011752017525013742 0ustar andyandyFile-Next-1.12/t/swamp/a/a10000644000076400007640000000000011752017525013741 0ustar andyandyFile-Next-1.12/t/swamp/perl-test.t0000644000076400007640000000024311752021112015375 0ustar andyandy#!perl -T use warnings; use strict; use Test::More tests => 1; BEGIN { use_ok( 'App::Ack' ); } diag( "Testing App::Ack $App::Ack::VERSION, Perl $], $^X" ); File-Next-1.12/t/swamp/javascript.js0000644000076400007640000000016611752017525016016 0ustar andyandy// JavaScript goodness // Files and directory structures var cssDir = "./Stylesheets/"; var NS4CSS = "wango.css"; File-Next-1.12/t/swamp/b/0000755000076400007640000000000012065422323013522 5ustar andyandyFile-Next-1.12/t/swamp/b/b10000644000076400007640000000000011752017525013743 0ustar andyandyFile-Next-1.12/t/swamp/b/b20000644000076400007640000000000011752017525013744 0ustar andyandyFile-Next-1.12/t/stdin-iterator.pl0000644000076400007640000000031711756330115015463 0ustar andyandy#!/usr/bin/env perl use strict; use warnings; use File::Next; my $nul = shift; my $iter = File::Next::from_file( { nul_separated => $nul }, '-' ); while ( my $file = $iter->() ) { print "$file\n"; } File-Next-1.12/t/filelist-nul.txt0000644000076400007640000000027411765533520015335 0ustar andyandyt/00-load.tt/api.tt/basic.tt/dirs.tt/dot.tt/everything.tt/follow.tt/from_file.tt/methods.tt/named-pipe.tt/parms.tt/pod-coverage.tt/pod.tt/sort.tt/swamp/perl-test.tt/zero.t File-Next-1.12/t/methods.t0000644000076400007640000000175611752022334014013 0ustar andyandy#!perl -T use strict; use warnings; use Test::More tests => 6; use lib 't'; use Util; use File::Next; EVERYTHING: { my $iter; my $rc = eval { $iter = File::Next->everything( 't/' ); }; ok( !defined($rc), 'Calling everything as method should fail' ); $rc = eval { $iter = File::Next::everything( 't/' ); }; ok( defined($rc), 'Calling everything as function should pass' ); } FILES: { my $iter; my $rc = eval { $iter = File::Next->files( 't/' ); }; ok( !defined($rc), 'Calling files as method should fail' ); $rc = eval { $iter = File::Next::files( 't/' ); }; ok( defined($rc), 'Calling files as function should pass' ); } DIRS: { my $iter; my $rc = eval { $iter = File::Next->dirs( 't/' ); }; ok( !defined($rc), 'Calling dirs as method should fail' ); $rc = eval { $iter = File::Next::dirs( 't/' ); }; ok( defined($rc), 'Calling dirs as function should pass' ); } File-Next-1.12/t/00-load.t0000644000076400007640000000026611752022334013477 0ustar andyandy#!perl -T use strict; use warnings; use Test::More tests => 1; use File::Next; diag( "Testing File::Next $File::Next::VERSION, Perl $], $^X" ); pass( 'All modules loaded OK.' ); File-Next-1.12/t/from_stdin.t0000644000076400007640000000150111765533520014510 0ustar andyandy#!perl use strict; use warnings; use Test::More tests => 2; use lib 't'; use Util; my $CAT = "$^X -pe1"; my @expected = qw( t/00-load.t t/api.t t/basic.t t/dirs.t t/dot.t t/everything.t t/follow.t t/from_file.t t/methods.t t/named-pipe.t t/parms.t t/pod-coverage.t t/pod.t t/sort.t t/swamp/perl-test.t t/zero.t ); FROM_STDIN: { # Pipe stuff into the iterator my @actual = `$CAT t/filelist.txt | $^X -Mblib t/stdin-iterator.pl`; chomp @actual; sets_match( \@actual, \@expected, 'FROM_STDIN' ); } FROM_STDIN_NUL: { # Pipe nul-separated stuff into the iterator that handles nul-separated my @actual = `$CAT t/filelist-nul.txt | $^X -Mblib t/stdin-iterator.pl 1`; chomp @actual; sets_match( \@actual, \@expected, 'FROM_STDIN_NUL' ); } File-Next-1.12/t/api.t0000644000076400007640000000257711752022334013123 0ustar andyandy#!perl -T use strict; use warnings; use Test::More tests => 17; use File::Next; CHECK_FILE_FILTER: { my $file_filter = sub { ok( defined $_, '$_ defined' ); is( $File::Next::dir, File::Next::reslash( 't/swamp' ), '$File::Next::dir correct in $file_filter' ); is( $File::Next::name, File::Next::reslash( "t/swamp/$_" ), '$File::Next::name is correct' ); }; my $iter = File::Next::files( { file_filter => $file_filter, sort_files => \&File::Next::sort_reverse, }, 't/swamp' ); isa_ok( $iter, 'CODE' ); # Return filename in scalar mode my $file = $iter->(); my $swamp = File::Next::reslash( 't/swamp' ); like( $file, qr{^\Q$swamp\E.+}, 'swamp filename returned' ); # Return $dir and $file in list mode my $dir; ($dir,$file) = $iter->(); is( $dir, $swamp, 'Correct $dir' ); unlike( $file, qr{/\\:}, '$file should not have any slashes, backslashes or other pathy things' ); } CHECK_DESCEND_FILTER: { my $swamp = File::Next::reslash( 't/swamp' ); my $descend_filter = sub { ok( defined $_, '$_ defined' ); like( $File::Next::dir, qr{^\Q$swamp}, '$File::Next::dir in $descend_filter' ); }; my $iter = File::Next::files( {descend_filter => $descend_filter}, $swamp ); isa_ok( $iter, 'CODE' ); while ( $iter->() ) { # Do nothing, just calling the descend } } File-Next-1.12/t/first-and-last-lines-via-process-pipe.pl0000644000076400007640000000045411765533520021646 0ustar andyandy#!/usr/bin/env perl use strict; use warnings; use File::Next; my ( $input ) = @ARGV; my $files = File::Next::files( $input ); my $file = $files->(); if ( open my $f, '<', $file ) { my @lines = <$f>; print $lines[0]; print $lines[-1]; close $f; exit 0; } else { exit 1; } File-Next-1.12/t/basic.t0000644000076400007640000000504711752022334013426 0ustar andyandy#!perl -T use strict; use warnings; use Test::More tests => 10; use lib 't'; use Util; use File::Next; # use Test::Differences; # eq_or_diff \@got, [qw( a b c )], "testing arrays"; JUST_A_FILE: { my $iter = File::Next::files( 't/pod.t' ); isa_ok( $iter, 'CODE' ); my @actual = slurp( $iter ); my @expected = qw( t/pod.t ); sets_match( \@actual, \@expected, 'JUST_A_FILE' ); } NO_PARMS: { my $iter = File::Next::files( 't/swamp' ); isa_ok( $iter, 'CODE' ); my @actual = slurp( $iter ); my @expected = qw( t/swamp/0 t/swamp/Makefile t/swamp/Makefile.PL t/swamp/c-header.h t/swamp/c-source.c t/swamp/javascript.js t/swamp/parrot.pir t/swamp/perl-test.t t/swamp/perl-without-extension t/swamp/perl.pl t/swamp/perl.pm t/swamp/perl.pod t/swamp/a/a1 t/swamp/a/a2 t/swamp/b/b1 t/swamp/b/b2 t/swamp/c/c1 t/swamp/c/c2 ); sets_match( \@actual, \@expected, 'NO_PARMS' ); } MULTIPLE_STARTS: { my $iter = File::Next::files( 't/swamp/a', 't/swamp/b', 't/swamp/c' ); isa_ok( $iter, 'CODE' ); my @actual = slurp( $iter ); my @expected = qw( t/swamp/a/a1 t/swamp/a/a2 t/swamp/b/b1 t/swamp/b/b2 t/swamp/c/c1 t/swamp/c/c2 ); sets_match( \@actual, \@expected, 'MULTIPLE_STARTS' ); } NO_DESCEND: { my $iter = File::Next::files( {descend_filter => sub {0}}, 't/swamp' ); isa_ok( $iter, 'CODE' ); my @actual = slurp( $iter ); my @expected = qw( t/swamp/0 t/swamp/Makefile t/swamp/Makefile.PL t/swamp/c-header.h t/swamp/c-source.c t/swamp/javascript.js t/swamp/parrot.pir t/swamp/perl-test.t t/swamp/perl-without-extension t/swamp/perl.pl t/swamp/perl.pm t/swamp/perl.pod ); sets_match( \@actual, \@expected, 'NO_DESCEND' ); } ONLY_FILES_WITH_AN_EXTENSION: { my $file_filter = sub { return /^[^.].*\./; }; my $iter = File::Next::files( {file_filter => $file_filter}, 't/swamp' ); isa_ok( $iter, 'CODE' ); my @actual = slurp( $iter ); my @expected = qw( t/swamp/Makefile.PL t/swamp/c-header.h t/swamp/c-source.c t/swamp/javascript.js t/swamp/parrot.pir t/swamp/perl-test.t t/swamp/perl.pl t/swamp/perl.pm t/swamp/perl.pod ); sets_match( \@actual, \@expected, 'ONLY_FILES_WITH_AN_EXTENSION' ); } File-Next-1.12/t/filelist.txt0000644000076400007640000000027311765533520014540 0ustar andyandyt/00-load.t t/api.t t/basic.t t/dirs.t t/dot.t t/everything.t t/follow.t t/from_file.t t/methods.t t/named-pipe.t t/parms.t t/pod-coverage.t t/pod.t t/sort.t t/swamp/perl-test.t t/zero.t File-Next-1.12/t/from_file.t0000644000076400007640000000272711765533520014321 0ustar andyandy#!perl -T use strict; use warnings; use Test::More tests => 10; use lib 't'; use Util; use File::Next; # use Test::Differences; # eq_or_diff \@got, [qw( a b c )], "testing arrays"; my @expected = qw( t/00-load.t t/api.t t/basic.t t/dirs.t t/dot.t t/everything.t t/follow.t t/from_file.t t/methods.t t/named-pipe.t t/parms.t t/pod-coverage.t t/pod.t t/sort.t t/swamp/perl-test.t t/zero.t ); FROM_FILESYSTEM_FILE: { my $iter = File::Next::from_file( 't/filelist.txt' ); isa_ok( $iter, 'CODE' ); my @actual = slurp( $iter ); sets_match( \@actual, \@expected, 'FROM_FILESYSTEM_FILE' ); } FROM_NUL_FILE: { my $iter = File::Next::from_file( { nul_separated => 1 }, 't/filelist-nul.txt' ); isa_ok( $iter, 'CODE' ); my @actual = slurp( $iter ); sets_match( \@actual, \@expected, 'FROM_NUL_FILE' ); } FROM_UNSPECIFIED_FILE: { my $iter; my $rc = eval { $iter = File::Next::from_file(); }; like( $@, qr/Must pass a filename to from_file/, 'Proper error message' ); ok( !defined($iter), 'Iterator should be null' ); ok( !defined($rc), 'Eval should fail' ); } FROM_MISSING_FILE: { my $iter; my $rc = eval { $iter = File::Next::from_file( 'flargle-bargle.txt' ); }; like( $@, qr/\QUnable to open flargle-bargle.txt/, 'Proper error message' ); ok( !defined($iter), 'Iterator should be null' ); ok( !defined($rc), 'Eval should fail' ); } File-Next-1.12/t/dot.t0000644000076400007640000000220111765533520013130 0ustar andyandy#!perl -T use strict; use warnings; use Test::More tests => 2; use lib 't'; use Util; use File::Next; NO_PARMS: { chdir( 't' ); my $iter = File::Next::files( '.' ); isa_ok( $iter, 'CODE' ); my @actual = slurp( $iter ); my @expected = qw( 00-load.t api.t basic.t dirs.t dot.t everything.t filelist.txt filelist-nul.txt first-and-last-lines-via-process-pipe.pl follow.t from_file.t from_stdin.t methods.t named-pipe.t parms.t pod-coverage.t pod.t sort.t stdin-iterator.pl Util.pm zero.t swamp/a/a1 swamp/a/a2 swamp/b/b1 swamp/b/b2 swamp/c/c1 swamp/c/c2 swamp/c-header.h swamp/c-source.c swamp/javascript.js swamp/0 swamp/Makefile swamp/Makefile.PL swamp/parrot.pir swamp/perl-test.t swamp/perl-without-extension swamp/perl.pl swamp/perl.pm swamp/perl.pod ); sets_match( \@actual, \@expected, 'NO_PARMS' ); } File-Next-1.12/t/zero.t0000644000076400007640000000136511752022334013323 0ustar andyandy#!perl -T use strict; use warnings; use Test::More tests => 2; use lib 't'; use Util; use File::Next; # NOTE! This block does a chdir. If you add more tests after it, you # may be sorry. HANDLE_ZEROES: { chdir 't/swamp' or die "chdir failed: $!"; my $iter = File::Next::files( '.' ); isa_ok( $iter, 'CODE' ); my @actual = slurp( $iter ); my @expected = qw( 0 a/a1 a/a2 b/b1 b/b2 c/c1 c/c2 c-header.h c-source.c javascript.js Makefile Makefile.PL parrot.pir perl-test.t perl-without-extension perl.pl perl.pm perl.pod ); sets_match( \@actual, \@expected, 'HANDLE_ZEROES' ); } File-Next-1.12/t/follow.t0000644000076400007640000000334411752022334013645 0ustar andyandy#!perl use strict; use warnings; use Test::More; use lib 't'; use Util; use File::Next; if ( ! eval { symlink('',''); 1 } ) { plan skip_all => 'System does not support symlinks.'; } plan tests => 6; my %links = ( 't/swamp/linkfile' => 'Makefile', 't/swamp/linkdir' => 'a', ); for my $link ( sort keys %links ) { my $file = $links{$link}; unlink( $link ); symlink( $file, $link ) or die "Unable to create symlink $file: $!"; } my @realfiles = qw( t/swamp/0 t/swamp/Makefile t/swamp/Makefile.PL t/swamp/c-header.h t/swamp/c-source.c t/swamp/javascript.js t/swamp/parrot.pir t/swamp/perl-test.t t/swamp/perl-without-extension t/swamp/perl.pl t/swamp/perl.pm t/swamp/perl.pod t/swamp/a/a1 t/swamp/a/a2 t/swamp/b/b1 t/swamp/b/b2 t/swamp/c/c1 t/swamp/c/c2 ); my @symlinkage = qw( t/swamp/linkfile t/swamp/linkdir/a1 t/swamp/linkdir/a2 ); DEFAULT: { my $iter = File::Next::files( 't/swamp' ); isa_ok( $iter, 'CODE' ); my @actual = slurp( $iter ); my @expected = ( @realfiles, @symlinkage ); sets_match( \@actual, \@expected, 'DEFAULT' ); } NO_FOLLOW: { my $iter = File::Next::files( { follow_symlinks => 0 }, 't/swamp' ); isa_ok( $iter, 'CODE' ); my @actual = slurp( $iter ); my @expected = ( @realfiles ); sets_match( \@actual, \@expected, 'NO_FOLLOW' ); } NO_FOLLOW_STARTING_WITH_A_SYMLINK: { my $iter = File::Next::files( { follow_symlinks => 0 }, 't/swamp/linkdir' ); isa_ok( $iter, 'CODE' ); my @actual = slurp( $iter ); my @expected = grep { /linkdir/ } @symlinkage; sets_match( \@actual, \@expected, 'NO_FOLLOW_STARTING_WITH_A_SYMLINK' ); } END { unlink( keys %links ); } File-Next-1.12/t/sort.t0000644000076400007640000000241711752022334013332 0ustar andyandy#!perl -T use strict; use warnings; use Test::More tests => 6; use lib 't'; use Util; use File::Next; my @sorted_swamp = qw( t/swamp/0 t/swamp/Makefile t/swamp/Makefile.PL t/swamp/a/a1 t/swamp/a/a2 t/swamp/b/b1 t/swamp/b/b2 t/swamp/c/c1 t/swamp/c/c2 t/swamp/c-header.h t/swamp/c-source.c t/swamp/javascript.js t/swamp/parrot.pir t/swamp/perl-test.t t/swamp/perl-without-extension t/swamp/perl.pl t/swamp/perl.pm t/swamp/perl.pod ); SORT_BOOLEAN: { my $iter = File::Next::files( { sort_files => 1 }, 't/swamp' ); isa_ok( $iter, 'CODE' ); my @actual = slurp( $iter ); my @expected = @sorted_swamp; sets_match( \@actual, \@expected, 'SORT_BOOLEAN' ); } SORT_STANDARD: { my $iter = File::Next::files( { sort_files => \&File::Next::sort_standard }, 't/swamp' ); isa_ok( $iter, 'CODE' ); my @actual = slurp( $iter ); my @expected = @sorted_swamp; sets_match( \@actual, \@expected, 'SORT_STANDARD' ); } SORT_REVERSE: { my $iter = File::Next::files( { sort_files => \&File::Next::sort_reverse }, 't/swamp' ); isa_ok( $iter, 'CODE' ); my @actual = slurp( $iter ); my @expected = reverse @sorted_swamp; sets_match( \@actual, \@expected, 'SORT_REVERSE' ); } File-Next-1.12/t/dirs.t0000644000076400007640000000061111752022334013276 0ustar andyandy#!perl -T use strict; use warnings; use Test::More tests => 2; use lib 't'; use Util; use File::Next; NO_PARMS: { my $iter = File::Next::dirs( 't/' ); isa_ok( $iter, 'CODE' ); my @actual = slurp( $iter ); my @expected = qw( t/ t/swamp/ t/swamp/a/ t/swamp/b/ t/swamp/c/ ); sets_match( \@actual, \@expected, 'NO_PARMS' ); } File-Next-1.12/t/named-pipe.t0000644000076400007640000000161111765533520014365 0ustar andyandy#!perl use strict; use warnings; use Test::More; plan skip_all => q{Windows doesn't have named pipes} if $^O =~ /MSWin32/; plan tests => 4; use POSIX (); my $pipename = POSIX::tmpnam(); POSIX::mkfifo $pipename, 0666; my $pid = fork(); if ( $pid == 0 ) { open my $fifo, '>', $pipename or die "Couldn't create named pipe $pipename: $!"; open my $f, '<', 'Changes' or die "Couldn't open Changes: $!"; while (my $line = <$f>) { print {$fifo} $line; } close $fifo; close $f; exit 0; } my @output = qx{$^X -Mblib t/first-and-last-lines-via-process-pipe.pl $pipename}; is( $?, 0, 'No errors in executing our little named pipe tester' ); unlink $pipename; chomp @output; is( scalar @output, 2, 'Get exactly 2 lines back' ); is( $output[0], 'Revision history for File-Next' ); is( $output[-1], ' First version, released on an unsuspecting world.' ); done_testing(); File-Next-1.12/t/pod.t0000644000076400007640000000036611752017525013134 0ustar andyandy#!perl -T use strict; use warnings; use Test::More; my $module = 'Test::Pod 1.14'; if ( eval "use $module; 1;" ) { ## no critic (ProhibitStringyEval) all_pod_files_ok(); } else { plan skip_all => "$module required for testing POD"; } File-Next-1.12/README.md0000644000076400007640000000216611752017525013201 0ustar andyandyFile-Next --------- File::Next is an iterator-based module for finding files. It's lightweight, has no dependencies, runs under taint mode, and puts your program more directly in control of file selection. It's taken heavily from Mark Jason Dominus' excellent book "Higher Order Perl". http://hop.perl.plover.com/ INSTALLATION ------------ To install this module, run the following commands: perl Makefile.PL make make test make install SUPPORT AND DOCUMENTATION ------------------------- After installing, you can find documentation for this module with the perldoc command. perldoc File::Next You can also look for information at: * Search CPAN * http://search.cpan.org/dist/File-Next * Bug Tracker: * http://github.com/petdance/file-next/issues * AnnoCPAN, annotated CPAN documentation: * http://annocpan.org/dist/File-Next * CPAN Ratings: * http://cpanratings.perl.org/d/File-Next COPYRIGHT AND LICENSE --------------------- Copyright 2005-2012 Andy Lester. This program is free software; you can redistribute it and/or modify it under the terms of the Artistic License version 2.0. File-Next-1.12/META.yml0000664000076400007640000000123512065422323013163 0ustar andyandy--- abstract: 'File-finding iterator' author: - 'Andy Lester ' build_requires: ExtUtils::MakeMaker: 0 configure_requires: ExtUtils::MakeMaker: 0 dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 6.62, CPAN::Meta::Converter version 2.112621' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: File-Next no_index: directory: - t - inc requires: File::Spec: 0 Test::More: 0.88 resources: bugtracker: http://github.com/petdance/file-next/issues license: http://dev.perl.org/licenses/ repository: http://github.com/petdance/file-next/tree/master version: 1.12 File-Next-1.12/META.json0000664000076400007640000000223712065422323013336 0ustar andyandy{ "abstract" : "File-finding iterator", "author" : [ "Andy Lester " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 6.62, CPAN::Meta::Converter version 2.112621", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "File-Next", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : 0 } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : 0 } }, "runtime" : { "requires" : { "File::Spec" : 0, "Test::More" : "0.88" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "http://github.com/petdance/file-next/issues" }, "license" : [ "http://dev.perl.org/licenses/" ], "repository" : { "url" : "http://github.com/petdance/file-next/tree/master" } }, "version" : "1.12" } File-Next-1.12/Next.pm0000644000076400007640000004033512065422220013164 0ustar andyandypackage File::Next; use strict; use warnings; =head1 NAME File::Next - File-finding iterator =head1 VERSION Version 1.12 =cut our $VERSION = '1.12'; =head1 SYNOPSIS File::Next is a lightweight, taint-safe file-finding module. It's lightweight and has no non-core prerequisites. use File::Next; my $files = File::Next::files( '/tmp' ); while ( defined ( my $file = $files->() ) ) { # do something... } =head1 OPERATIONAL THEORY The two major functions, I and I, return an iterator that will walk through a directory tree. The simplest use case is: use File::Next; my $iter = File::Next::files( '/tmp' ); while ( defined ( my $file = $iter->() ) ) { print $file, "\n"; } # Prints... /tmp/foo.txt /tmp/bar.pl /tmp/baz/1 /tmp/baz/2.txt /tmp/baz/wango/tango/purple.txt Note that only files are returned by C's iterator. Directories are ignored. In list context, the iterator returns a list containing I<$dir>, I<$file> and I<$fullpath>, where I<$fullpath> is what would get returned in scalar context. The first parameter to any of the iterator factory functions may be a hashref of options. =head1 ITERATORS For the three iterators, the \%options are optional. =head2 files( [ \%options, ] @starting_points ) Returns an iterator that walks directories starting with the items in I<@starting_points>. Each call to the iterator returns another regular file. =head2 dirs( [ \%options, ] @starting_points ) Returns an iterator that walks directories starting with the items in I<@starting_points>. Each call to the iterator returns another directory. =head2 everything( [ \%options, ] @starting_points ) Returns an iterator that walks directories starting with the items in I<@starting_points>. Each call to the iterator returns another file, whether it's a regular file, directory, symlink, socket, or whatever. =head2 from_file( [ \%options, ] $filename ) Returns an iterator that iterates over each of the files specified in I<$filename>. If I<$filename> is C<->, then the files are read from STDIN. The files are assumed to be in the file one filename per line. If I<$nul_separated> is passed, then the files are assumed to be NUL-separated, as by C. If there are blank lines or empty filenames in the input stream, they are ignored. Each filename is checked to see that it is a regular file or a named pipe. If the file does not exists or is a directory, then a warning is thrown to I, and the file is skipped. The following options have no effect in C: I, I, I. =head1 SUPPORT FUNCTIONS =head2 sort_standard( $a, $b ) A sort function for passing as a C option: my $iter = File::Next::files( { sort_files => \&File::Next::sort_standard, }, 't/swamp' ); This function is the default, so the code above is identical to: my $iter = File::Next::files( { sort_files => 1, }, 't/swamp' ); =head2 sort_reverse( $a, $b ) Same as C, but in reverse. =head2 reslash( $path ) Takes a path with all forward slashes and rebuilds it with whatever is appropriate for the platform. For example 'foo/bar/bat' will become 'foo\bar\bat' on Windows. This is really just a convenience function. I'd make it private, but F wants it, too. =cut =head1 CONSTRUCTOR PARAMETERS =head2 file_filter -> \&file_filter The file_filter lets you check to see if it's really a file you want to get back. If the file_filter returns a true value, the file will be returned; if false, it will be skipped. The file_filter function takes no arguments but rather does its work through a collection of variables. =over 4 =item * C<$_> is the current filename within that directory =item * C<$File::Next::dir> is the current directory name =item * C<$File::Next::name> is the complete pathname to the file =back These are analogous to the same variables in L. my $iter = File::Next::files( { file_filter => sub { /\.txt$/ } }, '/tmp' ); By default, the I is C, or "all files". This filter has no effect if your iterator is only returning directories. =head2 descend_filter => \&descend_filter The descend_filter lets you check to see if the iterator should descend into a given directory. Maybe you want to skip F and F<.svn> directories. my $descend_filter = sub { $_ ne "CVS" && $_ ne ".svn" } The descend_filter function takes no arguments but rather does its work through a collection of variables. =over 4 =item * C<$_> is the current filename of the directory =item * C<$File::Next::dir> is the complete directory name =back The descend filter is NOT applied to any directory names specified in as I<@starting_points> in the constructor. For example, my $iter = File::Next::files( { descend_filter => sub{0} }, '/tmp' ); always descends into I, as you would expect. By default, the I is C, or "always descend". =head2 error_handler => \&error_handler If I is set, then any errors will be sent through it. By default, this value is C. This function must NOT return. =head2 warning_handler => \&warning_handler If I is set, then any errors will be sent through it. By default, this value is C. Unlike the I, this function must return. =head2 sort_files => [ 0 | 1 | \&sort_sub] If you want files sorted, pass in some true value, as in C<< sort_files => 1 >>. If you want a special sort order, pass in a sort function like C<< sort_files => sub { $a->[1] cmp $b->[1] } >>. Note that the parms passed in to the sub are arrayrefs, where $a->[0] is the directory name, $a->[1] is the file name and $a->[2] is the full path. Typically you're going to be sorting on $a->[2]. =head2 follow_symlinks => [ 0 | 1 ] If set to false, the iterator will ignore any files and directories that are actually symlinks. This has no effect on non-Unixy systems such as Windows. By default, this is true. Note that this filter does not apply to any of the I<@starting_points> passed in to the constructor. You should not set C<< follow_symlinks => 0 >> unless you specifically need that behavior. Setting C<< follow_symlinks => 0 >> can be a speed hit, because File::Next must check to see if the file or directory you're about to follow is actually a symlink. =head2 nul_separated => [ 0 | 1 ] Used on by the C iterator. Specifies that the files listed in the input file are separated by NUL characters, as from the C command with the C<-print0> argument. =cut use File::Spec (); our $name; # name of the current file our $dir; # dir of the current file our %files_defaults; our %skip_dirs; BEGIN { %files_defaults = ( file_filter => undef, descend_filter => undef, error_handler => sub { CORE::die @_ }, warning_handler => sub { CORE::warn @_ }, sort_files => undef, follow_symlinks => 1, nul_separated => 0, ); %skip_dirs = map {($_,1)} (File::Spec->curdir, File::Spec->updir); } sub files { die _bad_invocation() if @_ && defined($_[0]) && ($_[0] eq __PACKAGE__); my ($parms,@queue) = _setup( \%files_defaults, @_ ); my $filter = $parms->{file_filter}; return sub { while (@queue) { my ($dirname,$file,$fullpath) = splice( @queue, 0, 3 ); ## no critic (ProhibitMagicNumbers) if ( -f $fullpath || -p $fullpath || $fullpath =~ m{^/dev/fd} ) { if ( $filter ) { local $_ = $file; local $File::Next::dir = $dirname; local $File::Next::name = $fullpath; next if not $filter->(); } return wantarray ? ($dirname,$file,$fullpath) : $fullpath; } elsif ( -d _ ) { unshift( @queue, _candidate_files( $parms, $fullpath ) ); } } # while return; }; # iterator } sub dirs { die _bad_invocation() if @_ && defined($_[0]) && ($_[0] eq __PACKAGE__); my ($parms,@queue) = _setup( \%files_defaults, @_ ); return sub { while (@queue) { my (undef,undef,$fullpath) = splice( @queue, 0, 3 ); ## no critic (ProhibitMagicNumbers) if ( -d $fullpath ) { unshift( @queue, _candidate_files( $parms, $fullpath ) ); return $fullpath; } } # while return; }; # iterator } sub everything { die _bad_invocation() if @_ && defined($_[0]) && ($_[0] eq __PACKAGE__); my ($parms,@queue) = _setup( \%files_defaults, @_ ); my $filter = $parms->{file_filter}; return sub { while (@queue) { my ($dirname,$file,$fullpath) = splice( @queue, 0, 3 ); ## no critic (ProhibitMagicNumbers) if ( -d $fullpath ) { unshift( @queue, _candidate_files( $parms, $fullpath ) ); } if ( $filter ) { local $_ = $file; local $File::Next::dir = $dirname; local $File::Next::name = $fullpath; next if not $filter->(); } return wantarray ? ($dirname,$file,$fullpath) : $fullpath; } # while return; }; # iterator } sub from_file { die _bad_invocation() if @_ && defined($_[0]) && ($_[0] eq __PACKAGE__); my ($parms,@queue) = _setup( \%files_defaults, @_ ); my $err = $parms->{error_handler}; my $warn = $parms->{error_handler}; my $filename = $queue[1]; if ( !defined($filename) ) { $err->( 'Must pass a filename to from_file()' ); return undef; } my $fh; if ( $filename eq '-' ) { $fh = \*STDIN; } else { if ( !open( $fh, '<', $filename ) ) { $err->( "Unable to open $filename: $!" ); return undef; } } my $filter = $parms->{file_filter}; return sub { local $/ = $parms->{nul_separated} ? "\x00" : $/; while ( my $fullpath = <$fh> ) { chomp $fullpath; next unless $fullpath =~ /./; if ( not ( -f $fullpath || -p _ ) ) { $warn->( "$fullpath: No such file" ); next; } my ($volume,$dirname,$file) = File::Spec->splitpath( $fullpath ); if ( $filter ) { local $_ = $file; local $File::Next::dir = $dirname; local $File::Next::name = $fullpath; next if not $filter->(); } return wantarray ? ($dirname,$file,$fullpath) : $fullpath; } # while close $fh; return; }; # iterator } sub _bad_invocation { my $good = (caller(1))[3]; my $bad = $good; $bad =~ s/(.+)::/$1->/; return "$good must not be invoked as $bad"; } sub sort_standard($$) { return $_[0]->[1] cmp $_[1]->[1] } ## no critic (ProhibitSubroutinePrototypes) sub sort_reverse($$) { return $_[1]->[1] cmp $_[0]->[1] } ## no critic (ProhibitSubroutinePrototypes) sub reslash { my $path = shift; my @parts = split( /\//, $path ); return $path if @parts < 2; return File::Spec->catfile( @parts ); } =head1 PRIVATE FUNCTIONS =head2 _setup( $default_parms, @whatever_was_passed_to_files() ) Handles all the scut-work for setting up the parms passed in. Returns a hashref of operational options, combined between I<$passed_parms> and I<$defaults>, plus the queue. The queue prep stuff takes the strings in I<@starting_points> and puts them in the format that queue needs. The C<@queue> that gets passed around is an array that has three elements for each of the entries in the queue: $dir, $file and $fullpath. Items must be pushed and popped off the queue three at a time (spliced, really). =cut sub _setup { my $defaults = shift; my $passed_parms = ref $_[0] eq 'HASH' ? {%{+shift}} : {}; # copy parm hash my %passed_parms = %{$passed_parms}; my $parms = {}; for my $key ( keys %{$defaults} ) { $parms->{$key} = exists $passed_parms{$key} ? delete $passed_parms{$key} : $defaults->{$key}; } # Any leftover keys are bogus for my $badkey ( keys %passed_parms ) { my $sub = (caller(1))[3]; ## no critic (ProhibitMagicNumbers) $parms->{error_handler}->( "Invalid option passed to $sub(): $badkey" ); } # If it's not a code ref, assume standard sort if ( $parms->{sort_files} && ( ref($parms->{sort_files}) ne 'CODE' ) ) { $parms->{sort_files} = \&sort_standard; } my @queue; for ( @_ ) { my $start = reslash( $_ ); if (-d $start) { push @queue, ($start,undef,$start); } else { push @queue, (undef,$start,$start); } } return ($parms,@queue); } =head2 _candidate_files( $parms, $dir ) Pulls out the files/dirs that might be worth looking into in I<$dir>. If I<$dir> is the empty string, then search the current directory. I<$parms> is the hashref of parms passed into File::Next constructor. =cut sub _candidate_files { my $parms = shift; my $dirname = shift; my $dh; if ( !opendir $dh, $dirname ) { $parms->{error_handler}->( "$dirname: $!" ); return; } my @newfiles; my $descend_filter = $parms->{descend_filter}; my $follow_symlinks = $parms->{follow_symlinks}; my $sort_sub = $parms->{sort_files}; for my $file ( grep { !exists $skip_dirs{$_} } readdir $dh ) { my $has_stat; # Only do directory checking if we have a descend_filter my $fullpath = File::Spec->catdir( $dirname, $file ); if ( !$follow_symlinks ) { next if -l $fullpath; $has_stat = 1; } if ( $descend_filter ) { if ( $has_stat ? (-d _) : (-d $fullpath) ) { local $File::Next::dir = $fullpath; local $_ = $file; next if not $descend_filter->(); } } if ( $sort_sub ) { push( @newfiles, [ $dirname, $file, $fullpath ] ); } else { push( @newfiles, $dirname, $file, $fullpath ); } } closedir $dh; if ( $sort_sub ) { return map { @{$_} } sort $sort_sub @newfiles; } return @newfiles; } =head1 DIAGNOSTICS =over =item C<< File::Next::files must not be invoked as File::Next->files >> =item C<< File::Next::dirs must not be invoked as File::Next->dirs >> =item C<< File::Next::everything must not be invoked as File::Next->everything >> =back The interface functions do not allow for the method invocation syntax and throw errors with the messages above. You can work around this limitation with L. for my $file_system_feature (qw(dirs files)) { my $iterator = File::Next->can($file_system_feature)->($options, $target_directory); while (defined(my $name = $iterator->())) { # ... } } =head1 SPEED TWEAKS =over 4 =item * Don't set C<< follow_symlinks => 0 >> unless you need it. =back =head1 AUTHOR Andy Lester, C<< >> =head1 BUGS Please report any bugs or feature requests to L. Note that File::Next does NOT use L for bug tracking. =head1 SUPPORT You can find documentation for this module with the perldoc command. perldoc File::Next You can also look for information at: =over 4 =item * File::Next's bug queue L =item * AnnoCPAN: Annotated CPAN documentation L =item * CPAN Ratings L =item * Search CPAN L =item * Source code repository L =back =head1 ACKNOWLEDGEMENTS All file-finding in this module is adapted from Mark Jason Dominus' marvelous I, page 126. Thanks also for bug fixes and typo finding to Bruce Woodward, Christopher J. Madsen, Bernhard Fisseni and Rob Hoelz. =head1 COPYRIGHT & LICENSE Copyright 2005-2012 Andy Lester. This program is free software; you can redistribute it and/or modify it under the terms of the Artistic License version 2.0. =cut 1; # End of File::Next File-Next-1.12/Changes0000644000076400007640000001214512065422240013203 0ustar andyandyRevision history for File-Next File::Next does NOT use rt.cpan.org for bug tracking. Please report problems at http://github.com/petdance/file-next/issues. 1.12 Sat Dec 22 15:22:31 CST 2012 [FIXES] Fix detection of named pipes under various flavors of BSD. 1.10 Thu Jun 14 19:55:57 CDT 2012 [ENHANCEMENTS] Added the warning_handler argument to File::Next::from_file(). This is so from_file() can throw a warning if a non-existent file is in the file it came from. [FIXES] from_file() should return undef if the file can't be opened. Fixed test failures and made tests more portable. 1.08 Sun May 20 22:43:19 CDT 2012 [ENHANCEMENTS] Added File::Next::from_file() to get the list of files to iterate over from a file, or from STDIN. Named pipes are now supported. [INTERNAL] Add more tests, and clean up some Perl::Critic warnings. 1.06 Tue Aug 4 15:10:34 CDT 2009 [FIXES] Fixed closing =cut in POD. There are no functionality changes, but the lack of a closing =cut meant that ack would not build properly. 1.04 Fri Jul 31 16:24:36 CDT 2009 [ENHANCEMENTS] It's never been correct to call File::Next::files() as a method, as File::Next->files(). Now, if you do, files() will die with an error. This is also the case with dirs() and everything(). Thanks to Eric Lyons for reporting. Tiny directory reading speedups. [DOCUMENTATION] Updated URLs for support sites. Added a little note about the follow_symlinks=>0 being a speed hit. 1.02 Mon Jan 14 14:01:40 CST 2008 [SPEED ENHANCEMENTS] Don't do a directory stat call if we've already done one to check for a symlink. Be smarter about building a list of candidate files that we're going to have to sort anyway. 1.00 Mon Jun 18 10:06:14 CDT 2007 [ENHANCEMENTS] Added File::Next::everything() to get back everything regardless of being file or directory. 0.40 Fri Mar 9 21:32:15 CST 2007 [ENHANCEMENTS] Minimizing the number of stat calls necessary. May make some teeny speed boost. [DOCUMENTATION] Fixed the constructor example of File::Next->files, which is wrong. Updated the examples to show that you need to check definedness of the return from the iterator, in case you get a file "0". 0.38 Sun Jan 7 01:23:43 CST 2007 [ENHANCEMENTS] Added the ability to skip symlinks. By default, symlinks are treated as the files or dirs they point to, but now you can tell File::Next to ignore them. Added a dirs() function to return an iterator that only finds directories. [DOCUMENTATION] Fixed some little errors here and there. 0.36 Thu Dec 21 15:50:13 CST 2006 There is no new functionality between 0.34 and 0.36. It's entirely a speedup. [ENHANCEMENTS] I sped up the internals of passing around the queue and building paths, and it should now be 20% faster than 0.34 in the simplest case. [DOCUMENTATION] Now it explains what the iterator returns in list context. 0.34 Sat Dec 16 00:21:10 CST 2006 [ENHANCEMENTS] The reslash() function is now publicly usable, although not via export. This is mostly convenience for ack. Minor speedups when there's no file_filter parameter. Speedups when there's no descend_filter, too. We were doing checks to see if a given file was a directory, even though we didn't do anything with that fact if there's no descend_filter. 0.32 Wed Dec 6 19:36:51 CST 2006 No functionality changes, except as seen below. For most of you using File::Next, there are no changes in this version. [INTERNALS] Initialize package arrays in BEGIN blocks. This is so ack's standalone version will initialize correctly. 0.30 Fri Nov 10 11:24:50 CST 2006 [FIXES] Explicitly declare $File::Find::name and $File::Find::dir. Made the updir/curdir stuff into a hash. [FEATURES] Added a sort_files parm to allow you to sort the results. [INTERNALS] Added a perlcriticrc for "make critic". 0.28 Tue Sep 5 23:51:41 CDT 2006 [FIXES] Wrapped the CORE::die in a real function. Also added a test to make sure that we die properly. [INTERNALS] Using proper File::Spec function to get the list of special directories. 0.26 Sat Sep 2 10:10:12 CDT 2006 No functionality changes. Making the tests actually worki under Windows this time. Thanks, Audrey! 0.24 Fri Sep 1 23:38:43 CDT 2006 No functionality changes. Only making the tests run under Windows. 0.22 Wed Aug 16 14:08:39 CDT 2006 [FIXES] The file_filter was getting called incorrectly. I was setting $File::Next::file instead of $File::Next::name. I've now also added tests to make sure that it's getting set correctly. 0.20 Tue Aug 15 02:28:42 CDT 2006 First real version. Don't use 0.01 any more. Iterator now returns separate file & directory components in array context. Rewrote internals. 0.01 Sat Jul 29 22:29:46 CDT 2006 First version, released on an unsuspecting world.