Add WRITE_ONLY option to open temp file with O_WRONLY

Author: timgimyee

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)

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<tempfile>: 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<WRITE_ONLY>.
+
+  ($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

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