Group
Extension

Perl6-Pugs/ext/File-Find/lib/File/Find.pm

use v6-alpha;

module File::Find-6.0.0;

use File::Spec;

has Int   $.debug;
has Array $.dirs;
has Array $.queue;
has Array $.results;
has Code  $.wanted_dir;
has Code  $.wanted_file;

submethod BUILD { $.debug = 0 }

method find ( $self: :@dirs, :$wanted_dir, :$wanted_file ) {
    my @start    = @dirs        || @.dirs;
    my $wdir_cb  = $wanted_dir  || $.wanted_dir  || sub { 1 };
    my $wfile_cb = $wanted_file || $.wanted_file || sub { 1 };
    for @start -> $dir {
        my $abs = $dir;
        $abs = rel2abs($abs);
        $.queue.push($abs);
    }
    my $dir;
    while $dir = $.queue.shift {
        say "$dir" if $.debug;
        my $dh = $dir.opendir;
        for $dh.readdir -> $node {
            next if $node ~~ m:P5/^(?:\.){1,2}$/;
            my $abs = catdir( $dir, $node );
            unless -d $abs {
                $abs = catfile( $dir, $node );
                if $wfile_cb( $node, $dir, $abs ) {
                    $.results.push($abs);
                    say "  +f $abs" if $.debug;
                }
                else { say "  -f $abs" if $.debug }
            }
            # XXX: Add symlink detection!
            else {
                if $wdir_cb( $node, $dir, $abs ) {
                    $.queue.push($abs);
                    say "  +d $abs" if $.debug;
                }
                else { say "  -d $abs" if $.debug }
            }
        }
	$dh.closedir;
	undefine $dh;
    }
    return $.results;
}

=head1 NAME

File::Find - Traverse a directory tree

=head1 SYNOPSIS

    use File::Find;

    my $f = File::Find.new;
    $f.wanted_file = sub ( $file, $path, $pathfile ) {
        return 1 if $file ~~ m:P5/^.*\.pm$/;
    }
    $f.dirs = qw/lib/;
    my @files = $f.find;

    # debug attribute for statistics
    $f.debug = 1;

=head1 DESCRIPTION

Perl 6 port of the C<File::Find> library.

This is no direct port, the api got cleaned up a bit. :)
Some features are still missing but will be added in the future...

=head1 CALLBACKS

We have two callbacks C<wanted_file> and C<wanted_dir>.

=over 4

=item wanted_file

Gets called before a file is added to results.
Should return 1 or 0. (defaults to 1)

    sub ( $file, $path, $pathfile ) {
        return 1;
    }

=item wanted_dir

Gets called before a directory is added to the queue.
Should return 1 or 0. (defaults to 1)

    sub ( $dir, $path, $pathdir ) {
        return 1;
    }

=back

=head1 AUTHOR

Sebastian Riedel <sri@oook.de>

=head1 LICENSE

This library is free software . You can redistribute it and/or modify
it under the same terms as perl itself.

=cut


Powered by Groonga
Maintained by Kenichi Ishigaki <ishigaki@cpan.org>. If you find anything, submit it on GitHub.