Changeset 721 for trunk/gsdl/perllib/util.pm

Timestamp:

1999-10-19T16:21:35+13:00 (25 years ago)

Author:

davidb

Message:

Support functions to help with the generation of webpages from
Perl CGI scripts.

File:

• trunk/gsdl/perllib/util.pm (modified) (6 diffs)

trunk/gsdl/perllib/util.pm

@@ -40 +40 @@
     if (!-e $file) {
         print STDERR "util::rm $file does not exist\n";
-    } elsif (!-f $file) {
-        print STDERR "util::rm $file is not a regular file\n";
+    } elsif ((!-f $file) && (!-l $file)) {
+        print STDERR "util::rm $file is not a regular (or symbolic) file\n";
     } else {
         push (@filefiles, $file);
@@ -68 +68 @@
         print STDERR "util::rm_r $file does not exist\n";
 
-    } elsif (-d $file) {
+    } elsif ((-d $file) && (!-l $file)) { # don't recurse down symbolic link
         # get the contents of this directory
         if (!opendir (INDIR, $file)) {
@@ -92 +92 @@
 }
 
+# moves a file or a group of files
+sub mv {
+    my $dest = pop (@_);
+    my (@srcfiles) = @_;
+
+    # remove trailing slashes from source and destination files
+    $dest =~ s/[\\\/]+$//;
+    map {$_ =~ s/[\\\/]+$//;} @srcfiles;
+
+    # a few sanity checks
+    if (scalar (@srcfiles) == 0) {
+    print STDERR "util::mv no destination directory given\n";
+    return;
+    } elsif ((scalar (@srcfiles) > 1) && (!-d $dest)) {
+    print STDERR "util::mv if multiple source files are given the ".
+        "destination must be a directory\n";
+    return;
+    }
+
+    # move the files
+    foreach $file (@srcfiles) {
+    my $tempdest = $dest;
+    if (-d $tempdest) {
+        my ($filename) = $file =~ /([^\\\/]+)$/;
+        $tempdest .= "/$filename";
+    }
+    if (!-e $file) {
+        print STDERR "util::mv $file does not exist\n";
+    } else {
+        rename ($file, $tempdest);
+    }
+    }
+}
+
 
 # copies a file or a group of files
@@ -128 +162 @@
     }
 }
+
 
 
@@ -186 +221 @@
 
 
+sub mk_dir {
+    my ($dir) = @_;
+
+    if (!mkdir ($dir, 0775)) {
+    print STDERR "util::mk_dir could not create directory $dir\n";
+    return;
+    }
+}
+
 sub mk_all_dir {
     my ($dir) = @_;
@@ -239 +283 @@
     }
     
+}
+
+# make soft link to file if supported by OS, otherwise return error
+sub soft_link {
+    my ($src,$dest) = @_;
+
+    # remove trailing slashes from source and destination files
+    $src =~ s/[\\\/]+$//;
+    $dest =~ s/[\\\/]+$//;
+
+    # a few sanity checks
+    if (!-e $src) {
+    print STDERR "util::soft_link source file $src does not exist\n";
+    return 0;
+    }
+
+    my $dest_dir = &File::Basename::dirname($dest);
+    mk_all_dir($dest_dir) if (!-e $dest_dir);
+
+    if (!symlink($src,$dest))
+    {
+    print STDERR "util::soft_link: unable to create soft link.";
+    return 0;
+    }
+
+    return 1;
 }