Changeset 37151 for main/trunk/greenstone2/perllib/FileUtils.pm
- Timestamp:
- 2023-01-18T14:54:31+13:00 (17 months ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
main/trunk/greenstone2/perllib/FileUtils.pm
r37034 r37151 116 116 117 117 118 ## @function _copyFilesGeneral() 119 # 120 # internal version that copies a file or a group of files 121 # 122 sub _copyFilesGeneral 123 { 124 my ($srcfiles_ref,$dest,$options) = @_; 125 126 # upgrade srcfiles_ref to array reference, if what is passed in is a single (scalar) filename 127 $srcfiles_ref = [ $srcfiles_ref] if (ref $srcfiles_ref eq ""); 128 129 my $strict = (defined $options && $options->{'strict'}) ? $options->{'strict'} : 0; 130 my $hardlink = (defined $options && $options->{'hardlink'}) ? $options->{'hardlink'} : 0; 131 132 # remove trailing slashes from source and destination files 133 $dest =~ s/[\\\/]+$//; 134 map {$_ =~ s/[\\\/]+$//;} @$srcfiles_ref; 135 136 # a few sanity checks 137 if (scalar(@$srcfiles_ref) == 0) 138 { 139 print STDERR "FileUtils::_copyFilesGeneral() no destination directory given\n"; 140 return 0; 141 } 142 elsif ((scalar(@$srcfiles_ref) > 1) && (!-d $dest)) 143 { 144 print STDERR "FileUtils::_copyFilesGeneral() if multiple source files are given the destination must be a directory\n"; 145 return 0; 146 } 147 148 my $had_an_error = 0; 149 150 # copy the files 151 foreach my $file (@$srcfiles_ref) 152 { 153 my $tempdest = $dest; 154 if (-d $tempdest) 155 { 156 my ($filename) = $file =~ /([^\\\/]+)$/; 157 $tempdest .= "/$filename"; 158 } 159 if (!-e $file) 160 { 161 print STDERR "FileUtils::_copyFilesGeneral() $file does not exist\n"; 162 $had_an_error = 1; 163 if ($strict) { 164 return 0; 165 } 166 } 167 elsif (!-f $file) 168 { 169 print STDERR "FileUtils::_copyFilesGeneral() $file is not a regular file\n"; 170 $had_an_error = 1; 171 if ($strict) { 172 return 0; 173 } 174 } 175 else 176 { 177 my $success = undef; 178 179 if ($hardlink) { 180 181 if (!link($file, $tempdest)) 182 { 183 print STDERR "Warning: FileUtils::_copyFilesGeneral(): unable to create hard link. "; 184 print STDERR " Attempting file copy: $file -> $tempdest\n"; 185 $success = &File::Copy::copy($file, $tempdest); 186 } 187 else { 188 $success = 1; 189 } 190 191 } 192 else { 193 $success = &File::Copy::copy($file, $tempdest); 194 } 195 196 if (!$success) { 197 print STDERR "FileUtils::_copyFilesGeneral() failed to copy $file -> $tempdest\n"; 198 $had_an_error = 1; 199 200 if ($strict) { 201 return 0; 202 } 203 } 204 } 205 } 206 207 if ($had_an_error) { 208 return 0; 209 } 210 else { 211 # true => everything OK 212 return 1; 213 } 214 215 } 216 217 218 118 219 ## @function copyFiles() 119 220 # … … 121 222 # 122 223 sub copyFiles 224 { 225 my $dest = pop (@_); 226 my (@srcfiles) = @_; 227 228 return &_copyFilesGeneral(\@srcfiles,$dest,undef); 229 } 230 231 sub copyFilesDEPRECATED 123 232 { 124 233 my $dest = pop (@_); … … 133 242 { 134 243 print STDERR "FileUtils::copyFiles() no destination directory given\n"; 135 return ;136 } 137 elsif ((scalar 244 return 0; 245 } 246 elsif ((scalar(@srcfiles) > 1) && (!-d $dest)) 138 247 { 139 248 print STDERR "FileUtils::copyFiles() if multiple source files are given the destination must be a directory\n"; 140 return; 141 } 142 249 return 0; 250 } 251 252 my $had_an_error = 0; 253 143 254 # copy the files 144 255 foreach my $file (@srcfiles) … … 152 263 if (!-e $file) 153 264 { 154 print STDERR "FileUtils::copyFiles() $file does not exist\n"; 265 print STDERR "FileUtils::copyFiles() $file does not exist\n"; 266 $had_an_error = 1; 155 267 } 156 268 elsif (!-f $file) 157 269 { 158 print STDERR "FileUtils::copyFiles() $file is not a plain file\n"; 270 print STDERR "FileUtils::copyFiles() $file is not a regular file\n"; 271 $had_an_error = 1; 159 272 } 160 273 else 161 274 { 162 &File::Copy::copy ($file, $tempdest); 163 } 164 } 275 my $success = &File::Copy::copy ($file, $tempdest); 276 if (!$success) { 277 $had_an_error = 1; 278 } 279 } 280 } 281 282 if ($had_an_error) { 283 return 0; 284 } 285 else { 286 # true => everything OK 287 return 1; 288 } 289 165 290 } 166 291 ## copyFiles() 292 293 294 ## @function _readdirWithOptions() 295 # 296 # Internal version to support public functions such as readdirFullpath and readDirectory 297 298 sub _readdirWithOptions 299 { 300 my ($src_dir_fullpath,$options) = @_; 301 302 my $ret_val_success = 1; # default (true) is to assume things will work out! 303 304 my $all_files_and_dirs = []; 305 306 my $strict = 0; 307 my $make_fullpath = 0; 308 my $exclude_filter_re = undef; 309 my $include_filter_re = undef; 310 311 if (defined $options) { 312 $strict = $options->{'strict'} if defined $options->{'strict'}; 313 $make_fullpath = $options->{'make_fullpath'} if defined $options->{'make_fullpath'}; 314 $exclude_filter_re = $options->{'exclude_filter_re'} if defined $options->{'exclude_filter_re'}; 315 $include_filter_re = $options->{'include_filter_re'} if defined $options->{'include_filter_re'}; 316 } 317 318 # get the contents of this directory 319 if (!opendir(INDIR, $src_dir_fullpath)) 320 { 321 print STDERR "FileUtils::readdirFullpath() could not open directory $src_dir_fullpath\n"; 322 $ret_val_success = 0; 323 } 324 else 325 { 326 my @next_files_and_dirs = readdir(INDIR); 327 closedir (INDIR); 328 329 foreach my $f_or_d (@next_files_and_dirs) 330 { 331 next if $f_or_d =~ /^\.\.?$/; 332 next if (defined $exclude_filter_re && ($f_or_d =~ m/$exclude_filter_re/)); 333 334 if ((!defined $include_filter_re) || ($f_or_d =~ m/$include_filter_re/)) { 335 if ($make_fullpath) { 336 my $ff_or_dd = &filenameConcatenate($src_dir_fullpath, $f_or_d); 337 push(@$all_files_and_dirs,$ff_or_dd); 338 } 339 else { 340 push(@$all_files_and_dirs,$f_or_d); 341 } 342 } 343 } 344 345 } 346 347 return ($ret_val_success,$all_files_and_dirs); 348 } 349 167 350 168 351 … … 178 361 { 179 362 my ($src_dir_fullpath,$options) = @_; 180 181 my $ret_val = 1; # assume things will work out! 363 364 my $topped_up_options = { %$options }; 365 366 $topped_up_options->{'make_fullpath'} = 1; 367 368 my ($ret_val_success,$fullpath_files_and_dirs) = _readdirWithOptions($src_dir_fullpath,$topped_up_options); 369 370 return ($ret_val_success,$fullpath_files_and_dirs); 371 } 372 373 sub readdirFullpathDEPRECATED 374 { 375 my ($src_dir_fullpath,$options) = @_; 376 377 my $ret_val_success = 1; # default (true) is to assume things will work out! 378 182 379 my $fullpath_files_and_dirs = []; 183 380 … … 193 390 { 194 391 print STDERR "FileUtils::readdirFullpath() could not open directory $src_dir_fullpath\n"; 195 $ret_val = 0;392 $ret_val_success = 0; 196 393 } 197 394 else … … 213 410 } 214 411 215 return ($ret_val ,$fullpath_files_and_dirs);412 return ($ret_val_success,$fullpath_files_and_dirs); 216 413 } 217 414 … … 222 419 # internal support routine for recursively copying or hard-linking files 223 420 # 421 # Notes that the src-files are passed as a reference, and so a single arguemnt, 422 # whereas the the public facing functions take a array or arguments, and pops off the 423 # final entry and treats it as the 'dest' 424 224 425 sub _copyFilesRecursiveGeneral 225 426 { 226 427 my ($srcfiles_ref,$dest,$depth,$options) = @_; 227 428 429 # upgrade srcfiles_ref to array reference, if what is passed in is a single (scalar) filename 430 $srcfiles_ref = [ $srcfiles_ref] if (ref $srcfiles_ref eq ""); 431 432 # 'strict' defaults to false 433 # when false, this means, in situations where it can, even if an error is encountered it keeps going 434 my $strict = (defined $options && $options->{'strict'}) ? $options->{'strict'} : 0; 435 my $hardlink = (defined $options && $options->{'hardlink'}) ? $options->{'hardlink'} : 0; 436 my $copytype = (defined $options && $options->{'copytype'}) ? $options->{'copytype'} : "recursive"; 437 228 438 # a few sanity checks 229 439 my $num_src_files = scalar (@$srcfiles_ref); … … 231 441 if ($num_src_files == 0) 232 442 { 233 print STDERR "FileUtils:: copyFilesRecursive() no destination directory given\n";443 print STDERR "FileUtils::_copyFilesRecursiveGeneral() no destination directory given\n"; 234 444 return 0; 235 445 } 236 446 elsif (-f $dest) 237 447 { 238 print STDERR "FileUtils:: copyFilesRecursive() destination must be a directory\n";448 print STDERR "FileUtils::_copyFilesRecursiveGeneral() destination must be a directory\n"; 239 449 return 0; 240 450 } … … 292 502 } 293 503 504 my $had_an_error = 0; 294 505 295 506 # copy the files … … 299 510 { 300 511 print STDERR "FileUtils::_copyFilesRecursiveGeneral() $file does not exist\n"; 301 # wrap up in strict option check 302 return 0; 512 513 if ($strict) { 514 return 0; 515 } 516 else { 517 $had_an_error = 1; 518 } 303 519 } 304 520 elsif (-d $file) 305 521 { 306 my $src_dir_fullpath = $file; # know by this point that $file is actually a sub-directory 522 # src-file is a diretory => recursive case 523 524 my $src_dir_fullpath = $file; 307 525 308 526 # make the new directory … … 310 528 311 529 my $next_dest = &filenameConcatenate($dest, $src_dirname_tail); 530 312 531 my $store_umask = umask(0002); 313 m kdir($next_dest, 0777);532 my $mkdir_success_ok = mkdir($next_dest, 0777); 314 533 umask($store_umask); 315 534 535 if (!$mkdir_success_ok) { 536 $had_an_error = 1; 537 if ($strict) { 538 return 0; 539 } 540 } 541 316 542 my ($readdir_status, $fullpath_src_subfiles_and_subdirs) = &readdirFullpath($src_dir_fullpath,$options); 317 543 318 544 if (!$readdir_status) { 319 return 0; 545 $had_an_error = 1; 546 if ($strict) { 547 return 0; 548 } 320 549 } 321 550 else { 322 551 323 foreach my $fullpath_subf_or_subd (@$fullpath_src_subfiles_and_subdirs) 324 { 325 # Recursively copy all the files/dirs in this directory: 326 # In the general version need the source argument to be a reference to an array 327 my $ret_val = &_copyFilesRecursiveGeneral([$fullpath_subf_or_subd],$next_dest, $depth+1, $options); 328 329 if ($ret_val == 0) { 330 # Error condition encountered 331 return 0; 552 if ($copytype eq "toplevel") { 553 foreach my $fullpath_subf_or_subd (@$fullpath_src_subfiles_and_subdirs) 554 { 555 if (-f $fullpath_subf_or_subd) 556 { 557 my $fullpath_subf = $fullpath_subf_or_subd; 558 my $ret_val_success = &_copyFilesGeneral([$fullpath_subf],$dest,$options); 559 560 if ($ret_val_success == 0) { 561 562 $had_an_error = 1; 563 if ($strict) { 564 return 0; 565 } 566 } 567 } 568 332 569 } 333 570 } 334 } 335 336 # # get the contents of this directory 337 # if (!opendir(INDIR, $src_dir_fullpath)) 338 # { 339 # print STDERR "FileUtils::_copyFilesRecursiveGeneral() could not open directory $src_dir_fullpath\n"; 340 # } 341 # else 342 # { 343 # my @next_files_and_dirs = readdir(INDIR); 344 # closedir (INDIR); 345 # foreach my $f_or_d (@next_files_and_dirs) 346 # { 347 # next if $f_or_d =~ /^\.\.?$/; 348 # # recursively copy all the files/dirs in this directory 349 # my $ff_or_dd = &filenameConcatenate($src_dir_fullpath, $f_or_d); 350 # # In the general version need the source argument to be a reference to an array 351 # my $ret_val = &_copyFilesRecursiveGeneral($next_dest, [ $ff_or_dd ], $options); 352 # 353 # if ($ret_val == 0) { 354 # # Error condition encountered 355 # return 0; 356 # } 357 # } 358 # } 359 571 else { 572 # Recursively copy all the files/dirs in this directory: 573 my $ret_val_success = &_copyFilesRecursiveGeneral($fullpath_src_subfiles_and_subdirs,$next_dest, $depth+1, $options); 574 575 if ($ret_val_success == 0) { 576 577 $had_an_error = 1; 578 if ($strict) { 579 return 0; 580 } 581 } 582 } 583 } 360 584 } 361 585 else 362 586 { 363 ©Files($file, $dest); 587 my $ret_val_success = &_copyFilesGeneral([$file], $dest, $options); 588 if ($ret_val_success == 0) { 589 590 $had_an_error = 1; 591 if ($strict) { 592 # Error condition encountered in copy => immediately bail, passing the error on to outer calling function 593 return 0; 594 } 595 } 364 596 } 365 597 } 366 598 367 return 1; 599 # get to here, then everything went well 600 601 if ($had_an_error) { 602 return 0; 603 } 604 else { 605 # true => everything OK 606 return 1; 607 } 368 608 } 369 609 ## _copyFilesRecursiveGeneral() … … 378 618 # 379 619 sub copyFilesRecursive 620 { 621 my $dest = pop (@_); 622 my (@srcfiles) = @_; 623 624 return _copyFilesRecursiveGeneral(\@srcfiles,$dest,0,undef); 625 } 626 627 sub copyFilesRecursiveDEPRECATED 380 628 { 381 629 my $dest = pop (@_); … … 433 681 # copy all the files in this directory 434 682 my $ff = &filenameConcatenate($file, $f); 435 ©FilesRecursive ($ff,$dest);683 ©FilesRecursiveDEPRECATED($ff ,$dest); 436 684 } 437 685 } … … 457 705 # 458 706 sub copyFilesRecursiveNoSVN 707 { 708 my $dest = pop (@_); 709 my (@srcfiles) = @_; 710 711 return _copyFilesRecursiveGeneral(\@srcfiles,$dest, 0, { 'exclude_filter_re' => "^\\.svn\$" } ); 712 } 713 714 sub copyFilesRecursiveNoSVNDEPRECATED 459 715 { 460 716 my $dest = pop (@_); … … 513 769 my $ff = &filenameConcatenate($file, $f); 514 770 # util.pm version incorrectly called cp_r here - jmt12 515 ©FilesRecursiveNoSVN ($ff,$dest);771 ©FilesRecursiveNoSVNDEPRECATED($ff ,$dest); 516 772 } 517 773 } … … 533 789 # 534 790 sub copyFilesRecursiveTopLevel 791 { 792 my $dest = pop (@_); 793 my (@srcfiles) = @_; 794 795 return _copyFilesRecursiveGeneral(\@srcfiles,$dest, 0, { 'copytype' => "toplevel" } ); 796 } 797 798 sub copyFilesRecursiveTopLevelDEPRECATED 535 799 { 536 800 my $dest = pop (@_); … … 605 869 606 870 871 ## @function hardlinkFilesRecursive() 872 # 873 # recursively hard-links a file or group of files syntax similar to 874 # how 'cp -r' operates (only hard-linking of course!) 875 # (sourcefiles, destination directory) destination must be a directory 876 # to copy one file to another use cp instead 877 # 878 879 sub hardlinkFilesRefRecursive 880 { 881 my ($srcfiles_ref,$dest, $options) = @_; 882 883 # only dealing with scalar values in 'options' so OK to shallow copy 884 my $options_clone = (defined $options) ? { %$options } : {}; 885 886 # top-up with setting to trigger hard-linking 887 $options_clone->{'hardlink'} = 1; 888 889 _copyFilesRecursiveGeneral($srcfiles_ref,$dest,0, $options_clone); 890 } 891 892 sub hardlinkFilesRecursive 893 { 894 my $dest = pop (@_); 895 my (@srcfiles) = @_; 896 897 _copyFilesRecursiveGeneral(\@srcfiles,$dest,0, { 'hardlink' => 1 }); 898 } 899 900 607 901 ## @function differentFiles() 608 902 # … … 823 1117 sub hardLink 824 1118 { 825 my ($src, $dest, $verbosity) = @_; 826 1119 my ($src, $dest, $verbosity, $options) = @_; 1120 1121 # 'strict' defaults to false 1122 # see _copyFilesRecursiveGeneral for more details 1123 my $strict = (defined $options && $options->{'strict'}) ? $options->{'strict'} : 0; 1124 827 1125 # remove trailing slashes from source and destination files 828 1126 $src =~ s/[\\\/]+$//; 829 1127 $dest =~ s/[\\\/]+$//; 830 1128 1129 my $had_an_error = 0; 1130 831 1131 ## print STDERR "**** src = ", unicode::debug_unicode_string($src),"\n"; 832 1132 # a few sanity checks 833 1133 if (!-e $src) 834 1134 { 835 print STDERR "FileUtils::hardLink() source file \"" . $src . "\" does not exist\n"; 836 return 1; 1135 print STDERR "FileUtils::hardLink() source file \"" . $src . "\" does not exist\n"; 1136 if ($strict) { 1137 return 0; 1138 } 1139 else { 1140 $had_an_error = 1; 1141 } 837 1142 } 838 1143 elsif (-d $src) 839 1144 { 840 print STDERR "FileUtils::hardLink() source \"" . $src . "\" is a directory\n"; 841 return 1; 1145 print STDERR "FileUtils::hardLink() source \"" . $src . "\" is a directory\n"; 1146 if ($strict) { 1147 return 0; 1148 } 1149 else { 1150 $had_an_error = 1; 1151 } 842 1152 } 843 1153 elsif (-e $dest) 844 1154 { 845 print STDERR "FileUtils::hardlink() dest file ($dest) exists, removing it\n"; 846 &removeFiles($dest); 1155 if ($strict) { 1156 return 0; 1157 } 1158 else { 1159 print STDERR "FileUtils::hardLink() dest file ($dest) exists, removing it\n"; 1160 my $status_ok = &removeFiles($dest); 1161 1162 if (!$status_ok) { 1163 $had_an_error = 1; 1164 } 1165 } 847 1166 } 848 1167 … … 850 1169 if (!-e $dest_dir) 851 1170 { 852 &makeAllDirectories($dest_dir); 1171 my $status_ok = &makeAllDirectories($dest_dir); 1172 if ($strict) { 1173 return 0; 1174 } 1175 else { 1176 $had_an_error = 1; 1177 } 853 1178 } 854 1179 … … 857 1182 if ((!defined $verbosity) || ($verbosity>2)) 858 1183 { 859 print STDERR "FileUtils::hardLink(): unable to create hard link. "; 860 print STDERR " Copying file: $src -> $dest\n"; 861 } 862 &File::Copy::copy ($src, $dest); 863 } 864 return 0; 1184 print STDERR "Warning: FileUtils::hardLink(): unable to create hard link. "; 1185 print STDERR " Copying file: $src -> $dest\n"; 1186 } 1187 my $status_ok = &File::Copy::copy($src, $dest); 1188 if (!$status_ok) { 1189 $had_an_error = 1; 1190 } 1191 } 1192 1193 if ($had_an_error) { 1194 return 0; 1195 } 1196 else { 1197 # no fatal issue encountered => return true 1198 return 1; 1199 } 865 1200 } 866 1201 ## hardLink() … … 922 1257 my ($dir) = @_; 923 1258 924 # use / for the directory separator, remove duplicate and 925 # trailing slashes 1259 # use / for the directory separator, remove duplicate and trailing slashes 926 1260 $dir=~s/[\\\/]+/\//g; 927 1261 $dir=~s/[\\\/]+$//; … … 946 1280 { 947 1281 print STDERR "FileUtils::makeAllDirectories() could not create directory $dirsofar\n"; 948 return ;1282 return 0; 949 1283 } 950 1284 } … … 967 1301 { 968 1302 print STDERR "FileUtils::makeDirectory() could not create directory $dir\n"; 969 return; 970 } 1303 return 0; 1304 } 1305 1306 # get to here, everything went as expected 1307 return 1; 971 1308 } 972 1309 ## makeDirectory() … … 991 1328 sub moveDirectoryContents 992 1329 { 1330 # Currently has no return values!!! 1331 1332 #### !!!! worthy of upgrading to include $options, and then use 1333 #### !!!! 'strict' to determine whether it returns 0 when hitting 1334 #### !!!! an issue immediately, or else persevere, and continue 1335 993 1336 my ($src_dir, $dest_dir) = @_; 994 1337 … … 1073 1416 { 1074 1417 print STDERR "FileUtils::moveFiles() no destination directory given\n"; 1075 return ;1418 return 0; 1076 1419 } 1077 1420 elsif ((scalar (@srcfiles) > 1) && (!-d $dest)) 1078 1421 { 1079 1422 print STDERR "FileUtils::moveFiles() if multiple source files are given the destination must be a directory\n"; 1080 return; 1081 } 1082 1423 return 0; 1424 } 1425 1426 my $had_an_error = 0; 1427 1083 1428 # move the files 1084 1429 foreach my $file (@srcfiles) … … 1092 1437 if (!-e $file) 1093 1438 { 1094 print STDERR "FileUtils::moveFiles() $file does not exist\n"; 1439 print STDERR "FileUtils::moveFiles() $file does not exist\n"; 1440 $had_an_error = 1; 1095 1441 } 1096 1442 else 1097 1443 { 1098 if (!rename($file, $tempdest))1444 if (!rename($file, $tempdest)) 1099 1445 { 1100 print STDERR "**** Failed to rename $file to $tempdest\n"; 1101 &File::Copy::copy($file, $tempdest); 1102 &removeFiles($file); 1446 print STDERR "**** Failed to rename $file to $tempdest. Attempting copy and then delete\n"; 1447 my $copy_status_ok = &File::Copy::copy($file, $tempdest); 1448 if ($copy_status_ok) { 1449 my $remove_status_ok = &removeFiles($file); 1450 if (!$remove_status_ok) { 1451 $had_an_error = 1; 1452 } 1453 } 1454 else { 1455 $had_an_error = 1; 1456 } 1103 1457 } 1104 1458 # rename (partially) succeeded) but srcfile still exists after rename 1105 elsif (-e $file)1459 elsif (-e $file) 1106 1460 { 1107 1461 #print STDERR "*** srcfile $file still exists after rename to $tempdest\n"; 1108 if (!-e $tempdest)1462 if (!-e $tempdest) 1109 1463 { 1110 1464 print STDERR "@@@@ ERROR: $tempdest does not exist\n"; … … 1112 1466 # Sometimes the rename operation fails (as does 1113 1467 # File::Copy::move). This turns out to be because the files 1114 # are hard linked. Need to do a copy-delete in this case,1468 # are hard-linked. Need to do a copy-delete in this case, 1115 1469 # however, the copy step is not necessary: the srcfile got 1116 1470 # renamed into tempdest, but srcfile itself still exists, 1117 1471 # delete it. &File::Copy::copy($file, $tempdest); 1118 &removeFiles($file); 1119 } 1120 } 1472 my $remove_status_ok = &removeFiles($file); 1473 if (!$remove_status_ok) { 1474 $had_an_error = 1; 1475 } 1476 } 1477 } 1478 } 1479 1480 if ($had_an_error) { 1481 return 0; 1482 } 1483 else { 1484 return 1; 1121 1485 } 1122 1486 } … … 1156 1520 1157 1521 1522 1158 1523 ## @function readDirectory() 1159 1524 # 1160 1525 sub readDirectory 1526 { 1527 my $path = shift(@_); 1528 1529 my $options = { 'strict' => 1 }; 1530 1531 my ($ret_val_success,$files_and_dirs) = _readdirWithOptions($path,$options); 1532 1533 if (!$ret_val_success) { 1534 die("Error! Failed to list files in directory: " . $path . "\n"); 1535 } 1536 1537 return $files_and_dirs; 1538 } 1539 1540 1541 sub readDirectoryDEPRECATED 1161 1542 { 1162 1543 my $path = shift(@_); … … 1169 1550 else 1170 1551 { 1171 die("Error! Failed to open directory tolist files: " . $path . "\n");1552 die("Error! Failed to open directory list files: " . $path . "\n"); 1172 1553 } 1173 1554 return \@files; 1174 1555 } 1175 1556 ## readDirectory() 1557 1558 ## @function readDirectoryFiltered() 1559 # 1560 sub readDirectoryFiltered 1561 { 1562 my ($path,$exclude_filter_re,$include_filter_re) = @_; 1563 1564 my $options = { 'strict' => 1 }; 1565 1566 $options->{'exclude_filter_re'} = $exclude_filter_re if defined $exclude_filter_re; 1567 $options->{'include_filter_re'} = $include_filter_re if defined $include_filter_re; 1568 1569 my ($ret_val_success,$files_and_dirs) = _readdirWithOptions($path,$options); 1570 1571 if (!$ret_val_success) { 1572 die("Error! Failed to list files in directory: " . $path . "\n"); 1573 } 1574 1575 return $files_and_dirs; 1576 } 1577 1578 ## readDirectoryFiltered() 1176 1579 1177 1580 ## @function readUTF8File() … … 1239 1642 my @filefiles = (); 1240 1643 1644 my $ret_val_success = 1; # default (true) is to assume everything works out 1645 1241 1646 # make sure the files we want to delete exist 1242 1647 # and are regular files … … 1245 1650 if (!-e $file) 1246 1651 { 1247 print STDERR "FileUtils::removeFiles() $file does not exist\n";1652 print STDERR "Warning: FileUtils::removeFiles() $file does not exist\n"; 1248 1653 } 1249 1654 elsif ((!-f $file) && (!-l $file)) 1250 1655 { 1251 print STDERR " FileUtils::removeFiles() $file is not a regular (or symbolic) file\n";1656 print STDERR "Warning: FileUtils::removeFiles() $file is not a regular (or symbolic) file\n"; 1252 1657 } 1253 1658 else … … 1261 1666 1262 1667 # check to make sure all of them were removed 1263 if ($numremoved != scalar(@filefiles)) 1264 { 1265 print STDERR "FileUtils::removeFiles() Not all files were removed\n"; 1266 } 1668 if ($numremoved != scalar(@filefiles)) { 1669 print STDERR "FileUtils::removeFiles() Not all files were removed\n"; 1670 1671 if ($numremoved == 0) { 1672 # without a '$options' parameter to provide strict=true/false then 1673 # interpret this particular situation as a "major" fail 1674 # => asked to remove files and not a single one was removed! 1675 $ret_val_success = 0; 1676 } 1677 } 1678 1679 return $ret_val_success; 1267 1680 } 1268 1681 ## removeFiles() … … 1308 1721 sub removeFilesFiltered 1309 1722 { 1310 my ($files,$file_accept_re,$file_reject_re) = @_; 1311 1723 my ($files,$file_accept_re,$file_reject_re, $options) = @_; 1724 1725 # 'strict' defaults to false 1726 # see _copyFilesRecursiveGeneral for more details 1727 my $strict = (defined $options && $options->{'strict'}) ? $options->{'strict'} : 0; 1728 1312 1729 # my ($cpackage,$cfilename,$cline,$csubr,$chas_args,$cwantarray) = caller(2); 1313 1730 # my ($lcfilename) = ($cfilename =~ m/([^\\\/]*)$/); … … 1316 1733 my @files_array = (ref $files eq "ARRAY") ? @$files : ($files); 1317 1734 1735 my $had_an_error = 0; 1736 1318 1737 # recursively remove the files 1319 1738 foreach my $file (@files_array) … … 1323 1742 if (!-e $file) 1324 1743 { 1325 print STDERR "FileUtils::removeFilesFiltered() $file does not exist\n"; 1744 # handle this as a warning rather than a fatal error that stops deleting files/dirs 1745 print STDERR "FileUtils::removeFilesFiltered() $file does not exist\n"; 1746 $had_an_error = 1; 1747 last if ($strict); 1326 1748 } 1327 1749 # don't recurse down symbolic link 1328 1750 elsif ((-d $file) && (!-l $file)) 1329 1751 { 1330 # get the contents of this directory1752 # specified '$file' is a directory => get the contents of this directory 1331 1753 if (!opendir (INDIR, $file)) 1332 1754 { 1333 print STDERR "FileUtils::removeFilesFiltered() could not open directory $file\n"; 1755 print STDERR "FileUtils::removeFilesFiltered() could not open directory $file\n"; 1756 $had_an_error = 1; 1757 last; 1334 1758 } 1335 1759 else … … 1340 1764 # remove all the files in this directory 1341 1765 map {$_="$file/$_";} @filedir; 1342 &removeFilesFiltered(\@filedir,$file_accept_re,$file_reject_re); 1343 1344 if (!defined $file_accept_re && !defined $file_reject_re) 1345 { 1346 # remove this directory 1347 if (!rmdir $file) 1348 { 1349 print STDERR "FileUtils::removeFilesFiltered() couldn't remove directory $file\n"; 1350 } 1766 my $remove_success_ok = &removeFilesFiltered(\@filedir,$file_accept_re,$file_reject_re); 1767 1768 if ($remove_success_ok) { 1769 if (!defined $file_accept_re && !defined $file_reject_re) 1770 { 1771 # no filters were in effect, and all files were removed 1772 # => remove this directory 1773 if (!rmdir $file) 1774 { 1775 print STDERR "FileUtils::removeFilesFiltered() couldn't remove directory $file\n"; 1776 1777 $had_an_error = 1; # back to there being a problem 1778 last if ($strict); 1779 } 1780 } 1351 1781 } 1782 else { 1783 # had a problems in the above 1784 $had_an_error = 1; 1785 last if ($strict); 1786 } 1352 1787 } 1353 1788 } 1354 1789 else 1355 1790 { 1356 next if (defined $file_reject_re && ($file =~ m/$file_reject_re/)); 1357 1358 if ((!defined $file_accept_re) || ($file =~ m/$file_accept_re/)) 1359 { 1360 # remove this file 1361 &removeFiles($file); 1362 } 1363 } 1791 # File exists => skip if it matches the file_reject_re 1792 1793 next if (defined $file_reject_re && ($file =~ m/$file_reject_re/)); 1794 1795 if ((!defined $file_accept_re) || ($file =~ m/$file_accept_re/)) 1796 { 1797 # remove this file 1798 my $remove_success_ok = &removeFiles($file); 1799 1800 if (!$remove_success_ok) { 1801 $had_an_error = 1; 1802 last if ($strict); 1803 } 1804 } 1805 } 1806 } 1807 1808 if ($had_an_error) { 1809 return 0; 1810 } 1811 else { 1812 return 1; 1364 1813 } 1365 1814 } … … 1376 1825 # use the more general (but reterospectively written) function 1377 1826 # filtered_rm_r function() with no accept or reject expressions 1378 &removeFilesFiltered(\@files,undef,undef);1827 return &removeFilesFiltered(\@files,undef,undef); 1379 1828 } 1380 1829 ## removeFilesRecursive()
Note:
See TracChangeset
for help on using the changeset viewer.