Initial Commit

database/perl/vendor/lib/IO/All/Dir.pm

@@ -0,0 +1,260 @@
+use strict; use warnings;
+package IO::All::Dir;
+
+use Scalar::Util 'blessed';
+use File::Glob 'bsd_glob';
+use IO::All::Filesys -base;
+use IO::All -base;
+use IO::Dir;
+
+#===============================================================================
+const type => 'dir';
+option 'sort' => 1;
+chain filter => undef;
+option 'deep';
+field 'chdir_from';
+
+#===============================================================================
+sub dir {
+    my $self = shift;
+    my $had_prev = blessed($self) && $self->pathname;
+
+    bless $self, __PACKAGE__ unless $had_prev;
+    if (@_ && @_ > 1 || @_ && $had_prev) {
+       $self->name(
+           $self->_spec_class->catdir(
+               ($self->pathname ? ($self->pathname) : () ),
+               @_,
+           )
+       )
+    } elsif (@_) {
+       $self->name($_[0])
+    }
+    return $self->_init;
+}
+
+sub dir_handle {
+    my $self = shift;
+    bless $self, __PACKAGE__;
+    $self->_handle(shift) if @_;
+    return $self->_init;
+}
+
+#===============================================================================
+sub _assert_open {
+    my $self = shift;
+    return if $self->is_open;
+    $self->open;
+}
+
+sub open {
+    my $self = shift;
+    $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 $self = shift;
+    my $name = defined $self->pathname
+      ? " '" . $self->pathname . "'"
+      : '';
+    return qq{Can't open directory$name:\n$!};
+}
+
+sub exists { -d shift->pathname }
+
+#===============================================================================
+sub All {
+    my $self = shift;
+    $self->all(0);
+}
+
+sub all {
+    my $self = shift;
+    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 {
+    my $self = shift;
+    $self->all_dirs(0);
+}
+
+sub all_dirs {
+    my $self = shift;
+    grep {$_->is_dir} $self->all(@_);
+}
+
+sub All_Files {
+    my $self = shift;
+    $self->all_files(0);
+}
+
+sub all_files {
+    my $self = shift;
+    grep {$_->is_file} $self->all(@_);
+}
+
+sub All_Links {
+ my $self = shift;
+ $self->all_links(0);
+}
+
+sub all_links {
+    my $self = shift;
+    grep {$_->is_link} $self->all(@_);
+}
+
+sub chdir {
+    my $self = shift;
+    require Cwd;
+    $self->chdir_from(Cwd::cwd());
+    CORE::chdir($self->pathname);
+    return $self;
+}
+
+sub empty {
+    my $self = shift;
+    my $dh;
+    opendir($dh, $self->pathname) or die;
+    while (my $dir = readdir($dh)) {
+       return 0 unless $dir =~ /^\.{1,2}$/;
+    }
+    return 1;
+}
+
+sub mkdir {
+    my $self = shift;
+    defined($self->perms)
+    ? (CORE::mkdir($self->pathname, $self->perms) or die "mkdir failed: $!")
+    : (CORE::mkdir($self->pathname) or die "mkdir failed: $!");
+    return $self;
+}
+
+sub mkpath {
+    my $self = shift;
+    require File::Path;
+    File::Path::mkpath($self->pathname, @_);
+    return $self;
+}
+
+sub file {
+    my ($self, @rest) = @_;
+
+    return $self->_constructor->()->file($self->pathname, @rest)
+}
+
+sub next {
+    my $self = shift;
+    $self->_assert_open;
+    my $name = $self->readdir;
+    return unless defined $name;
+    my $io = $self->_constructor->(File::Spec->catfile($self->pathname, $name));
+    $io->absolute if $self->is_absolute;
+    return $io;
+}
+
+sub readdir {
+    my $self = shift;
+    $self->_assert_open;
+    if (wantarray) {
+        my @return = grep {
+            not /^\.{1,2}$/
+        } $self->io_handle->read;
+        $self->close;
+        if ($self->_has_utf8) { utf8::decode($_) for (@return) }
+        return @return;
+    }
+    my $name = '.';
+    while ($name =~ /^\.{1,2}$/) {
+        $name = $self->io_handle->read;
+        unless (defined $name) {
+            $self->close;
+            return;
+        }
+    }
+    if ($self->_has_utf8) { utf8::decode($name) }
+    return $name;
+}
+
+sub rmdir {
+    my $self = shift;
+    rmdir $self->pathname;
+}
+
+sub rmtree {
+    my $self = shift;
+    require File::Path;
+    File::Path::rmtree($self->pathname, @_);
+}
+
+sub glob {
+   my ($self, @rest) = @_;
+
+   map {;
+      my $ret = $self->_constructor->($_);
+      $ret->absolute if $self->is_absolute;
+      $ret
+   } bsd_glob $self->_spec_class->catdir( $self->pathname, @rest );
+}
+
+sub copy {
+    my ($self, $new) = @_;
+
+    require File::Copy::Recursive;
+
+    File::Copy::Recursive::dircopy($self->name, $new)
+        or die "failed to copy $self to $new: $!";
+     $self->_constructor->($new)
+}
+
+sub DESTROY {
+    my $self = shift;
+    CORE::chdir($self->chdir_from)
+      if $self->chdir_from;
+      # $self->SUPER::DESTROY(@_);
+}
+
+#===============================================================================
+sub _overload_table {
+    (
+        '${} dir' => '_overload_as_scalar',
+        '@{} dir' => '_overload_as_array',
+        '%{} dir' => '_overload_as_hash',
+    )
+}
+
+sub _overload_as_scalar {
+    \ $_[1];
+}
+
+sub _overload_as_array {
+    [ $_[1]->all ];
+}
+
+sub _overload_as_hash {
+    +{
+        map {
+            (my $name = $_->pathname) =~ s/.*[\/\\]//;
+            ($name, $_);
+        } $_[1]->all
+    };
+}
+
+1;