From 5d28bd099c0b953d6e73885098e879c919bfc25c Mon Sep 17 00:00:00 2001
From: Tim Gim Yee <tim.gim.yee@gmail.com>
Date: Wed, 24 Oct 2018 13:54:29 -0700
Subject: [PATCH] Add WRITE_ONLY option to open temp file with O_WRONLY

---
 Changes          |  1 +
 lib/File/Temp.pm | 17 +++++++++++++++--
 t/tempfile.t     | 32 ++++++++++++++++++++++++++++++--
 3 files changed, 46 insertions(+), 4 deletions(-)

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..baafe87 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<tempfile>: UNLINK
-(defaulting to true), DIR, EXLOCK, PERMS and SUFFIX.
+(defaulting to true), DIR, EXLOCK, PERMS, 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<PERMS> 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<WRITE_ONLY>.
+
+  ($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