X-Git-Url: https://git.p6c8.net/devedit.git/blobdiff_plain/7bc8b322eb4d5fdf4b6edf0fcd711b2ad5483a3a..c752deb389730ae56c25888e6b82c89e30060ec9:/modules/File/Access.pm diff --git a/modules/File/Access.pm b/modules/File/Access.pm index 2727775..28124cc 100644 --- a/modules/File/Access.pm +++ b/modules/File/Access.pm @@ -6,15 +6,15 @@ package File::Access; # Some simple routines for doing things with files # with only one command # -# Author: Patrick Canterino -# Last modified: 2003-11-04 +# Author: Patrick Canterino +# Last modified: 2004-10-26 # use strict; use vars qw(@EXPORT); -use Carp qw(croak); +use Fcntl; ### Export ### @@ -23,7 +23,8 @@ use base qw(Exporter); @EXPORT = qw(dir_read file_create file_read - file_save); + file_save + file_unlock); # dir_read() # @@ -49,7 +50,7 @@ sub dir_read($) # Sort the entries - @entries = sort(@entries); + @entries = sort {uc($a) cmp uc($b)} @entries; my @files; my @dirs; @@ -73,7 +74,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,8 +92,8 @@ 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; } @@ -106,9 +111,9 @@ sub file_read($) my $file = shift; local *FILE; - open(FILE,"<",$file) or return; + sysopen(FILE,$file,O_RDONLY) or return; read(FILE, my $content, -s $file); - close(FILE) or return; + close(FILE) or return; return \$content; } @@ -127,13 +132,32 @@ sub file_save($$) my ($file,$content) = @_; 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; + print FILE $$content 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;