File Coverage

blib/lib/File/Tempdir/ForPackage.pm

Criterion	Covered	Total	%
statement	23	63	36.5
branch	0	14	0.0
condition	0	3	0.0
subroutine	8	14	57.1
pod	3	3	100.0
total	34	97	35.0

use 5.006;
use strict;
use warnings;

package File::Tempdir::ForPackage;

our $VERSION = '1.000002';

# ABSTRACT: Easy temporary directories associated with packages.

our $AUTHORITY = 'cpan:KENTNL'; # AUTHORITY

use Carp qw( croak );
use Moo qw( has );
use File::Temp qw();
## no critic (Subroutines::ProhibitCallsToUnexportedSubs)
use constant MINX => File::Temp::MINX;
## use critic

















has package => (
  is   => ro =>,
  lazy => 1,
  default => sub { scalar [ caller 1 ]->[0] },
);


















































has with_version   => ( is => ro =>, lazy => 1, default => sub { undef } );
has with_timestamp => ( is => ro =>, lazy => 1, default => sub { undef } );
has with_pid       => ( is => ro =>, lazy => 1, default => sub { undef } );
has num_random     => (
  is  => 'ro',
  isa => sub {
    return if $_[0] >= MINX();
    croak( "num_random ( $_[0] ) must be >= " . MINX() );
  },
  default => sub { 8 },
);







has '_preserve' => ( is => rw =>, init_arg => 'preserve', lazy => 1, default => sub { 0 } );







has _dir => ( is => 'lazy', clearer => 1, predicate => 1 );

























sub preserve {
  my ( $self, @args ) = @_;
  if ( @args and not $args[0] ) {
    $self->_preserve(0);
    $self->_dir->unlink_on_destroy(1);
    return;
  }
  $self->_preserve(1);
  $self->_dir->unlink_on_destroy(0);
  return 1;
}







sub _clean_pkg {
  my ($package) = @_;
  $package =~ s/::/-/gsmx;
  $package =~ s/[^\w-]+/_/gsmx;
  return $package;
}







sub _clean_ver {
  my ($ver) = @_;
  return 'versionundef' if not defined $ver;
  $ver =~ s/[^v\d_.]+/_/gsmx;
  return $ver;
}







sub _build__dir {
  my ($self) = shift;

  my $template = q{perl-};
  $template .= _clean_pkg( $self->package );

  if ( $self->with_version ) {
    $template .= q{-} . _clean_ver( $self->package->VERSION );
  }
  if ( $self->with_timestamp ) {
    $template .= q{-} . time;
  }
  if ( $self->with_pid ) {
    ## no critic ( ProhibitPunctuationVars )
    $template .= q{-} . $$;
  }
  $template .= q{-} . ( 'X' x $self->num_random );

  my $dir = File::Temp->newdir( TEMPLATE => $template, TMPDIR => 1 );
  if ( $self->_preserve ) {
    $dir->unlink_on_destroy(0);
  }
  return $dir;
}









sub dir {
  my ($self) = shift;
  return $self->_dir . q[];
}
















sub run_once_in {
  my ( $self, $options, $code ) = @_;
  $code = $options unless defined $code;
  require File::pushd;
  {
    ## no critic (Variables::ProhibitUnusedVarsStricter)
    my $marker = File::pushd::pushd( $self->dir );
    $code->( $self->dir );
  }

  # Dir POP.
  $self->_clear_dir;
  return $self;
}

no Moo;

1;

__END__