X-Git-Url: https://git.p6c8.net/devedit.git/blobdiff_plain/362eeaa190459c405df9a134341fe9923032d16a..d5a32580b2fa9d1ae8c31a6bfbc65b54c79c37c7:/modules/File/Access.pm?ds=sidebyside diff --git a/modules/File/Access.pm b/modules/File/Access.pm index ad2bc13..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-16 +# 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 @@ -183,25 +240,6 @@ sub file_save($$;$) 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;