1package FFI::Temp;
2
3use strict;
4use warnings;
5use 5.008004;
6use Carp qw( croak );
7use File::Spec;
8use File::Temp qw( tempdir );
9
10# ABSTRACT: Temp Dir support for FFI::Platypus
11our $VERSION = '1.56'; # VERSION
12
13
14# problem with vanilla File::Temp is that is often uses
15# as /tmp that has noexec turned on.  Workaround is to
16# create a temp directory in the build directory, but
17# we have to be careful about cleanup.  This puts all that
18# (attempted) carefulness in one place so that when we
19# later discover it isn't so careful we can fix it in
20# one place rather thabn alllll the places that we need
21# temp directories.
22
23my %root;
24
25sub _root
26{
27  my $root = File::Spec->rel2abs(File::Spec->catdir(".tmp"));
28  my $lock = File::Spec->catfile($root, "l$$");
29
30  foreach my $try (0..9)
31  {
32    sleep $try if $try != 0;
33    mkdir $root or die "unable to create temp root $!" unless -d $root;
34
35    # There is a race condition here if the FFI::Temp is
36    # used in parallel.  To work around we run this 10
37    # times until it works.  There is still a race condition
38    # if it fails 10 times, but hopefully that is unlikely.
39
40    # ??: doesn't account for fork, but probably doesn't need to.
41    open my $fh, '>', $lock or next;
42    close $fh or next;
43
44    $root{$root} = 1;
45    return $root;
46  }
47}
48
49END {
50  foreach my $root (keys %root)
51  {
52    my $lock = File::Spec->catfile($root, "l$$");
53    unlink $lock;
54    # try to delete if possible.
55    # if not possible then punt
56    rmdir $root if -d $root;
57  }
58}
59
60sub newdir
61{
62  my $class = shift;
63  croak "uneven" if @_ % 2;
64  File::Temp->newdir(DIR => _root, @_);
65}
66
67sub new
68{
69  my $class = shift;
70  croak "uneven" if @_ % 2;
71  File::Temp->new(DIR => _root, @_);
72}
73
741;
75
76__END__
77
78=pod
79
80=encoding UTF-8
81
82=head1 NAME
83
84FFI::Temp - Temp Dir support for FFI::Platypus
85
86=head1 VERSION
87
88version 1.56
89
90=head1 DESCRIPTION
91
92This class is private to L<FFI::Platypus>.
93
94=head1 AUTHOR
95
96Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
97
98Contributors:
99
100Bakkiaraj Murugesan (bakkiaraj)
101
102Dylan Cali (calid)
103
104pipcet
105
106Zaki Mughal (zmughal)
107
108Fitz Elliott (felliott)
109
110Vickenty Fesunov (vyf)
111
112Gregor Herrmann (gregoa)
113
114Shlomi Fish (shlomif)
115
116Damyan Ivanov
117
118Ilya Pavlov (Ilya33)
119
120Petr Písař (ppisar)
121
122Mohammad S Anwar (MANWAR)
123
124Håkon Hægland (hakonhagland, HAKONH)
125
126Meredith (merrilymeredith, MHOWARD)
127
128Diab Jerius (DJERIUS)
129
130Eric Brine (IKEGAMI)
131
132szTheory
133
134José Joaquín Atria (JJATRIA)
135
136Pete Houston (openstrike, HOUSTON)
137
138=head1 COPYRIGHT AND LICENSE
139
140This software is copyright (c) 2015,2016,2017,2018,2019,2020 by Graham Ollis.
141
142This is free software; you can redistribute it and/or modify it under
143the same terms as the Perl 5 programming language system itself.
144
145=cut
146