Ignore:
Timestamp:
2023-01-18T14:54:31+13:00 (17 months ago)
Author:
davidb
Message:

Refactoring of FileUtils.pm: adds in more general purpose internal functions for file operations; also strengthens error checking of file ops. For backwards compatability the stricter error checking is only done with the 'strict=1' option is passed in.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • main/trunk/greenstone2/perllib/FileUtils.pm

    r37034 r37151  
    116116
    117117
     118## @function _copyFilesGeneral()
     119#
     120# internal version that copies a file or a group of files
     121#
     122sub _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
    118219## @function copyFiles()
    119220#
     
    121222#
    122223sub copyFiles
     224{
     225  my $dest = pop (@_);
     226  my (@srcfiles) = @_;
     227 
     228  return &_copyFilesGeneral(\@srcfiles,$dest,undef);
     229}
     230
     231sub copyFilesDEPRECATED
    123232{
    124233  my $dest = pop (@_);
     
    133242  {
    134243    print STDERR "FileUtils::copyFiles() no destination directory given\n";
    135     return;
    136   }
    137   elsif ((scalar (@srcfiles) > 1) && (!-d $dest))
     244    return 0;
     245  }
     246  elsif ((scalar(@srcfiles) > 1) && (!-d $dest))
    138247  {
    139248    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 
    143254  # copy the files
    144255  foreach my $file (@srcfiles)
     
    152263    if (!-e $file)
    153264    {
    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;
    155267    }
    156268    elsif (!-f $file)
    157269    {
    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;
    159272    }
    160273    else
    161274    {
    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
    165290}
    166291## copyFiles()
     292
     293
     294## @function _readdirWithOptions()
     295#
     296# Internal version to support public functions such as readdirFullpath and readDirectory
     297
     298sub _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
    167350
    168351
     
    178361{
    179362    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
     373sub 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   
    182379    my $fullpath_files_and_dirs = [];
    183380
     
    193390    {
    194391    print STDERR "FileUtils::readdirFullpath() could not open directory $src_dir_fullpath\n";
    195     $ret_val = 0;   
     392    $ret_val_success = 0;   
    196393    }
    197394    else
     
    213410    }
    214411
    215     return ($ret_val,$fullpath_files_and_dirs);
     412    return ($ret_val_success,$fullpath_files_and_dirs);
    216413}
    217414
     
    222419# internal support routine for recursively copying or hard-linking files
    223420#
     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
    224425sub _copyFilesRecursiveGeneral
    225426{
    226427    my ($srcfiles_ref,$dest,$depth,$options) = @_;
    227428
     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   
    228438    # a few sanity checks
    229439    my $num_src_files = scalar (@$srcfiles_ref);
     
    231441    if ($num_src_files == 0)
    232442    {
    233     print STDERR "FileUtils::copyFilesRecursive() no destination directory given\n";
     443    print STDERR "FileUtils::_copyFilesRecursiveGeneral() no destination directory given\n";
    234444    return 0;
    235445    }
    236446    elsif (-f $dest)
    237447    {
    238     print STDERR "FileUtils::copyFilesRecursive() destination must be a directory\n";
     448    print STDERR "FileUtils::_copyFilesRecursiveGeneral() destination must be a directory\n";
    239449    return 0;
    240450    }
     
    292502    }
    293503
     504    my $had_an_error = 0;   
    294505   
    295506    # copy the files
     
    299510    {
    300511        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        }
    303519    }
    304520    elsif (-d $file)
    305521    {
    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;
    307525
    308526        # make the new directory
     
    310528
    311529        my $next_dest = &filenameConcatenate($dest, $src_dirname_tail);
     530
    312531        my $store_umask = umask(0002);
    313         mkdir ($next_dest, 0777);
     532        my $mkdir_success_ok = mkdir($next_dest, 0777);
    314533        umask($store_umask);
    315534
     535        if (!$mkdir_success_ok) {
     536        $had_an_error = 1;
     537        if ($strict) {
     538            return 0;
     539        }
     540        }
     541       
    316542        my ($readdir_status, $fullpath_src_subfiles_and_subdirs) = &readdirFullpath($src_dir_fullpath,$options);
    317543
    318544        if (!$readdir_status) {
    319         return 0;
     545        $had_an_error = 1;
     546        if ($strict) {
     547            return 0;
     548        }
    320549        }
    321550        else {
    322551
    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           
    332569            }
    333570        }
    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        }       
    360584    }
    361585    else
    362586    {
    363         &copyFiles($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        }
    364596    }
    365597    }
    366598
    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    }
    368608}
    369609## _copyFilesRecursiveGeneral()
     
    378618#
    379619sub copyFilesRecursive
     620{
     621  my $dest = pop (@_);
     622  my (@srcfiles) = @_;
     623
     624  return _copyFilesRecursiveGeneral(\@srcfiles,$dest,0,undef);
     625}
     626
     627sub copyFilesRecursiveDEPRECATED
    380628{
    381629  my $dest = pop (@_);
     
    433681          # copy all the files in this directory
    434682          my $ff = &filenameConcatenate($file, $f);
    435           &copyFilesRecursive($ff, $dest);
     683          &copyFilesRecursiveDEPRECATED($ff ,$dest);
    436684        }
    437685      }
     
    457705#
    458706sub copyFilesRecursiveNoSVN
     707{
     708  my $dest = pop (@_);
     709  my (@srcfiles) = @_;
     710
     711  return _copyFilesRecursiveGeneral(\@srcfiles,$dest, 0, { 'exclude_filter_re' => "^\\.svn\$" } );
     712}
     713
     714sub copyFilesRecursiveNoSVNDEPRECATED
    459715{
    460716  my $dest = pop (@_);
     
    513769          my $ff = &filenameConcatenate($file, $f);
    514770          # util.pm version incorrectly called cp_r here - jmt12
    515           &copyFilesRecursiveNoSVN($ff, $dest);
     771          &copyFilesRecursiveNoSVNDEPRECATED($ff ,$dest);
    516772        }
    517773      }
     
    533789#
    534790sub copyFilesRecursiveTopLevel
     791{
     792  my $dest = pop (@_);
     793  my (@srcfiles) = @_;
     794
     795  return _copyFilesRecursiveGeneral(\@srcfiles,$dest, 0, { 'copytype' => "toplevel" } );
     796}
     797
     798sub copyFilesRecursiveTopLevelDEPRECATED
    535799{
    536800  my $dest = pop (@_);
     
    605869
    606870
     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
     879sub 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
     892sub hardlinkFilesRecursive
     893{
     894    my $dest = pop (@_);
     895    my (@srcfiles) = @_;
     896
     897    _copyFilesRecursiveGeneral(\@srcfiles,$dest,0, { 'hardlink' => 1 });
     898}
     899
     900
    607901## @function differentFiles()
    608902#
     
    8231117sub hardLink
    8241118{
    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     
    8271125  # remove trailing slashes from source and destination files
    8281126  $src =~ s/[\\\/]+$//;
    8291127  $dest =~ s/[\\\/]+$//;
    8301128
     1129  my $had_an_error = 0;
     1130 
    8311131  ##    print STDERR "**** src = ", unicode::debug_unicode_string($src),"\n";
    8321132  # a few sanity checks
    8331133  if (!-e $src)
    8341134  {
    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      }
    8371142  }
    8381143  elsif (-d $src)
    8391144  {
    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      }
    8421152  }
    8431153  elsif (-e $dest)
    8441154  {
    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      }
    8471166  }
    8481167
     
    8501169  if (!-e $dest_dir)
    8511170  {
    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      }
    8531178  }
    8541179
     
    8571182    if ((!defined $verbosity) || ($verbosity>2))
    8581183    {
    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  }
    8651200}
    8661201## hardLink()
     
    9221257  my ($dir) = @_;
    9231258
    924   # use / for the directory separator, remove duplicate and
    925   # trailing slashes
     1259  # use / for the directory separator, remove duplicate and trailing slashes
    9261260  $dir=~s/[\\\/]+/\//g;
    9271261  $dir=~s/[\\\/]+$//;
     
    9461280      {
    9471281        print STDERR "FileUtils::makeAllDirectories() could not create directory $dirsofar\n";
    948         return;
     1282        return 0;
    9491283      }
    9501284    }
     
    9671301  {
    9681302    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;
    9711308}
    9721309## makeDirectory()
     
    9911328sub moveDirectoryContents
    9921329{
     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   
    9931336  my ($src_dir, $dest_dir) = @_;
    9941337
     
    10731416  {
    10741417    print STDERR "FileUtils::moveFiles() no destination directory given\n";
    1075     return;
     1418    return 0;
    10761419  }
    10771420  elsif ((scalar (@srcfiles) > 1) && (!-d $dest))
    10781421  {
    10791422    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 
    10831428  # move the files
    10841429  foreach my $file (@srcfiles)
     
    10921437    if (!-e $file)
    10931438    {
    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;
    10951441    }
    10961442    else
    10971443    {
    1098       if(!rename ($file, $tempdest))
     1444      if (!rename($file, $tempdest))
    10991445      {
    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    }
    11031457      }
    11041458      # rename (partially) succeeded) but srcfile still exists after rename
    1105       elsif(-e $file)
     1459      elsif (-e $file)
    11061460      {
    11071461        #print STDERR "*** srcfile $file still exists after rename to $tempdest\n";
    1108         if(!-e $tempdest)
     1462        if (!-e $tempdest)
    11091463        {
    11101464          print STDERR "@@@@ ERROR: $tempdest does not exist\n";
     
    11121466        # Sometimes the rename operation fails (as does
    11131467        # File::Copy::move).  This turns out to be because the files
    1114         # are hardlinked.  Need to do a copy-delete in this case,
     1468        # are hard-linked.  Need to do a copy-delete in this case,
    11151469        # however, the copy step is not necessary: the srcfile got
    11161470        # renamed into tempdest, but srcfile itself still exists,
    11171471        # 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;
    11211485  }
    11221486}
     
    11561520
    11571521
     1522
    11581523## @function readDirectory()
    11591524#
    11601525sub 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
     1541sub readDirectoryDEPRECATED
    11611542{
    11621543  my $path = shift(@_);
     
    11691550  else
    11701551  {
    1171     die("Error! Failed to open directory to list files: " . $path . "\n");
     1552    die("Error! Failed to open directory list files: " . $path . "\n");
    11721553  }
    11731554  return \@files;
    11741555}
    11751556## readDirectory()
     1557
     1558## @function readDirectoryFiltered()
     1559#
     1560sub 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()
    11761579
    11771580## @function readUTF8File()
     
    12391642  my @filefiles = ();
    12401643
     1644  my $ret_val_success = 1; # default (true) is to assume everything works out
     1645 
    12411646  # make sure the files we want to delete exist
    12421647  # and are regular files
     
    12451650    if (!-e $file)
    12461651    {
    1247       print STDERR "FileUtils::removeFiles() $file does not exist\n";
     1652    print STDERR "Warning: FileUtils::removeFiles() $file does not exist\n";
    12481653    }
    12491654    elsif ((!-f $file) && (!-l $file))
    12501655    {
    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";
    12521657    }
    12531658    else
     
    12611666
    12621667  # 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;
    12671680}
    12681681## removeFiles()
     
    13081721sub removeFilesFiltered
    13091722{
    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     
    13121729  #   my ($cpackage,$cfilename,$cline,$csubr,$chas_args,$cwantarray) = caller(2);
    13131730  #   my ($lcfilename) = ($cfilename =~ m/([^\\\/]*)$/);
     
    13161733  my @files_array = (ref $files eq "ARRAY") ? @$files : ($files);
    13171734
     1735  my $had_an_error = 0;
     1736 
    13181737  # recursively remove the files
    13191738  foreach my $file (@files_array)
     
    13231742    if (!-e $file)
    13241743    {
    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);
    13261748    }
    13271749    # don't recurse down symbolic link
    13281750    elsif ((-d $file) && (!-l $file))
    13291751    {
    1330       # get the contents of this directory
     1752      # specified '$file' is a directory => get the contents of this directory
    13311753      if (!opendir (INDIR, $file))
    13321754      {
    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;
    13341758      }
    13351759      else
     
    13401764        # remove all the files in this directory
    13411765        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        }
    13511781        }
     1782    else {
     1783        # had a problems in the above
     1784        $had_an_error = 1;
     1785        last if ($strict);
     1786    }
    13521787      }
    13531788    }
    13541789    else
    13551790    {
    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;
    13641813  }
    13651814}
     
    13761825  # use the more general (but reterospectively written) function
    13771826  # filtered_rm_r function() with no accept or reject expressions
    1378   &removeFilesFiltered(\@files,undef,undef);
     1827  return &removeFilesFiltered(\@files,undef,undef);
    13791828}
    13801829## removeFilesRecursive()
Note: See TracChangeset for help on using the changeset viewer.