Changeset 1454 for trunk/gsdl/perllib/util.pm
- Timestamp:
- 2000-08-27T23:04:47+12:00 (24 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/gsdl/perllib/util.pm
r1431 r1454 166 166 167 167 # recursively copies a file or group of files 168 # syntax: cp_r (sourcefiles, destination file or directory) 168 # syntax: cp_r (sourcefiles, destination directory) 169 # destination must be a directory - to copy one file to 170 # another use cp instead 169 171 sub cp_r { 170 172 my $dest = pop (@_); 171 173 my (@srcfiles) = @_; 172 174 173 # remove trailing slashes from source and destination files174 $dest =~ s/[\\\/]+$//;175 map {$_ =~ s/[\\\/]+$//;} @srcfiles;176 177 175 # a few sanity checks 178 176 if (scalar (@srcfiles) == 0) { 179 print STDERR "util::cp no destination directory given\n"; 180 return; 181 } elsif ((scalar (@srcfiles) > 1) && (!-d $dest)) { 182 print STDERR "util::cp if multiple source files are given the ". 183 "destination must be a directory\n"; 177 print STDERR "util::cp_r no destination directory given\n"; 178 return; 179 } elsif (-f $dest) { 180 print STDERR "util::cp_r destination must be a directory\n"; 184 181 return; 185 182 } 186 183 184 # create destination directory if it doesn't exist already 185 if (! -d $dest) { 186 my $store_umask = umask(0002); 187 mkdir ($dest, 0777); 188 umask($store_umask); 189 } 190 187 191 # copy the files 188 192 foreach $file (@srcfiles) { 189 # copy the file to within dest if dest is a directory190 # exception: if there is only one source file and that191 # source file is a directory192 my $tempdest = $dest;193 if (-d $tempdest && !(scalar(@srcfiles) == 1 && -d $file)) {194 my ($filename) = $file =~ /([^\\\/]+)$/;195 $tempdest .= "/$filename";196 }197 193 198 194 if (!-e $file) { 199 print STDERR "util::cp $file does not exist\n";195 print STDERR "util::cp_r $file does not exist\n"; 200 196 201 197 } elsif (-d $file) { 202 # make a new directory (if needed) 203 unless (-e $tempdest) 204 { 205 my $store_umask = umask(0002); 206 mkdir ($tempdest, 0777); 207 umask($store_umask); 208 } 198 print STDERR "directory: $file\n"; 209 199 210 200 # get the contents of this directory … … 212 202 print STDERR "util::cp_r could not open directory $file\n"; 213 203 } else { 214 my @filedir = grep (!/^\.\.?$/, readdir (INDIR));204 my @filedir = readdir (INDIR); 215 205 closedir (INDIR); 216 217 # copy all the files in this directory 218 &cp_r (map {$_="$file/$_";} @filedir, $tempdest); 206 my $olddest = $dest; 207 foreach $f (@filedir) { 208 next if $f =~ /^\.\.?$/; 209 # copy all the files in this directory 210 my $ff = &util::filename_cat ($file, $f); 211 if (-d $ff) { 212 # make the new directory 213 $dest = &util::filename_cat ($dest, $f); 214 my $store_umask = umask(0002); 215 mkdir ($dest, 0777); 216 umask($store_umask); 217 } 218 print STDERR "dest: $dest\n"; 219 &cp_r ($ff, $dest); 220 $dest = $olddest; 221 } 219 222 } 220 223 221 224 } else { 222 &cp($file, $tempdest); 225 print STDERR "ordinary file: $file --> $dest\n"; 226 &cp($file, $dest); 223 227 } 224 228 } … … 504 508 } 505 509 510 # returns 1 if filename1 and filename2 point to the same 511 # file or directory 512 sub filenames_equal { 513 my ($filename1, $filename2) = @_; 514 515 # use filename_cat to clean up trailing slashes and 516 # multiple slashes 517 $filename1 = filename_cat ($filename1); 518 $filename1 = filename_cat ($filename1); 519 520 # filenames not case sensitive on windows 521 if ($ENV{'GSDLOS'} =~ /^windows$/i) { 522 $filename1 =~ tr/[A-Z]/[a-z]/; 523 $filename2 =~ tr/[A-Z]/[a-z]/; 524 } 525 return 1 if $filename1 eq $filename2; 526 return 0; 527 } 528 506 529 sub get_os_dirsep { 507 530 … … 535 558 # will return the collection name if successful, "" otherwise 536 559 sub use_collection { 537 my ($collection) = @_; 560 my ($collection, $collectdir) = @_; 561 562 if (!defined $collectdir || $collectdir eq "") { 563 $collectdir = &filename_cat ($ENV{'GSDLHOME'}, "collect"); 564 } 538 565 539 566 # get and check the collection … … 555 582 # are defined 556 583 $ENV{'GSDLCOLLECTION'} = $collection unless defined $ENV{'GSDLCOLLECTION'}; 557 $ENV{'GSDLCOLLECTDIR'} = &filename_cat ($ ENV{'GSDLHOME'}, "collect", $collection);584 $ENV{'GSDLCOLLECTDIR'} = &filename_cat ($collectdir, $collection); 558 585 559 586 # make sure this collection exists
Note:
See TracChangeset
for help on using the changeset viewer.