Changeset 11179 for trunk/gsdl

Timestamp:

2006-02-01T10:12:18+13:00 (18 years ago)

Author:

kjdon

Message:

added a cp_r_toplevel function, to copy the contents of a directory, but no subdirectories

File:

• trunk/gsdl/perllib/util.pm (modified) (1 diff)

trunk/gsdl/perllib/util.pm

@@ -246 +246 @@
 }
 
+# copies a directory and its contents, excluding subdirectories, into a new directory
+sub cp_r_toplevel {
+    my $dest = pop (@_);
+    my (@srcfiles) = @_;
+
+    # a few sanity checks
+    if (scalar (@srcfiles) == 0) {
+    print STDERR "util::cp_r no destination directory given\n";
+    return;
+    } elsif (-f $dest) {
+    print STDERR "util::cp_r destination must be a directory\n";
+    return;
+    }
+    
+    # create destination directory if it doesn't exist already
+    if (! -d $dest) {
+    my $store_umask = umask(0002);
+    mkdir ($dest, 0777);
+    umask($store_umask);
+    } 
+
+    # copy the files
+    foreach my $file (@srcfiles) {
+
+    if (!-e $file) {
+        print STDERR "util::cp_r $file does not exist\n";
+
+    } elsif (-d $file) {
+        # make the new directory
+        my ($filename) = $file =~ /([^\\\/]*)$/;
+        $dest = &util::filename_cat ($dest, $filename);
+        my $store_umask = umask(0002);
+        mkdir ($dest, 0777);
+        umask($store_umask);
+
+        # get the contents of this directory
+        if (!opendir (INDIR, $file)) {
+        print STDERR "util::cp_r could not open directory $file\n";
+        } else {
+        my @filedir = readdir (INDIR);
+        closedir (INDIR);
+        foreach my $f (@filedir) {
+            next if $f =~ /^\.\.?$/;
+            
+            # copy all the files in this directory, but not directories
+            my $ff = &util::filename_cat ($file, $f); 
+            if (-f $ff) {
+            &cp($ff, $dest);
+            #&cp_r ($ff, $dest);
+            }
+        }
+        }
+
+    } else {
+        &cp($file, $dest);
+    }
+    }
+}
 
 sub mk_dir {