X-Git-Url: https://git.p6c8.net/devedit.git/blobdiff_plain/6a0432ae8e83df713006409cf8ba6b673ad074e5..4f312081a2b65ffd71c66e425cbe1b51e0e9c9ec:/modules/File/Access.pm?ds=sidebyside diff --git a/modules/File/Access.pm b/modules/File/Access.pm index dd6403b..a96dd09 100644 --- a/modules/File/Access.pm +++ b/modules/File/Access.pm @@ -7,7 +7,15 @@ package File::Access; # using only one command # # Author: Patrick Canterino -# Last modified: 2005-02-12 +# Last modified: 2005-08-01 +# +# Copyright (C) 1999-2000 Roland Bluethgen, Frank Schoenmann +# Copyright (C) 2003-2009 Patrick Canterino +# All Rights Reserved. +# +# This file can be distributed and/or modified under the terms of +# of the Artistic License 1.0 (see also the LICENSE file found at +# the top level of the Dev-Editor distribution). # use strict; @@ -18,16 +26,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 +49,53 @@ use base qw(Exporter); $has_flock = eval { local $SIG{'__DIE__'}; flock(STDOUT,0); 1 }; +# Predeclaration of dir_copy() + +sub dir_copy($$); + +# 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 @@ -151,7 +208,6 @@ sub file_read($;$) read(FILE, my $content, -s $file); - file_lock(FILE,LOCK_UN) or do { close(FILE); return }; close(FILE) or return; return \$content; @@ -179,31 +235,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: Status code (Boolean) - -sub file_unlock($$) -{ - my ($uselist,$file) = @_; - - $uselist->remove_file($file) or return; - $uselist->save or return; - - return 1; -} - # it's true, baby ;-) 1;