File Coverage

blib/lib/File/Fu/Dir/Temp.pm

Criterion	Covered	Total	%
statement	50	59	84.7
branch	5	8	62.5
condition			n/a
subroutine	13	17	76.4
pod	5	5	100.0
total	73	89	82.0

package File::Fu::Dir::Temp;
$VERSION = v0.0.8;

use warnings;
use strict;
use Carp;

=begin shutup_pod_cover

=head2 clone

=head2 XXX

=end shutup_pod_cover

=cut

use File::Fu::File::Temp;
  *_validate = \&File::Fu::File::Temp::_validate;
  *XXX = \&File::Fu::File::Temp::XXX;

=head1 NAME

File::Fu::Dir::Temp - temporary directories

=head1 SYNOPSIS

  use File::Fu;
  my $dir = File::Fu->temp_dir;

=cut

use base 'File::Fu::Dir';
use overload (
  '/=' => sub {croak("cannot mutate a temp dir");},
  '+=' => sub {croak("cannot mutate a temp dir");},
  '.=' => sub {croak("cannot mutate a temp dir");},
);

use Class::Accessor::Classy;
rs auto_delete => \(my $set_auto_delete);
rs dir_class => \(my $set_dir_class);
no  Class::Accessor::Classy;

=head2 new

  my $tmp = File::Fu::Dir::Temp->new($dir, 'foo');

=cut

{
my %argmap = (
  nocleanup => [UNLINK => 0],
);
sub new {
  my $proto = shift;
  if(ref($proto)) { # calls to subdir, etc are not in the Temp class
    return $proto->dir_class->new(@_);
  }
  my $class = $proto;
  #warn "args: @_";
  my ($dir, $send, $opt) = $class->_validate(\%argmap, @_);

  #warn "dir: $dir";
  #warn "opts: @$send";
  my $temp = File::Temp::tempdir(@$send);
  my $self = $class->SUPER::new($temp);
  $self->{$_} = $opt->{$_} for(keys(%$opt));
  $self->{_proc} = $$;
  $self->$set_dir_class(ref($dir));

  return($self);
}} # end subroutine new definition
########################################################################

=head2 chdir

  my $dir = $dir->chdir;

=cut

sub chdir {
  my $self = shift;

  my $dir = $self->SUPER::chdir;
  $dir->{temp_parent} = $self;
  return($dir);
} # chdir ##############################################################

=for nit head2 clone
Because clone doesn't call new :-/
  $not_temp = $temp->clone;

=cut

sub clone {
  my $self = shift;
  $self = $self->SUPER::clone;
  bless($self, $self->dir_class);
} # end subroutine clone definition
########################################################################

=head2 rename

Same as the base rename(), but promotes the temp dir to a regular Dir
object (prevents any cleanup actions.)

  $temp = $temp->rename($dest);

=cut

sub rename {
  my $self = shift;
  my $dir_class = $self->dir_class;
  $self = $self->SUPER::rename(@_);
  bless($self, $dir_class);
  return($self);
}

# TODO File::Fu->temp_dir->chdir causes immediate deletion?

=head2 nocleanup

Disable autocleanup.

  $dir->nocleanup;

=cut

# XXX I think this is named wrong -- should probably just delete the
# dependency on File::Temp because I can't override that END block
sub nocleanup {
  my $self = shift;
  $self->$set_auto_delete(0);
} # end subroutine nocleanup definition
########################################################################

=head2 DESTROY

Called automatically when the object goes out of scope.

  $dir->DESTROY;

=cut

sub DESTROY {
  my $self = shift;

  # ? should this have:
  return unless($self->auto_delete);

  # forked case
  return unless($$ == $self->{_proc});

  my $string = $self->stringify;
  #warn "DESTROY ($$/$self->{_proc}", $string;
  # XXX overload stops operating in DESTROY()?

  die("$string does not exist") unless(-d $string);
  $self->remove;
  $self->{auto_delete} = 0;
} # end subroutine DESTROY definition
########################################################################

=head1 AUTHOR

Eric Wilhelm @

http://scratchcomputing.com/

=head1 BUGS

If you found this module on CPAN, please report any bugs or feature
requests through the web interface at L.  I will be
notified, and then you'll automatically be notified of progress on your
bug as I make changes.

If you pulled this development version from my /svn/, please contact me
directly.

=head1 COPYRIGHT

Copyright (C) 2008 Eric L. Wilhelm, All Rights Reserved.

=head1 NO WARRANTY

Absolutely, positively NO WARRANTY, neither express or implied, is
offered with this software.  You use this software at your own risk.  In
case of loss, no person or entity owes you anything whatsoever.  You
have been warned.

=head1 LICENSE

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut

# vi:ts=2:sw=2:et:sta
1;