X-Git-Url: https://git.p6c8.net/devedit.git/blobdiff_plain/95df6a6a2bb9185cceb1fcf205b4f9f07690ca27..5d97440acfd02dd482d9b87d8a86521b013aea46:/modules/File/Access.pm?ds=inline diff --git a/modules/File/Access.pm b/modules/File/Access.pm index 31377d9..e0f4e55 100644 --- a/modules/File/Access.pm +++ b/modules/File/Access.pm @@ -3,11 +3,11 @@ package File::Access; # # Dev-Editor - Module File::Access # -# Some simple routines for doing things with files -# with only one command +# Some simple routines for doing things with files by +# using only one command # # Author: Patrick Canterino -# Last modified: 2004-12-17 +# Last modified: 2005-07-05 # use strict; @@ -18,16 +18,18 @@ use vars qw(@EXPORT use Fcntl qw(:DEFAULT :flock); +use File::Copy; + ### Export ### use base qw(Exporter); -@EXPORT = qw(dir_read +@EXPORT = qw(dir_copy + dir_read file_create file_lock file_read file_save - file_unlock LOCK_SH LOCK_EX @@ -39,6 +41,49 @@ use base qw(Exporter); $has_flock = eval { local $SIG{'__DIE__'}; flock(STDOUT,0); 1 }; +# dir_copy() +# +# Copy a directory +# +# Params: 1. Directory to copy +# 2. Target +# +# Return: Status code (Boolean) + +sub dir_copy($$) +{ + my ($dir,$target) = @_; + + return unless(-d $dir); + + my $entries = dir_read($dir) or return; + + my $dirs = $entries->{'dirs'}; + my $files = $entries->{'files'}; + + mkdir($target,0777) unless(-d $target); + + foreach my $directory(@$dirs) + { + unless(-d $target.'/'.$directory) + { + mkdir($target.'/'.$directory,0777) or next; + } + + if(-r $target.'/'.$directory && -x $target.'/'.$directory) + { + dir_copy($dir.'/'.$directory,$target.'/'.$directory) or next; + } + } + + foreach my $file(@$files) + { + copy($dir.'/'.$file,$target.'/'.$file) or next; + } + + return 1; +} + # dir_read() # # Collect the files and directories in a directory @@ -46,7 +91,7 @@ $has_flock = eval { local $SIG{'__DIE__'}; flock(STDOUT,0); 1 }; # Params: Directory # # Return: Hash reference: dirs => directories -# files => files +# files => files and symbolic links sub dir_read($) { @@ -70,9 +115,9 @@ sub dir_read($) foreach my $entry(@entries) { - next if($entry eq "." || $entry eq ".."); + next if($entry eq '.' || $entry eq '..'); - if(-d $dir."/".$entry) + if(-d $dir.'/'.$entry && not -l $dir.'/'.$entry) { push(@dirs,$entry); } @@ -134,21 +179,23 @@ sub file_lock(*$) # # Read out a file completely # -# Params: File +# Params: 1. File +# 2. true => open in binary mode +# false => open in normal mode (default) # # Return: Contents of the file (Scalar Reference) -sub file_read($) +sub file_read($;$) { - my $file = shift; + my ($file,$binary) = @_; local *FILE; sysopen(FILE,$file,O_RDONLY) or return; file_lock(FILE,LOCK_SH) or do { close(FILE); return }; + binmode(FILE) if($binary); read(FILE, my $content, -s $file); - file_lock(FILE,LOCK_UN) or do { close(FILE); return }; close(FILE) or return; return \$content; @@ -176,31 +223,11 @@ sub file_save($$;$) 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;