package Dir::TempChdir;

use strict;
use warnings;

use Carp ();
use Config ();
use Cwd ();
use Scalar::Util ();

use overload
  '""' => \&Cwd::getcwd,
  fallback => 1
  ;

BEGIN {
  require Exporter;
  our @ISA = qw(Exporter);
  our @EXPORT = ();
  our @EXPORT_OK = ();
  our @EXPORT_TAGS = ();
}

our $VERSION = '0.01';
$VERSION = eval $VERSION; # so "use Module 0.002" won't warn on underscore

my $_FINAL_ERRNO;
my $_FINAL_ERROR;
my $_USE_PATH_FOR_CHDIR = 0;

sub new {
  my $class = shift;
  my $dir = shift;

  my $self = bless {
    _stack => [],
    _last_errno => undef,
    _last_error => undef,
    _initialized => 0,
  }, $class;

  if (defined $dir && !$self->pushd($dir)) {
    return undef;
  }

  $self->{_initialized}++;
  return $self;
}

sub _clear_errors {
  my $self = shift;
  undef $self->{_last_errno};
  undef $self->{_last_error};
}

sub pushd {
  my $self = shift;
  my $dir = shift;

  my $fn;
  # Perl < 5.22 had no newfangled nonsense like the fileno of a dir handle.
  my $dirname = ref($dir) && defined($fn = fileno $dir) ? "fileno:$fn" : $dir;

  my $cwd = Cwd::getcwd();
  $cwd = sprintf('[%d:%s]', $!, $!) unless defined $cwd;

  if (! opendir my $dh, '.') {
    $self->{_last_error} = "pushd($dirname): opendir(.) failed: $! [cwd:$cwd]";
  }
  elsif (! chdir $dir) {
    $self->{_last_error} = "pushd($dirname): chdir() failed: $! [cwd:$cwd]";
  }
  else {
    $self->_clear_errors();
    push @{$self->{_stack}}, { dh => $dh, path => $cwd };
    return $self;
  }

  $self->{_last_errno} = $!;
  return undef;
}

sub popd {
  my $self = shift;

  my $d = pop @{$self->{_stack}};
  if (defined $d) {
    if (chdir($_USE_PATH_FOR_CHDIR ? $d->{path} : $d->{dh})) {
      $self->_clear_errors();
      return $self;
    }
    $self->{_last_errno} = $!;
    $self->{_last_error} =
      "popd() couldn't chdir() to (assumedly) $d->{path}: $!";
  }
  elsif ($self->{_initialized}) {
    undef $!;
    $self->_clear_errors();
  }

  return undef;
}

sub backout {
  my $self = shift;

  splice @{$self->{_stack}}, 1;
  return $self->popd();
}

sub stack_size {
  my $self = shift;
  return scalar @{$self->{_stack}};
}

sub errno {
  my $self = shift;
  return Scalar::Util::blessed($self) ? $self->{_last_errno} : $_FINAL_ERRNO;
}

sub error {
  my $self = shift;
  return Scalar::Util::blessed($self) ? $self->{_last_error} : $_FINAL_ERROR;
}

sub DESTROY {
  my $self = shift;

  local($., $@, $!, $^E, $?); # recommended by perldoc perlobj
  if ($self->backout()) {
    undef $_FINAL_ERRNO;
    undef $_FINAL_ERROR;
  }
  else {
    $_FINAL_ERRNO = $self->{_last_errno};
    $_FINAL_ERROR = $self->{_last_error};
  }
}

sub import {
  my $this = shift;

  my @args = grep !$_ || $_ ne '-IGNORE_UNSAFE_CHDIR_SECURITY_RISK', @_;
  my $HAVE_IGNORE_UNSAFE_CHDIR_SECURITY_RISK = @args < @_;

  if ($Config::Config{d_fchdir}) {
    $_USE_PATH_FOR_CHDIR = 0;
    if ($HAVE_IGNORE_UNSAFE_CHDIR_SECURITY_RISK) {
      Carp::carp(
        'Useless -IGNORE_UNSAFE_CHDIR_SECURITY_RISK on fchdir() capable system'
      );
    }
  }
  elsif ($HAVE_IGNORE_UNSAFE_CHDIR_SECURITY_RISK) {
    $_USE_PATH_FOR_CHDIR = 1;
  }
  else {
    Carp::croak('This system lacks support for fchdir()');
  }

  __PACKAGE__->export_to_level(1, $this, @args);
}

1;
