X-Git-Url: https://git.p6c8.net/devedit.git/blobdiff_plain/7c201ab8e15b5000a1bd3f445e6c769aca4129b1..9020a0a5805da403b5564f2bd77d01722f459fab:/modules/File/Access.pm diff --git a/modules/File/Access.pm b/modules/File/Access.pm index c649a2c..31377d9 100644 --- a/modules/File/Access.pm +++ b/modules/File/Access.pm @@ -6,45 +6,38 @@ package File::Access; # Some simple routines for doing things with files # with only one command # -# Author: Patrick Canterino -# Last modified: 2004-08-05 +# Author: Patrick Canterino +# Last modified: 2004-12-17 # use strict; -use vars qw(@EXPORT); +use vars qw(@EXPORT + $has_flock); -use Fcntl; +use Fcntl qw(:DEFAULT + :flock); ### Export ### use base qw(Exporter); -@EXPORT = qw(chgrp - dir_read +@EXPORT = qw(dir_read file_create + file_lock file_read file_save - file_unlock); + file_unlock -# chgrp() -# -# Change the group of files or directories -# -# Params: 1. Group name or group ID -# 2. List of files -# -# Return: Number of files group successfully changed -# (or false) + LOCK_SH + LOCK_EX + LOCK_UN + LOCK_NB); -sub chgrp($@) -{ - my ($group,@files) = @_; - my $gid = ($group !~ /^\d+$/) ? getgrnam($group) : $group; +# Check if flock() is available +# I found this piece of code somewhere in the internet - return unless($gid); - return chown(-1,$gid,@files); -} +$has_flock = eval { local $SIG{'__DIE__'}; flock(STDOUT,0); 1 }; # dir_read() # @@ -118,6 +111,25 @@ sub file_create($) 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 @@ -132,7 +144,11 @@ sub file_read($) local *FILE; sysopen(FILE,$file,O_RDONLY) or return; + file_lock(FILE,LOCK_SH) or do { close(FILE); return }; + read(FILE, my $content, -s $file); + + file_lock(FILE,LOCK_UN) or do { close(FILE); return }; close(FILE) or return; return \$content; @@ -144,16 +160,23 @@ 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; 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;