diff --git a/Changes b/Changes index c127ba5..f4d653e 100644 --- a/Changes +++ b/Changes @@ -2,6 +2,7 @@ - add AppVeyor CI - Add PERMS options to create temp file with given file permissions - Document exportable functions, constants and :tags + - Add WRITE_ONLY option to open temp file with O_WRONLY 0.2309 2019-01-06 20:29:15Z - fix longstanding pod formatting error (issue #19, RT#109526) diff --git a/lib/File/Temp.pm b/lib/File/Temp.pm index cc64cdc..d1cb584 100644 --- a/lib/File/Temp.pm +++ b/lib/File/Temp.pm @@ -308,6 +308,7 @@ my %FILES_CREATED_BY_OBJECT; # Usually irrelevant on unix # "use_exlock" => Indicates that O_EXLOCK should be used. Default is false. # "file_permissions" => file permissions for sysopen(). Default is 0600. +# "write_only" => Indicates that O_WRONLY should be used. Default is false. # Optionally a reference to a scalar can be passed into the function # On error this will be used to store the reason for the error @@ -506,13 +507,16 @@ sub _gettemp { # Attempt to open the file my $open_success = undef; if ( $^O eq 'VMS' and $options{"unlink_on_close"} && !$KEEP_ALL) { + my $flags = $OPENFLAGS; + $flags = ($flags & ~O_RDWR) | O_WRONLY if $options{write_only}; # make it auto delete on close by setting FAB$V_DLT bit - $fh = VMS::Stdio::vmssysopen($path, $OPENFLAGS, $perms, 'fop=dlt'); + $fh = VMS::Stdio::vmssysopen($path, $flags, $perms, 'fop=dlt'); $open_success = $fh; } else { my $flags = ( ($options{"unlink_on_close"} && !$KEEP_ALL) ? $OPENTEMPFLAGS : $OPENFLAGS ); + $flags = ($flags & ~O_RDWR) | O_WRONLY if $options{write_only}; $flags |= $LOCKFLAG if (defined $LOCKFLAG && $options{use_exlock}); $open_success = sysopen($fh, $path, $flags, $perms); } @@ -1053,7 +1057,7 @@ that the temporary file is removed by the object destructor if UNLINK is set to true (the default). Supported arguments are the same as for C: UNLINK -(defaulting to true), DIR, EXLOCK, PERMS and SUFFIX. +(defaulting to true), DIR, EXLOCK, WRITE_ONLY and SUFFIX. Additionally, the filename template is specified using the TEMPLATE option. The OPEN option is not supported (the file is always opened). @@ -1370,6 +1374,11 @@ Use C to change this: ($fh, $filename) = tempfile($template, PERMS => 0666); +Normally, the temporary filehandle is opened for both reading +and writing. To open for writing only, use C. + + ($fh, $filename) = tempfile($template, WRITE_ONLY => 1); + Options can be combined as required. Will croak() if there is an error. @@ -1384,6 +1393,8 @@ EXLOCK flag available since 0.19. PERMS flag available since 0.24. +WRITE_ONLY flag available since 0.24. + =cut sub tempfile { @@ -1402,6 +1413,7 @@ sub tempfile { "TMPDIR" => 0, # Place tempfile in tempdir if template specified "EXLOCK" => 0, # Open file with O_EXLOCK "PERMS" => undef, # File permissions + "WRITE_ONLY" => 0, # Open file with O_WRONLY ); # Check to see whether we have an odd or even number of arguments @@ -1485,6 +1497,7 @@ sub tempfile { "ErrStr" => \$errstr, "use_exlock" => $options{EXLOCK}, "file_permissions" => $options{PERMS}, + "write_only" => $options{WRITE_ONLY}, ) ); # Set up an exit handler that can do whatever is right for the diff --git a/t/tempfile.t b/t/tempfile.t index baef313..7f51cbd 100644 --- a/t/tempfile.t +++ b/t/tempfile.t @@ -2,7 +2,7 @@ # Test for File::Temp - tempfile function use strict; -use Test::More tests => 30; +use Test::More tests => 35; use File::Spec; use Cwd qw/ cwd /; @@ -95,8 +95,36 @@ push(@files, File::Spec->rel2abs($tempfile)); DIR => $tempdir, ); - ok( (-f $tempfile ), "Local tempfile in tempdir exists"); +{ + # Catch warning when reading from write-only filehandle + # or writing to read-only filehandle. + my $e; + local $SIG{__WARN__} = sub { $e++ }; + print $fh 42; + <$fh>; + ok( !$e, "...and filehandle opened for reading and writing" ); +} +push(@files, File::Spec->rel2abs($tempfile)); + +# Test tempfile +# ..and write-only this time +($fh, $tempfile) = tempfile( + DIR => $tempdir, + WRITE_ONLY => 1, + ); + +ok( (-f $tempfile ), "Local WRITE_ONLY tempfile in tempdir exists"); +{ + # Catch warning when reading from write-only filehandle + # or writing to read-only filehandle. + my $e; + local $SIG{__WARN__} = sub { $e++ }; + print $fh 42; + ok( !$e, "...and filehandle opened for writing" ); + <$fh>; + ok( $e, "...but not reading" ); +} push(@files, File::Spec->rel2abs($tempfile)); # Test tempfile