File Coverage

blib/lib/Path/Class/Iterator.pm

Criterion	Covered	Total	%
statement	101	111	90.9
branch	27	38	71.0
condition	6	15	40.0
subroutine	18	20	90.0
pod	4	4	100.0
total	156	188	82.9

package Path::Class::Iterator;

use strict;
use warnings;
use Path::Class;
use Carp;
use Iterator;

use base qw/ Class::Accessor::Fast /;

our $VERSION = '0.07';
our $Err;
our $debug = $ENV{PERL_TEST} || $ENV{PERL_DEBUG} || 0;

if ($debug)
{
    require Data::Dump;
}

my @acc = qw/
  root
  start
  follow_symlinks
  follow_hidden
  iterator
  error_handler
  error
  show_warnings
  breadth_first
  interesting
  push_queue
  pop_queue
  queue
  depth

  /;

sub _listing
{
    my $self = shift;
    my $path = shift;

    my $d = $path->open;

    unless (defined $d)
    {
        $self->error("cannot open $path: $!");
        if ($self->error_handler->($self, $path, $!))
        {
            return Iterator->new(sub { Iterator::is_done(); return undef });
        }
        else
        {
            croak "can't open $path: $!";
        }
    }

    return Iterator->new(
        sub {

            # Get next file, skipping . and ..
            my $next;
            while (1)
            {
                $next = $d->read;

                if (!defined $next)
                {
                    undef $d;    # allow garbage collection
                    Iterator::is_done();
                }

                next if !$self->follow_hidden && $next =~ m/^\./o;

                last if $next ne '.' && $next ne '..';
            }

            # Return this item
            my $f = Path::Class::Iterator::Dir->new($path, $next);
            if (-d $f)
            {
                $self->{_depth} =
                  (scalar($f->cleanup->dir_list) - $self->{_root_depth});

            }
            else
            {
                $f = Path::Class::Iterator::File->new($path, $next);
                my $p = $f->parent->cleanup;
                $self->{_depth} =
                  (scalar($p->dir_list) - $self->{_root_depth} + 1);

            }

            return $f;

        }
    );
}

sub next
{
    my $self = shift;
    my $depth = $self->cur_depth;
    my $n = $self->iterator->value;
    $n->depth($depth);
    return $n;
}

sub done
{
    my $self = shift;
    return $self->iterator->is_exhausted;
}

sub cur_depth { return $_[0]->{_depth} }

sub new
{
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self  = {};
    my %opts  = @_;
    @$self{keys %opts} = values %opts;
    bless($self, $class);
    $self->mk_accessors(@acc);

    $self->start(time());
    $self->{_depth} = 0;    # internal tracking

    $self->root or croak "root param required";
    $self->root(dir($self->root));
    unless ($self->root->open)
    {
        $Err = $self->root . " cannot be opened: $!";
        return undef;
    }

    $self->{_root_depth} = scalar($self->root->dir_list);

    $self->error_handler(
        sub {
            my ($self, $path, $msg) = @_;
            warn "skipping $path: $msg" if $self->show_warnings;
            return 1;
        }
      )
      unless $self->error_handler;

    $self->breadth_first
      ? $self->pop_queue(
        sub {
            my $self = shift;
            return pop(@{$self->{queue}});
        }
      )
      : $self->pop_queue(
        sub {
            my $self = shift;
            return shift(@{$self->{queue}});
        }
      );

    $self->push_queue(sub { my $self = shift; push(@{$self->{queue}}, @_); });

    my $files = $self->_listing($self->root);

    $self->queue([]);
    $self->iterator(
        Iterator->new(
            sub {

                # If no more files in current directory,
                # get next directory off the queue
                while ($files->is_exhausted)
                {

                    # Nothing else on the queue? Then we're done .
                    if (!$self->queue->[0])
                    {
                        undef $files;    # allow garbage collection
                        Iterator::is_done();
                    }

                    # Create an iterator to return the files in that directory
                    carp Data::Dump::pp($self->queue) if $debug;

                    $files = $self->_listing($self->pop_queue->($self));
                }

                # Get next file in current directory
                my $next = $files->value;

                if (!$self->follow_symlinks)
                {
                    while (-l $next && $files->isnt_exhausted)
                    {
                        $next = $files->value;
                    }
                }

                # remember dirs for recursing later
                # unless they exceed depth
                carp join("\n", '=' x 50, "$next", $self->cur_depth) if $debug;
                if (-d $next)
                {

            # BUG?? does checking cur_depth() here invoke our bug?

                    unless (   $self->depth
                            && $self->cur_depth > $self->depth)
                    {
                        $self->push_queue->($self, $next);
                        if ($self->interesting)
                        {
                            my $new = $self->interesting->($self, $self->queue);
                            croak
                              "return value from interesting() must be an ARRAY ref"
                              unless ref $new eq 'ARRAY';
                            $self->queue($new);
                        }
                    }
                }

                return $next;
            }
        )
    );

    return $self;
}

1;


package Path::Class::Iterator::File;
use base qw( Path::Class::File Class::Accessor::Fast );
__PACKAGE__->mk_accessors('depth');

1;

package Path::Class::Iterator::Dir;
use base qw( Path::Class::Dir Class::Accessor::Fast );
__PACKAGE__->mk_accessors('depth');

1;


__END__