X-Git-Url: https://git.p6c8.net/devedit.git/blobdiff_plain/baa16479399badf33a72089621e9c2ddae96444c..95df6a6a2bb9185cceb1fcf205b4f9f07690ca27:/modules/File/Access.pm diff --git a/modules/File/Access.pm b/modules/File/Access.pm index 6c3862b..31377d9 100644 --- a/modules/File/Access.pm +++ b/modules/File/Access.pm @@ -6,15 +6,17 @@ package File::Access; # Some simple routines for doing things with files # with only one command # -# Author: Patrick Canterino -# Last modified: 2003-12-01 +# Author: Patrick Canterino +# Last modified: 2004-12-17 # use strict; -use vars qw(@EXPORT); +use vars qw(@EXPORT + $has_flock); -use Carp qw(croak); +use Fcntl qw(:DEFAULT + :flock); ### Export ### @@ -22,8 +24,20 @@ use base qw(Exporter); @EXPORT = qw(dir_read file_create + file_lock file_read - file_save); + file_save + file_unlock + + LOCK_SH + LOCK_EX + LOCK_UN + LOCK_NB); + +# Check if flock() is available +# I found this piece of code somewhere in the internet + +$has_flock = eval { local $SIG{'__DIE__'}; flock(STDOUT,0); 1 }; # dir_read() # @@ -49,7 +63,7 @@ sub dir_read($) # Sort the entries - @entries = sort(@entries); + @entries = sort {uc($a) cmp uc($b)} @entries; my @files; my @dirs; @@ -73,7 +87,11 @@ sub dir_read($) # file_create() # -# Create a file +# Create a file, but only if it doesn't already exist +# +# (I wanted to use O_EXCL for this, but `perldoc -f sysopen` +# doesn't say that it is available on every system - so I +# created this workaround using O_RDONLY and O_CREAT) # # Params: File to create # @@ -87,12 +105,31 @@ sub file_create($) return if(-e $file); - open(FILE,">$file") or return; - close(FILE) or return; + sysopen(FILE,$file,O_RDONLY | O_CREAT) or return; + close(FILE) or return; return 1; } +# file_lock() +# +# System independent wrapper function for flock() +# On systems where flock() is not available, this function +# always returns true. +# +# Params: 1. Filehandle +# 2. Locking mode +# +# Return: Status code (Boolean) + +sub file_lock(*$) +{ + my ($handle,$mode) = @_; + + return 1 unless($has_flock); + return flock($handle,$mode); +} + # file_read() # # Read out a file completely @@ -106,9 +143,13 @@ sub file_read($) my $file = shift; local *FILE; - open(FILE,"<$file") or return; + sysopen(FILE,$file,O_RDONLY) or return; + file_lock(FILE,LOCK_SH) or do { close(FILE); return }; + read(FILE, my $content, -s $file); - close(FILE) or return; + + file_lock(FILE,LOCK_UN) or do { close(FILE); return }; + close(FILE) or return; return \$content; } @@ -119,21 +160,47 @@ sub file_read($) # # Params: 1. File # 2. File content as Scalar Reference +# 3. true => open in binary mode +# false => open in normal mode (default) # # Return: Status code (Boolean) -sub file_save($$) +sub file_save($$;$) { - my ($file,$content) = @_; + my ($file,$content,$binary) = @_; local *FILE; - open(FILE,">$file") or return; - print FILE $$content or do { close(FILE); return }; - close(FILE) or return; + sysopen(FILE,$file,O_WRONLY | O_CREAT | O_TRUNC) or return; + file_lock(FILE,LOCK_EX) or do { close(FILE); return }; + binmode(FILE) if($binary); + + print FILE $$content or do { close(FILE); return }; + + file_lock(FILE,LOCK_UN) or do { close(FILE); return }; + close(FILE) or return; return 1; } +# file_unlock() +# +# Remove a file from the list of files in use +# +# Params: 1. File::UseList object +# 2. File to remove +# +# Return: -nothing- + +sub file_unlock($$) +{ + my ($uselist,$file) = @_; + + $uselist->remove_file($file); + $uselist->save; + + return; +} + # it's true, baby ;-) 1;