File Coverage

lib/File/Tempdir/ForPackage.pm
Criterion Covered Total %
statement 24 64 37.5
branch 0 14 0.0
condition 0 3 0.0
subroutine 8 14 57.1
pod 3 3 100.0
total 35 98 35.7


line stmt bran cond sub pod time code
1 1     1   1447 use 5.006;
  1         4  
  1         39  
2 1     1   6 use strict;
  1         2  
  1         41  
3 1     1   16 use warnings;
  1         2  
  1         69  
4              
5             package File::Tempdir::ForPackage;
6              
7             our $VERSION = '1.000001';
8              
9             # ABSTRACT: Easy temporary directories associated with packages.
10              
11             our $AUTHORITY = 'cpan:KENTNL'; # AUTHORITY
12              
13 1     1   5 use Carp qw( croak );
  1         2  
  1         74  
14 1     1   857 use Moo qw( has );
  1         22422  
  1         7  
15 1     1   4586 use File::Temp qw();
  1         32012  
  1         43  
16             ## no critic (Subroutines::ProhibitCallsToUnexportedSubs)
17 1     1   8 use constant MINX => File::Temp::MINX;
  1         3  
  1         898  
18             ## use critic
19              
20              
21              
22              
23              
24              
25              
26              
27              
28              
29              
30              
31              
32              
33              
34              
35              
36             has package => (
37             is => ro =>,
38             lazy => 1,
39             default => sub { scalar [ caller 1 ]->[0] },
40             );
41              
42              
43              
44              
45              
46              
47              
48              
49              
50              
51              
52              
53              
54              
55              
56              
57              
58              
59              
60              
61              
62              
63              
64              
65              
66              
67              
68              
69              
70              
71              
72              
73              
74              
75              
76              
77              
78              
79              
80              
81              
82              
83              
84              
85              
86              
87              
88              
89              
90              
91             has with_version => ( is => ro =>, lazy => 1, default => sub { undef } );
92             has with_timestamp => ( is => ro =>, lazy => 1, default => sub { undef } );
93             has with_pid => ( is => ro =>, lazy => 1, default => sub { undef } );
94             has num_random => (
95             is => 'ro',
96             isa => sub {
97             return if $_[0] >= MINX();
98             croak( "num_random ( $_[0] ) must be >= " . MINX() );
99             },
100             default => sub { 8 },
101             );
102              
103              
104              
105              
106              
107              
108              
109             has '_preserve' => ( is => rw =>, init_arg => 'preserve', lazy => 1, default => sub { 0 } );
110              
111              
112              
113              
114              
115              
116              
117             has _dir => ( is => 'lazy', clearer => 1, predicate => 1 );
118              
119              
120              
121              
122              
123              
124              
125              
126              
127              
128              
129              
130              
131              
132              
133              
134              
135              
136              
137              
138              
139              
140              
141              
142              
143             sub preserve {
144 0     0 1   my ( $self, @args ) = @_;
145 0 0 0       if ( @args and not $args[0] ) {
146 0           $self->_preserve(0);
147 0           $self->_dir->unlink_on_destroy(1);
148 0           return;
149             }
150 0           $self->_preserve(1);
151 0           $self->_dir->unlink_on_destroy(0);
152 0           return 1;
153             }
154              
155              
156              
157              
158              
159              
160              
161             sub _clean_pkg {
162 0     0     my ($package) = @_;
163 0           $package =~ s/::/-/gsmx;
164 0           $package =~ s/[^\w-]+/_/gsmx;
165 0           return $package;
166             }
167              
168              
169              
170              
171              
172              
173              
174             sub _clean_ver {
175 0     0     my ($ver) = @_;
176 0 0         return 'versionundef' if not defined $ver;
177 0           $ver =~ s/[^v\d_.]+/_/gsmx;
178 0           return $ver;
179             }
180              
181              
182              
183              
184              
185              
186              
187             sub _build__dir {
188 0     0     my ($self) = shift;
189              
190 0           my $template = q{perl-};
191 0           $template .= _clean_pkg( $self->package );
192              
193 0 0         if ( $self->with_version ) {
194 0           $template .= q{-} . _clean_ver( $self->package->VERSION );
195             }
196 0 0         if ( $self->with_timestamp ) {
197 0           $template .= q{-} . time;
198             }
199 0 0         if ( $self->with_pid ) {
200             ## no critic ( ProhibitPunctuationVars )
201 0           $template .= q{-} . $$;
202             }
203 0           $template .= q{-} . ( 'X' x $self->num_random );
204              
205 0           my $dir = File::Temp->newdir( TEMPLATE => $template, TMPDIR => 1 );
206 0 0         if ( $self->_preserve ) {
207 0           $dir->unlink_on_destroy(0);
208             }
209 0           return $dir;
210             }
211              
212              
213              
214              
215              
216              
217              
218              
219              
220             sub dir {
221 0     0 1   my ($self) = shift;
222 0           return $self->_dir . q[];
223             }
224              
225              
226              
227              
228              
229              
230              
231              
232              
233              
234              
235              
236              
237              
238              
239              
240             sub run_once_in {
241 0     0 1   my ( $self, $options, $code ) = @_;
242 0 0         $code = $options unless defined $code;
243 0           require File::pushd;
244             {
245             ## no critic (Variables::ProhibitUnusedVarsStricter)
246 0           my $marker = File::pushd::pushd( $self->dir );
  0            
247 0           $code->( $self->dir );
248             }
249              
250             # Dir POP.
251 0           $self->_clear_dir;
252 0           return $self;
253             }
254              
255 1     1   7 no Moo;
  1         2  
  1         9  
256              
257             1;
258              
259             __END__