# using only one command
#
# Author: Patrick Canterino <patrick@patshaping.de>
-# 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;
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
$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
read(FILE, my $content, -s $file);
- file_lock(FILE,LOCK_UN) or do { close(FILE); return };
close(FILE) or return;
return \$content;
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;