env dir code

[scpubgit/DKit.git] / lib / DX / Lib / FS / Guts.pm

package DX::Lib::FS::Guts;

use File::stat;
use File::Copy;
use Fcntl qw(O_CREAT O_WRONLY);
use POSIX qw(ENOENT);
use Moo;

sub create_directory {
  my ($self, $path, $mode) = @_;
  if (defined $mode) {
    my $umask = umask(0000);
    mkdir($path, oct($mode))
      or do { umask($umask); die "Couldn't mkdir ${path}: $!" };
    umask($umask);
  } else {
    mkdir($path) or die "Couldn't mkdir ${path}: $!";
  }
  return;
}

sub create_file {
  my ($self, $path, $mode, $data) = @_;
  my $fh;
  if (defined $mode) {
    my $umask = umask(0000);
    sysopen(
      $fh, $path, O_CREAT | O_WRONLY, oct($mode)
    ) or do { umask($umask); die "Couldn't create ${path}: $!" };
    umask($umask);
  } else {
    sysopen($fh, $path, O_CREAT | O_WRONLY)
      or die "Couldn't create ${path}: $!";
  }
  print $fh $data if length($data);
  return;
}

sub set_path_mode {
  my ($self, $path, $mode) = @_;
  chmod oct($mode), $path
    or die "Failed to chmod ${path} to ${mode}: $!";
  return;
}

sub rewrite_file {
  my ($self, $path, $final_content) = @_;
  my $stat = stat($path) or die "Couldn't stat ${path}: $!";
  my $perms = $stat->mode & 07777;
  my $new = $path.'.new';
  unlink($new);
  sysopen my $fh, $new, O_CREAT | O_WRONLY, $perms
    or die "Couldn't open ${new}: $!";
  print $fh $final_content
    or die "Couldn't write data to ${new}: $!";
  close $fh;
  move($new, $path) or die "Couldn't install ${new}: $!";
  return;
}

sub path_status_info {
  my ($self, $path) = @_;
  if (my $stat = stat($path)) {
    return +{
      is_directory => -d _,
      is_file => -f _,
      mode => sprintf("%04o", ($stat->mode & 07777))
    };
  } elsif ($! == ENOENT) {
    return undef;
  } else {
    die "Couldn't stat ${path}: $!";
  }
}

sub file_content {
  my ($self, $path) = @_;
  return undef unless -e $path;
  my $data = do {
    open my $fh, '<', $path or die "Couldn't open ${path}: $!";
    local $/;
    readline($fh)
  };
  return $data;
}

sub env_dir {
  my ($self, $key) = @_;
  $key =~ s/^\.\///;
  return $ENV{$key}|| die "${key} not set";
}

1;