X-Git-Url: https://git.p6c8.net/devedit.git/blobdiff_plain/3e6b9e338fe5ea06b487202fe54217f2082cd13d..b5ad046f9519385786cb0faa8dbf165f6d733dee:/modules/File/Access.pm?ds=sidebyside diff --git a/modules/File/Access.pm b/modules/File/Access.pm index 81b6851..6ab193e 100644 --- a/modules/File/Access.pm +++ b/modules/File/Access.pm @@ -7,15 +7,14 @@ package File::Access; # with only one command # # Author: Patrick Canterino -# Last modified: 09-20-2003 +# Last modified: 2004-10-26 # use strict; use vars qw(@EXPORT); -use Carp qw(croak); -use File::Spec; +use Fcntl; ### Export ### @@ -24,7 +23,8 @@ use base qw(Exporter); @EXPORT = qw(dir_read file_create file_read - file_save); + file_save + file_unlock); # dir_read() # @@ -50,7 +50,7 @@ sub dir_read($) # Sort the entries - @entries = sort(@entries); + @entries = sort {uc($a) cmp uc($b)} @entries; my @files; my @dirs; @@ -59,7 +59,7 @@ sub dir_read($) { next if($entry eq "." || $entry eq ".."); - if(-d File::Spec->canonpath($dir."/".$entry)) + if(-d $dir."/".$entry) { push(@dirs,$entry); } @@ -74,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 # @@ -88,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; } @@ -107,9 +111,9 @@ sub file_read($) my $file = shift; local *FILE; - open(FILE,"<",$file); + sysopen(FILE,$file,O_RDONLY) or return; read(FILE, my $content, -s $file); - close(FILE); + close(FILE) or return; return \$content; } @@ -121,23 +125,39 @@ sub file_read($) # Params: 1. File # 2. File content as Scalar Reference # -# Return: Status Code (Boolean) +# Return: Status code (Boolean) sub file_save($$) { my ($file,$content) = @_; - my $temp = $file.".temp"; local *FILE; - open(FILE,">",$temp) or return; - print FILE $$content; - close(FILE) or return; - - rename($temp,$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;