Commit | Line | Data |
51fc852f |
1 | #!/usr/local/bin/perl -w |
262eb13a |
2 | # Test for File::Temp - tempfile function |
3 | |
4 | use strict; |
21cc0ee1 |
5 | use Test; |
6bfdb090 |
6 | BEGIN { plan tests => 22} |
262eb13a |
7 | use File::Spec; |
262eb13a |
8 | |
9 | # Will need to check that all files were unlinked correctly |
51fc852f |
10 | # Set up an END block here to do it |
11 | |
12 | # Arrays containing list of dirs/files to test |
13 | my (@files, @dirs, @still_there); |
14 | |
15 | # And a test for files that should still be around |
16 | # These are tidied up |
17 | END { |
18 | foreach (@still_there) { |
19 | ok( -f $_ ); |
20 | ok( unlink( $_ ) ); |
21 | ok( !(-f $_) ); |
22 | } |
23 | } |
262eb13a |
24 | |
25 | # Loop over an array hoping that the files dont exist |
1c19c868 |
26 | END { foreach (@files) { ok( !(-e $_) )} } |
262eb13a |
27 | |
28 | # And a test for directories |
51fc852f |
29 | END { foreach (@dirs) { ok( !(-d $_) )} } |
1c19c868 |
30 | |
31 | # Need to make sure that the END blocks are setup before |
32 | # the ones that File::Temp configures since END blocks are evaluated |
33 | # in revers order and we need to check the files *after* File::Temp |
34 | # removes them |
35 | use File::Temp qw/ tempfile tempdir/; |
36 | |
37 | # Now we start the tests properly |
38 | ok(1); |
262eb13a |
39 | |
40 | |
41 | # Tempfile |
42 | # Open tempfile in some directory, unlink at end |
43 | my ($fh, $tempfile) = tempfile( |
44 | UNLINK => 1, |
45 | SUFFIX => '.txt', |
46 | ); |
47 | |
48 | ok( (-f $tempfile) ); |
09d7a2f9 |
49 | # Should still be around after closing |
50 | ok( close( $fh ) ); |
51 | ok( (-f $tempfile) ); |
52 | # Check again at exit |
262eb13a |
53 | push(@files, $tempfile); |
54 | |
55 | # TEMPDIR test |
56 | # Create temp directory in current dir |
57 | my $template = 'tmpdirXXXXXX'; |
58 | print "# Template: $template\n"; |
59 | my $tempdir = tempdir( $template , |
60 | DIR => File::Spec->curdir, |
61 | CLEANUP => 1, |
62 | ); |
63 | |
64 | print "# TEMPDIR: $tempdir\n"; |
65 | |
66 | ok( (-d $tempdir) ); |
67 | push(@dirs, $tempdir); |
68 | |
69 | # Create file in the temp dir |
70 | ($fh, $tempfile) = tempfile( |
71 | DIR => $tempdir, |
72 | UNLINK => 1, |
73 | SUFFIX => '.dat', |
74 | ); |
75 | |
76 | print "# TEMPFILE: Created $tempfile\n"; |
77 | |
78 | ok( (-f $tempfile)); |
79 | push(@files, $tempfile); |
80 | |
81 | # Test tempfile |
82 | # ..and again |
83 | ($fh, $tempfile) = tempfile( |
84 | DIR => $tempdir, |
85 | ); |
86 | |
87 | |
88 | ok( (-f $tempfile )); |
89 | push(@files, $tempfile); |
90 | |
6bfdb090 |
91 | # Test tempfile |
92 | # ..and another with changed permissions (read-only) |
93 | ($fh, $tempfile) = tempfile( |
05fb677a |
94 | DIR => $tempdir, |
95 | ); |
6bfdb090 |
96 | chmod 0444, $tempfile; |
97 | |
98 | ok( (-f $tempfile )); |
99 | push(@files, $tempfile); |
100 | |
262eb13a |
101 | print "# TEMPFILE: Created $tempfile\n"; |
102 | |
103 | # and another (with template) |
104 | |
105 | ($fh, $tempfile) = tempfile( 'helloXXXXXXX', |
106 | DIR => $tempdir, |
107 | UNLINK => 1, |
108 | SUFFIX => '.dat', |
109 | ); |
110 | |
111 | print "# TEMPFILE: Created $tempfile\n"; |
112 | |
113 | ok( (-f $tempfile) ); |
114 | push(@files, $tempfile); |
115 | |
51fc852f |
116 | |
117 | # Create a temporary file that should stay around after |
118 | # it has been closed |
119 | ($fh, $tempfile) = tempfile( 'permXXXXXXX', UNLINK => 0 ); |
120 | print "# TEMPFILE: Created $tempfile\n"; |
121 | ok( -f $tempfile ); |
122 | ok( close( $fh ) ); |
123 | push( @still_there, $tempfile); # check at END |
124 | |
09d7a2f9 |
125 | # Would like to create a temp file and just retrieve the handle |
126 | # but the test is problematic since: |
127 | # - We dont know the filename so we cant check that it is tidied |
128 | # correctly |
129 | # - The unlink0 required on unix for tempfile creation will fail |
130 | # on NFS |
131 | # Try to do what we can. |
132 | # Tempfile croaks on error so we need an eval |
133 | $fh = eval { tempfile( 'ftmpXXXXX', DIR => File::Spec->tmpdir ) }; |
134 | |
135 | if ($fh) { |
136 | |
137 | # print something to it to make sure something is there |
138 | ok( print $fh "Test\n" ); |
139 | |
140 | # Close it - can not check it is gone since we dont know the name |
141 | ok( close($fh) ); |
142 | |
143 | } else { |
144 | skip "Skip Failed probably due to NFS", 1; |
145 | skip "Skip Failed probably due to NFS", 1; |
146 | } |
147 | |
1c19c868 |
148 | # Now END block will execute to test the removal of directories |
09d7a2f9 |
149 | print "# End of tests. Execute END blocks\n"; |
1c19c868 |
150 | |