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