diff --git a/Changes b/Changes index c4d9458..6ccf299 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,6 @@ {{$NEXT}} - add AppVeyor CI + - 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 2dfc457..5dc7d2f 100644 --- a/lib/File/Temp.pm +++ b/lib/File/Temp.pm @@ -307,6 +307,7 @@ my %FILES_CREATED_BY_OBJECT; # use of the O_TEMPORARY flag to sysopen. # Usually irrelevant on unix # "use_exlock" => Indicates that O_EXLOCK should be used. Default is false. +# "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 @@ -501,13 +502,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, 0600, 'fop=dlt'); + $fh = VMS::Stdio::vmssysopen($path, $flags, 0600, '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, 0600); } @@ -1048,7 +1052,8 @@ 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 and SUFFIX. Additionally, the filename +(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). @@ -1359,6 +1364,11 @@ versions, explicitly set C<< EXLOCK=>0 >>. ($fh, $filename) = tempfile($template, EXLOCK => 1); +Normally, the temporary filehandle is opened for both reading +and writing. To open for writng only, use C. + + ($fh, $filename) = tempfile($template, WRITE_ONLY => 1); + Options can be combined as required. Will croak() if there is an error. @@ -1371,6 +1381,8 @@ TMPDIR flag available since 0.19. EXLOCK flag available since 0.19. +WRITE_ONLY flag available since 0.24. + =cut sub tempfile { @@ -1382,12 +1394,13 @@ sub tempfile { # Default options my %options = ( - "DIR" => undef, # Directory prefix - "SUFFIX" => '', # Template suffix - "UNLINK" => 0, # Do not unlink file on exit - "OPEN" => 1, # Open file - "TMPDIR" => 0, # Place tempfile in tempdir if template specified - "EXLOCK" => 0, # Open file with O_EXLOCK + "DIR" => undef, # Directory prefix + "SUFFIX" => '', # Template suffix + "UNLINK" => 0, # Do not unlink file on exit + "OPEN" => 1, # Open file + "TMPDIR" => 0, # Place tempfile in tempdir if template specified + "EXLOCK" => 0, # Open file with O_EXLOCK + "WRITE_ONLY" => 0, # Open file with O_WRONLY ); # Check to see whether we have an odd or even number of arguments @@ -1464,12 +1477,13 @@ sub tempfile { my ($fh, $path, $errstr); croak "Error in tempfile() using template $template: $errstr" unless (($fh, $path) = _gettemp($template, - "open" => $options{'OPEN'}, - "mkdir"=> 0 , + "open" => $options{OPEN}, + "mkdir" => 0, "unlink_on_close" => $unlink_on_close, - "suffixlen" => length($options{'SUFFIX'}), - "ErrStr" => \$errstr, - "use_exlock" => $options{EXLOCK}, + "suffixlen" => length($options{SUFFIX}), + "ErrStr" => \$errstr, + "use_exlock" => $options{EXLOCK}, + "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 3cb08d2..b18c005 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 => 28; +use Test::More tests => 33; 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