On Mon May 28 09:36:50 2012, sergei wrote:
Show quoted text> problem described in the test
here is possible patch for this problem
diff -uNr File-Slurp-9999.19.orig//lib/File/Slurp.pm File-Slurp-9999.19/lib/File/Slurp.pm
--- File-Slurp-9999.19.orig//lib/File/Slurp.pm 2011-05-30 23:58:53.000000000 +0400
+++ File-Slurp-9999.19/lib/File/Slurp.pm 2012-05-28 18:46:27.247849104 +0400
@@ -454,7 +454,7 @@
my $mode = O_WRONLY | O_CREAT ;
$mode |= O_APPEND if $opts->{'append'} ;
- $mode |= O_EXCL if $opts->{'no_clobber'} ;
+ $mode |= O_EXCL if $opts->{'no_clobber'} && !$opts->{'atomic'} ;
my $perms = $opts->{perms} ;
$perms = 0666 unless defined $perms ;
@@ -534,10 +534,28 @@
# handle the atomic mode - move the temp file to the original filename.
- if ( $opts->{'atomic'} && !rename( $file_name, $orig_file_name ) ) {
+ if ( $opts->{'atomic'} ) {
- @_ = ( $opts, "write_file '$file_name' - rename: $!" ) ;
- goto &_error ;
+ if ( $opts->{'no_clobber'} ) {
+
+ if ( !link( $file_name, $orig_file_name ) ) {
+
+ @_ = ( $opts, "write_file '$file_name' - link: $!" ) ;
+ unlink( $file_name );
+ goto &_error ;
+ }
+
+ unlink( $file_name );
+
+ } else {
+
+ if ( !rename( $file_name, $orig_file_name ) ) {
+
+ @_ = ( $opts, "write_file '$file_name' - rename: $!" ) ;
+ goto &_error ;
+ }
+
+ }
}
return 1 ;
diff -uNr File-Slurp-9999.19.orig//Makefile.PL File-Slurp-9999.19/Makefile.PL
--- File-Slurp-9999.19.orig//Makefile.PL 2011-03-13 10:29:42.000000000 +0300
+++ File-Slurp-9999.19/Makefile.PL 2012-05-28 18:42:45.135856505 +0400
@@ -13,6 +13,9 @@
perl => 5.004,
},
},
+ 'BUILD_REQUIRES' => {
+ 'Test::Exception' => 0,
+ },
'PREREQ_PM' => {
'Carp' => 0,
'Exporter' => 0,
diff -uNr File-Slurp-9999.19.orig//t/atomic_no_clobber.t File-Slurp-9999.19/t/atomic_no_clobber.t
--- File-Slurp-9999.19.orig//t/atomic_no_clobber.t 1970-01-01 03:00:00.000000000 +0300
+++ File-Slurp-9999.19/t/atomic_no_clobber.t 2012-05-28 18:43:27.759855085 +0400
@@ -0,0 +1,23 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use File::Slurp;
+use Test::More tests => 2;
+use Test::Exception;
+
+my $file = "xxx";
+my $option = {};
+my $data4write = "data1";
+File::Slurp::write_file($file, $option, $data4write);
+
+
+$option = {
+ atomic => 1,
+ no_clobber => 1,
+};
+dies_ok {File::Slurp::write_file($file, $option, "data2"); } 'atomic and no_clobber fail';
+my $data = File::Slurp::read_file($file);
+
+is($data, $data4write, 'no data change');
