File::pushd

package File::pushd;

$VERSION = '1.00';
@EXPORT  = qw( pushd tempd );
@ISA     = qw( Exporter );

use 5.004;
use strict;
#use warnings;
use Exporter;
use Carp;
use Cwd         qw( cwd abs_path );
use File::Path  qw( rmtree );
use File::Temp  qw();
use File::Spec;

use overload 
    q{""} => sub { File::Spec->canonpath( $_[0]->{_pushd} ) },
    fallback => 1;

#--------------------------------------------------------------------------#
# pushd()
#--------------------------------------------------------------------------#

sub pushd {
    my ($target_dir) = @_;
    
    my $orig = cwd;
    
    my $dest;
    eval { $dest   = $target_dir ? abs_path( $target_dir ) : $orig };
    
    croak "Can't locate directory $target_dir: $@" if $@;
    
    if ($dest ne $orig) { 
        chdir $dest or croak "Can't chdir to $dest\: $!";
    }

    my $self = bless { 
        _pushd => $dest,
        _original => $orig
    }, __PACKAGE__;

    return $self;
}

#--------------------------------------------------------------------------#
# tempd()
#--------------------------------------------------------------------------#

sub tempd {
    my $dir = pushd( File::Temp::tempdir( CLEANUP => 0 ) );
    $dir->{_tempd} = 1;
    return $dir;
}

#--------------------------------------------------------------------------#
# preserve()
#--------------------------------------------------------------------------#

sub preserve {
    my $self = shift;
    return 1 if ! $self->{"_tempd"};
    if ( @_ == 0 ) {
        return $self->{_preserve} = 1;
    }
    else {
        return $self->{_preserve} = $_[0] ? 1 : 0;
    }
}
    
#--------------------------------------------------------------------------#
# DESTROY()
# Revert to original directory as object is destroyed and cleanup
# if necessary
#--------------------------------------------------------------------------#

sub DESTROY {
    my ($self) = @_;
    my $orig = $self->{_original};
    chdir $orig if $orig; # should always be so, but just in case...
    if ( $self->{_tempd} && 
        !$self->{_preserve} ) {
        eval { rmtree( $self->{_pushd} ) };
        carp $@ if $@;
    }
}

1; #this line is important and will help the module return a true value
__END__