File Coverage

blib/lib/Evo/Fs.pm

Criterion	Covered	Total	%
statement	317	318	99.6
branch	122	194	62.8
condition	18	25	72.0
subroutine	45	45	100.0
pod	19	32	59.3
total	521	614	84.8

package Evo::Fs;
use Evo '-Export *; -Class; ::Stat; -Path; Carp croak; -Path';
die "Win isn't supported yet. Pull requests are welcome!" if $^O eq 'MSWin32';

use Fcntl qw(:seek O_RDWR O_RDONLY O_WRONLY O_RDWR O_CREAT O_TRUNC O_APPEND O_EXCL :flock);
use Evo 'File::Spec; File::Path; Cwd() abs_path; File::Basename fileparse; Symbol()';
use Time::HiRes ();
use Evo 'List::Util first; File::Copy ()';
use Errno qw(EAGAIN EWOULDBLOCK);
use Scalar::Util;

sub SKIP_HIDDEN : Export : prototype() {
  sub($dir) {
    my @dirs = File::Spec->splitdir($dir);
    $dirs[-1] !~ /^\./;
  };
}


# ========= CLASS =========


has root =>
  check sub($v) { File::Spec->file_name_is_absolute($v) ? 1 : (0, "root should be absolute") };


sub cd ($self, $rel) {
  my $root = Evo::Path->from_string('', $self->root . '')->append_unsafe($rel)->to_string;
  ref($self)->new(root => $root);
}

sub path2real ($self, $rel) {
  Evo::Path->from_string($rel, $self->root . '')->to_string;
}

sub exists ($self, $path) {
  -e $self->path2real($path);
}


sub mkdir ($self, $path, $perm = undef) {
  my $real = $self->path2real($path);
  &CORE::mkdir($real, defined $perm ? $perm : ()) or croak "$real: $!";
}

sub make_tree ($self, $path, $perms = undef) {
  my $real = $self->path2real($path);
  my %opts = (error => \my $err);
  $opts{chmod} = $perms if defined $perms;
  File::Path::make_path($real, \%opts);
  croak join('; ', map { $_->%* } @$err) if @$err;    # TODO: test
}

sub symlink ($self, $to_path, $link_path) {
  CORE::symlink($self->path2real($to_path), $self->path2real($link_path))
    or croak "symlink $to_path $link_path: $!";
}

sub link ($self, $to_path, $link_path) {
  CORE::link($self->path2real($to_path), $self->path2real($link_path))
    or croak "hardlink $to_path $link_path: $!";
}

sub is_symlink ($self, $path) {
  -l $self->path2real($path);
}


sub utimes ($self, $path, $atime = undef, $mtime = undef) {
  my $real = $self->path2real($path);
  utime($atime // undef, $mtime // undef, $real) or croak "utimes $path: $!";
}

sub close ($self, $fh) {
  close $fh;
}

sub stat ($self, $path) {
  my %opts;
  my @stat = Time::HiRes::stat $self->path2real($path) or croak "stat $path: $!";
  @opts{qw(dev ino mode nlink uid gid rdev size atime mtime ctime blksize blocks)} = @stat;
  Evo::Fs::Stat->new(%opts, _data => \@stat);
}

sub rename ($self, $old, $new) {
  rename $self->path2real($old), $self->path2real($new) or croak "rename $!";
}


my %seek_map = (start => SEEK_SET, cur => SEEK_CUR, end => SEEK_END,);

my %open_map = (
  r    => O_RDONLY,
  'r+' => O_RDWR,

  w     => O_WRONLY | O_CREAT | O_TRUNC,
  wx    => O_WRONLY | O_CREAT | O_EXCL,
  'w+'  => O_RDWR | O_CREAT | O_TRUNC,
  'wx+' => O_RDWR | O_CREAT | O_EXCL,
  a     => O_WRONLY | O_CREAT | O_APPEND,
  ax    => O_WRONLY | O_CREAT | O_APPEND | O_EXCL,

  'a+'  => O_RDWR | O_CREAT | O_APPEND,
  'ax+' => O_RDWR | O_CREAT | O_APPEND | O_EXCL,
);

# self, fh, path, mode, perm?
sub sysopen ($, $, $, $, @) {
  croak "Bad mode $_[3]" unless exists $open_map{$_[3]};
  &CORE::sysopen($_[1], $_[0]->path2real($_[2]), $open_map{$_[3]}, (defined($_[4]) ? $_[4] : ()))
    or croak "sysopen: $!";
}


sub sysseek ($self, $fh, $pos, $whence = 'start') {
  croak "Bad whence $whence" unless exists $seek_map{$whence};
  &CORE::sysseek($fh, $pos, $seek_map{$whence}) // croak "Can't sysseek $!";
}

sub syswrite ($, $, $, @) {    # other lengh, scalar offset
  shift;
  &CORE::syswrite(@_) // croak "Can't write: $!";
}

sub sysread ($, $, $, $, @) {    # @other = string offset
  shift;
  &CORE::sysread(@_) // croak "Can't read: $!";
}

sub unlink ($self, $path) {
  unlink $self->path2real($path) or croak "$path $!";
}

sub remove_tree ($self, $path, $opts = {}) {
  my $real = $self->path2real($path);
  croak "remove_tree $real: Not a directory" unless $self->stat($path)->is_dir;
  File::Path::remove_tree($real, {%$opts, error => \my $err});
  croak join('; ', map { $_->%* } @$err) if @$err;    # TODO: test
}

sub ls ($self, $path) {
  my $real = $self->path2real($path);
  opendir(my $dh, $real) || croak "Can't opendir $real: $!";
  my @result = grep { $_ ne '.' && $_ ne '..' } readdir($dh);
  closedir $dh;
  @result;
}

my %flock_map = (
  ex    => LOCK_EX,
  ex_nb => LOCK_EX | LOCK_NB,
  sh    => LOCK_SH,
  sh_nb => LOCK_SH | LOCK_NB,
  un    => LOCK_UN
);


sub flock ($self, $fh, $flag) {
  croak "Bad flag $flag" unless exists $flock_map{$flag};
  my $res = flock($fh, $flock_map{$flag});
  croak "$!" unless $res || $! == EAGAIN || $! == EWOULDBLOCK;
  $res;
}

sub open ($self, $path, $mode, @rest) {
  $self->make_tree((fileparse($path))[1]) unless ($mode eq 'r' && $mode eq 'r+');
  $self->sysopen(my $fh, $path, $mode, @rest);
  $fh;
}


sub append ($self, $path, $) {
  my $fh = $self->open($path, 'a');
  $self->flock($fh, 'ex');
  $self->syswrite($fh, $_[2]);
  $self->flock($fh, 'un');
  CORE::close $fh;
  return;
}

# don't copy 3rd arg
sub write ($self, $path, $) {
  my $fh = $self->open($path, 'w');
  $self->flock($fh, 'ex');
  $self->syswrite($fh, $_[2]);
  $self->flock($fh, 'un');
  CORE::close $fh;
  return;
}

sub read_ref ($self, $path) {
  my $fh = $self->open($path, 'r');
  $self->flock($fh, 'sh');
  $self->sysread($fh, \my $buf, $self->stat($path)->size);
  $self->flock($fh, 'un');
  CORE::close $fh;
  \$buf;
}

sub read ($self, $path) {
  $self->read_ref($path)->$*;
}

sub write_many ($self, %map) {
  $self->write($_, $map{$_}) for keys %map;
  $self;
}

sub find_files ($self, $start, $fhs_fn, $pick = undef) {
  my %seen;
  my $fn = sub ($path) {
    my $stat = $self->stat($path);
    return unless $stat->is_file;
    $fhs_fn->($path);
  };
  $self->traverse($start, $fn, $pick);
}

# make faster?
sub traverse ($self, $start, $fn, $pick_d = undef) {

  $start = [$start] unless ref $start eq 'ARRAY';
  my %seen_dirs;        # don't go into the same dir twice
  my %seen_children;    # don't fire the same file twice

  my @stack = map { Evo::Path->new(base => $_); } map {
    my $path = $_;
    my $stat = $self->stat($path);
    $seen_dirs{($stat->dev, '-', $stat->ino)}++ ? () : ($path);
  } reverse $start->@*;

  while (@stack) {
    my $cur_dir = pop @stack;

    my (@dirs, @children);
    foreach my $cur_child (sort $self->ls($cur_dir)) {

      my $path = $cur_dir->append($cur_child);
      next unless $self->exists($path);    # broken link
      my $stat = $self->stat($path);


      my $bool
        = $stat->is_dir
        && $stat->can_exec
        && $stat->can_read
        && !$seen_dirs{$stat->dev, '-', $stat->ino}++
        && (!$pick_d || $pick_d->($path));

      unshift @dirs, $path if $bool;
      push @children, $path if !$seen_children{$stat->dev, '-', $stat->ino}++;

    }
    $fn->($_) for @children;
    push @stack, @dirs;
  }
}

my sub _copy_file ($self, $from, $to) {
  File::Copy::cp $self->path2real($from), $self->path2real($to) or die "Copy failed: $!";
}

sub copy_dir ($self, $from, $to) {
  $to = Evo::Path->new(base => $to);
  $self->make_tree($to);
  my @stack = ($from);
  while (@stack) {
    my $cur_dir = shift @stack;
    $self->traverse(
      $cur_dir,
      sub($path) {
        my $stat = $self->stat($path);
        my $dest = $to->append(join '/', $path->children->@*);
        if ($stat->is_dir) {
          $self->mkdir($dest) unless $self->exists($dest);
        }
        elsif ($stat->is_file) {
          _copy_file($self, $path, $dest);
        }

        #else { croak "Can't copy $path, not a dir neither a file"; }
      }
    );
  }
}

sub copy_file ($self, $from, $to) {
  $self->make_tree((fileparse($to))[1]);
  _copy_file($self, $from, $to);
}

# ========= MODULE =========

my $FSROOT = __PACKAGE__->new(root => '/');
sub FSROOT : Export {$FSROOT}


1;

__END__