package IO::All::Dir;
use IO::All -Base;
use mixin 'IO::All::Filesys';
use IO::Dir;

#===============================================================================
const type => 'dir';
option 'sort' => 1;
chain filter => undef;
option 'deep';
field 'chdir_from';

#===============================================================================
sub dir {
    bless $self, __PACKAGE__;
    $self->name(shift) if @_;
    return $self->_init;
}

sub dir_handle {
    bless $self, __PACKAGE__;
    $self->_handle(shift) if @_;
    return $self->_init;
}

#===============================================================================
sub assert_open {
    return if $self->is_open;
    $self->open;
}

sub open {
    $self->is_open(1);
    $self->assert_dirpath($self->pathname)
      if $self->pathname and $self->_assert;
    my $handle = IO::Dir->new;
    $self->io_handle($handle);
    $handle->open($self->pathname)
      or $self->throw($self->open_msg);
    return $self;
}

sub open_msg {
    my $name = defined $self->pathname
      ? " '" . $self->pathname . "'"
      : '';
    return qq{Can't open directory$name:\n$!};
}

#===============================================================================
sub All {
    $self->all(0);
}

sub all {
    my $depth = @_ ? shift(@_) : $self->_deep ? 0 : 1;
    my $first = not @_;
    my @all;
    while (my $io = $self->next) {
        push @all, $io;
        push(@all, $io->all($depth - 1, 1))
          if $depth != 1 and $io->is_dir;
    }
    @all = grep {&{$self->filter}} @all
      if $self->filter;
    return @all unless $first and $self->_sort;
    return sort {$a->pathname cmp $b->pathname} @all;
}

sub All_Dirs {
    $self->all_dirs(0);
}

sub all_dirs {
    grep {$_->is_dir} $self->all(@_);
}

sub All_Files {
    $self->all_files(0);
}

sub all_files {
    grep {$_->is_file} $self->all(@_);
}

sub All_Links {
    $self->all_links(0);
}

sub all_links {
    grep {$_->is_link} $self->all(@_);
}

sub chdir {
    require Cwd;
    $self->chdir_from(Cwd::cwd());
    CORE::chdir($self->pathname);
    return $self;
}

sub empty {
    my $dh;
    opendir($dh, $self->pathname) or die;
    while (my $dir = readdir($dh)) {
       return 0 unless $dir =~ /^\.{1,2}$/;
    } 
    return 1;
}

sub mkdir {
    defined($self->perms)
    ? CORE::mkdir($self->pathname, $self->perms)
    : CORE::mkdir($self->pathname);
    return $self;
}

sub mkpath {
    require File::Path;
    File::Path::mkpath($self->pathname, @_);
    return $self;
}

sub next {
    $self->assert_open;
    my $name = $self->readdir;
    return unless defined $name;
    my $io = IO::All->new(File::Spec->catfile($self->pathname, $name));
    $io->absolute if $self->is_absolute;
    return $io;
}

sub readdir {
    $self->assert_open;
    if (wantarray) {
        my @return = grep { 
            not /^\.{1,2}$/ 
        } $self->io_handle->read;
        $self->close;
        return @return;
    }
    my $name = '.'; 
    while ($name =~ /^\.{1,2}$/) {
        $name = $self->io_handle->read;
        unless (defined $name) {
            $self->close;
            return;
        }
    }
    return $name;
}

sub rmdir {
    rmdir $self->pathname;
}

sub rmtree {
    require File::Path;
    File::Path::rmtree($self->pathname, @_);
}

sub DESTROY {
    CORE::chdir($self->chdir_from)
      if $self->chdir_from;
    super;
}

#===============================================================================
sub overload_table {
    (
        '@{} dir' => 'overload_as_array',
        '%{} dir' => 'overload_as_hash',
    )
}

sub overload_as_array() {
    [ $_[1]->all ];
}

sub overload_as_hash() {
    +{ 
        map {
            (my $name = $_->pathname) =~ s/.*[\/\\]//;
            ($name, $_);
        } $_[1]->all 
    };
}

__DATA__

=head1 NAME 

IO::All::Dir - Directory Support for IO::All

=head1 SYNOPSIS

See L<IO::All>.

=head1 DESCRIPTION

=head1 AUTHOR

Brian Ingerson <INGY@cpan.org>

=head1 COPYRIGHT

Copyright (c) 2004. Brian Ingerson. All rights reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

See http://www.perl.com/perl/misc/Artistic.html

=cut