Skip Menu |
 

This queue is for tickets about the File-Slurp CPAN distribution.

Report information
The Basics
Id: 77502
Status: open
Priority: 0/
Queue: File-Slurp

People
Owner: Nobody in particular
Requestors: kozunov [...] gmail.com
Cc:
AdminCc:

Bug Information
Severity: Critical
Broken in: 9999.19
Fixed in: (no value)



Subject: atomic and no_clobber clobbered file
problem described in the test
Subject: slurp.pl
Download slurp.pl
text/x-perl 436b
#!/usr/bin/perl use strict; use warnings; use File::Slurp; use Test::More tests => 1; my $file = "/tmp/slurp"; my $option = {}; my $data4write = "data1"; File::Slurp::write_file($file, $option, $data4write); $option = { atomic => 1, no_clobber => 1, }; File::Slurp::write_file($file, $option, "data2"); my $data = File::Slurp::read_file($file); is($data, $data4write, 'atomic and no_clobber');
From: Sergey Zhuravlev
Download (untitled) / with headers
text/plain 115b
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
Subject: file-slurp.patch
Download file-slurp.patch
text/x-diff 2.3k
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');


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.