Ignore:
Timestamp:
2013-05-06T15:23:45+12:00 (11 years ago)
Author:
jmt12
Message:

Replacing hardcoded additions to INC and PATH environment variables with conditional ones - this allows us to use the order of values in these variables for precedence, thus allows better support for extensions that override classifiers, plugins etc. ENV and PATH functions already exists in util, but augmentINC() is a new function

File:
1 edited

Legend:

Unmodified
Added
Removed

  • main/trunk/greenstone2/perllib/util.pm

    r26976 r27303  
    3535# $^X works better in some cases to return the path to perl used to launch the script,
    3636# but if launched with plain "perl" (no full-path), that will be just what it returns.
    37 use Config;
     37use Config;
     38# New module for file related utility functions - intended as a
     39# placeholder for an extension that allows a variety of different
     40# filesystems (FTP, HTTP, SAMBA, WEBDav, HDFS etc)
     41use FileUtils;
    3842
    3943# removes files (but not directories)
    4044sub rm {
    41     my (@files) = @_;
    42 
    43     my @filefiles = ();
    44 
    45     # make sure the files we want to delete exist
    46     # and are regular files
    47     foreach my $file (@files) {
    48     if (!-e $file) {
    49         print STDERR "util::rm $file does not exist\n";
    50     } elsif ((!-f $file) && (!-l $file)) {
    51         print STDERR "util::rm $file is not a regular (or symbolic) file\n";
    52     } else {
    53         push (@filefiles, $file);
    54     }
    55     }
    56    
    57     # remove the files
    58     my $numremoved = unlink @filefiles;
    59 
    60     # check to make sure all of them were removed
    61     if ($numremoved != scalar(@filefiles)) {
    62     print STDERR "util::rm Not all files were removed\n";
    63     }
    64 }
    65 
    66 # removes files (but not directories) - can rename this to the default
    67 # "rm" subroutine  when debugging the deletion of individual files.
    68 sub rm_debug {
    69     my (@files) = @_;
    70     my @filefiles = ();
    71 
    72     # make sure the files we want to delete exist
    73     # and are regular files
    74     foreach my $file (@files) {
    75         if (!-e $file) {
    76             print STDERR "util::rm $file does not exist\n";
    77         } elsif ((!-f $file) && (!-l $file)) {
    78             print STDERR "util::rm $file is not a regular (or symbolic) file\n";
    79         } else { # debug message
    80             unlink($file) or warn "Could not delete file $file: $!\n";
    81         }
    82     }
    83 }
    84 
     45  warnings::warnif("deprecated", "util::rm() is deprecated, using FileUtils::removeFiles() instead");
     46  return &FileUtils::removeFiles(@_);
     47}
    8548
    8649# recursive removal
    8750sub filtered_rm_r {
    88     my ($files,$file_accept_re,$file_reject_re) = @_;
    89 
    90 #   my ($cpackage,$cfilename,$cline,$csubr,$chas_args,$cwantarray) = caller(2);
    91 #   my ($lcfilename) = ($cfilename =~ m/([^\\\/]*)$/);
    92 #   print STDERR "** Calling method (2): $lcfilename:$cline $cpackage->$csubr\n";
    93    
    94     my @files_array = (ref $files eq "ARRAY") ? @$files : ($files);
    95 
    96     # recursively remove the files
    97     foreach my $file (@files_array) {
    98     $file =~ s/[\/\\]+$//; # remove trailing slashes
    99    
    100     if (!-e $file) {
    101         print STDERR "util::filtered_rm_r $file does not exist\n";
    102 
    103     } elsif ((-d $file) && (!-l $file)) { # don't recurse down symbolic link
    104         # get the contents of this directory
    105         if (!opendir (INDIR, $file)) {
    106         print STDERR "util::filtered_rm_r could not open directory $file\n";
    107         } else {
    108         my @filedir = grep (!/^\.\.?$/, readdir (INDIR));
    109         closedir (INDIR);
    110                
    111         # remove all the files in this directory
    112         map {$_="$file/$_";} @filedir;
    113         &filtered_rm_r (\@filedir,$file_accept_re,$file_reject_re);
    114 
    115         if (!defined $file_accept_re && !defined $file_reject_re) {
    116             # remove this directory
    117             if (!rmdir $file) {
    118             print STDERR "util::filtered_rm_r couldn't remove directory $file\n";
    119             }
    120         }
    121         }
    122     } else {
    123         next if (defined $file_reject_re && ($file =~ m/$file_reject_re/));
    124 
    125         if ((!defined $file_accept_re) || ($file =~ m/$file_accept_re/)) {
    126         # remove this file 
    127         &rm ($file);
    128         }
    129     }
    130     }
    131 }
    132 
     51  warnings::warnif("deprecated", "util::filtered_rm_r() is deprecated, using FileUtils::removeFilesFiltered() instead");
     52  return &FileUtils::removeFilesFiltered(@_);
     53}
    13354
    13455# recursive removal
    13556sub rm_r {
    136     my (@files) = @_;
    137    
    138     # use the more general (but reterospectively written function
    139     # filtered_rm_r function()
    140 
    141     filtered_rm_r(\@files,undef,undef); # no accept or reject expressions
    142 }
    143 
    144 
    145 
     57  warnings::warnif("deprecated", "util::rm_r() is deprecated, using FileUtils::recursiveRemoveFiles() instead");
     58  return &FileUtils::removeFilesRecursive(@_);
     59}
    14660
    14761# moves a file or a group of files
    14862sub mv {
    149     my $dest = pop (@_);
    150     my (@srcfiles) = @_;
    151 
    152     # remove trailing slashes from source and destination files
    153     $dest =~ s/[\\\/]+$//;
    154     map {$_ =~ s/[\\\/]+$//;} @srcfiles;
    155 
    156     # a few sanity checks
    157     if (scalar (@srcfiles) == 0) {
    158     print STDERR "util::mv no destination directory given\n";
    159     return;
    160     } elsif ((scalar (@srcfiles) > 1) && (!-d $dest)) {
    161     print STDERR "util::mv if multiple source files are given the ".
    162         "destination must be a directory\n";
    163     return;
    164     }
    165 
    166     # move the files
    167     foreach my $file (@srcfiles) {
    168     my $tempdest = $dest;
    169     if (-d $tempdest) {
    170         my ($filename) = $file =~ /([^\\\/]+)$/;
    171         $tempdest .= "/$filename";
    172     }
    173     if (!-e $file) {
    174         print STDERR "util::mv $file does not exist\n";
    175     } else {
    176         if(!rename ($file, $tempdest)) {
    177         print STDERR "**** Failed to rename $file to $tempdest\n";
    178         &File::Copy::copy($file, $tempdest);
    179         &rm($file);
    180         }
    181         elsif(-e $file) { # rename (partially) succeeded) but srcfile still exists after rename
    182         #print STDERR "*** srcfile $file still exists after rename to $tempdest\n";
    183         if(!-e $tempdest) {
    184             print STDERR "@@@@ ERROR: $tempdest does not exist\n";
    185         }
    186         # Sometimes the rename operation fails (as does File::Copy::move).
    187         # This turns out to be because the files are hardlinked.
    188         # Need to do a copy-delete in this case, however, the copy step is not necessary:
    189         # the srcfile got renamed into tempdest, but srcfile itself still exists, delete it.
    190         #&File::Copy::copy($file, $tempdest);
    191 
    192         &rm($file);     
    193         }
    194     }
    195     }
     63  warnings::warnif("deprecated", "util::mv() is deprecated, using FileUtils::moveFiles() instead");
     64  return &FileUtils::moveFiles(@_);
    19665}
    19766
    … …  
    20170# but other files and folders in the target will continue to exist
    20271sub mv_dir_contents {
    203     my ($src_dir, $dest_dir) = @_;
    204    
    205     # Obtain listing of all files within src_dir
    206     # Note that readdir lists relative paths, as well as . and ..
    207     opendir(DIR, "$src_dir");
    208     my @files= readdir(DIR);
    209     close(DIR);
    210    
    211     my @full_path_files = ();
    212     foreach my $file (@files) {
    213         # process all except . and ..
    214         unless($file eq "." || $file eq "..") {
    215            
    216             my $dest_subdir = &filename_cat($dest_dir, $file); # $file is still a relative path
    217        
    218             # construct absolute paths
    219             $file = &filename_cat($src_dir, $file); # $file is now an absolute path
    220            
    221             # Recurse on directories which have an equivalent in target dest_dir
    222             # If $file is a directory that already exists in target $dest_dir,
    223             # then a simple move operation will fail (definitely on Windows).
    224             if(-d $file && -d $dest_subdir) {
    225                 #print STDERR "**** $file is a directory also existing in target, its contents to be copied to $dest_subdir\n";
    226                 &mv_dir_contents($file, $dest_subdir);
    227                
    228                 # now all content is moved across, delete empty dir in source folder
    229                 if(&is_dir_empty($file)) {
    230                     if (!rmdir $file) {
    231                         print STDERR "ERROR. util::mv_dir_contents couldn't remove directory $file\n";
    232                     }
    233                 } else { # error
    234                     print STDERR "ERROR. util::mv_dir_contents: subfolder $file still non-empty after moving contents to $dest_subdir\n";
    235                 }
    236             } else { # process files and any directories that don't already exist with a simple move
    237                 push(@full_path_files, $file);
    238             }           
    239         }
    240     }
    241    
    242     if(!&dir_exists($dest_dir)) { # create target toplevel folder or subfolders if they don't exist
    243         &mk_dir($dest_dir);
    244     }
    245 
    246     #print STDERR "@@@@@ Copying files |".join(",", @full_path_files)."| to: $dest_dir\n";
    247 
    248     if(@full_path_files) { # if non-empty, there's something to copy across
    249         &mv(@full_path_files, $dest_dir);
    250     }
    251 }
    252 
     72  warnings::warnif("deprecated", "util::mv_dir_contents() is deprecated, using FileUtils::moveDirectoryContents() instead");
     73  return &FileUtils::moveDirectoryContents(@_);
     74}
    25375
    25476# copies a file or a group of files
    25577sub cp {
    256     my $dest = pop (@_);
    257     my (@srcfiles) = @_;
    258 
    259     # remove trailing slashes from source and destination files
    260     $dest =~ s/[\\\/]+$//;
    261     map {$_ =~ s/[\\\/]+$//;} @srcfiles;
    262 
    263     # a few sanity checks
    264     if (scalar (@srcfiles) == 0) {
    265     print STDERR "util::cp no destination directory given\n";
    266     return;
    267     } elsif ((scalar (@srcfiles) > 1) && (!-d $dest)) {
    268     print STDERR "util::cp if multiple source files are given the ".
    269         "destination must be a directory\n";
    270     return;
    271     }
    272 
    273     # copy the files
    274     foreach my $file (@srcfiles) {
    275     my $tempdest = $dest;
    276     if (-d $tempdest) {
    277         my ($filename) = $file =~ /([^\\\/]+)$/;
    278         $tempdest .= "/$filename";
    279     }
    280     if (!-e $file) {
    281         print STDERR "util::cp $file does not exist\n";
    282     } elsif (!-f $file) {
    283         print STDERR "util::cp $file is not a plain file\n";
    284     } else {
    285         &File::Copy::copy ($file, $tempdest);
    286     }
    287     }
    288 }
    289 
    290 
     78  warnings::warnif("deprecated", "util::cp() is deprecated, using FileUtils::copyFiles() instead");
     79  return &FileUtils::copyFiles(@_);
     80}
    29181
    29282# recursively copies a file or group of files
    … …  
    29585# another use cp instead
    29686sub cp_r {
    297     my $dest = pop (@_);
    298     my (@srcfiles) = @_;
    299 
    300     # a few sanity checks
    301     if (scalar (@srcfiles) == 0) {
    302     print STDERR "util::cp_r no destination directory given\n";
    303     return;
    304     } elsif (-f $dest) {
    305     print STDERR "util::cp_r destination must be a directory\n";
    306     return;
    307     }
    308    
    309     # create destination directory if it doesn't exist already
    310     if (! -d $dest) {
    311     my $store_umask = umask(0002);
    312     mkdir ($dest, 0777);
    313     umask($store_umask);
    314     }
    315 
    316     # copy the files
    317     foreach my $file (@srcfiles) {
    318 
    319     if (!-e $file) {
    320         print STDERR "util::cp_r $file does not exist\n";
    321 
    322     } elsif (-d $file) {
    323         # make the new directory
    324         my ($filename) = $file =~ /([^\\\/]*)$/;
    325         $dest = &util::filename_cat ($dest, $filename);
    326         my $store_umask = umask(0002);
    327         mkdir ($dest, 0777);
    328         umask($store_umask);
    329 
    330         # get the contents of this directory
    331         if (!opendir (INDIR, $file)) {
    332         print STDERR "util::cp_r could not open directory $file\n";
    333         } else {
    334         my @filedir = readdir (INDIR);
    335         closedir (INDIR);
    336         foreach my $f (@filedir) {
    337             next if $f =~ /^\.\.?$/;
    338             # copy all the files in this directory
    339             my $ff = &util::filename_cat ($file, $f);
    340             &cp_r ($ff, $dest);
    341         }
    342         }
    343 
    344     } else {
    345         &cp($file, $dest);
    346     }
    347     }
    348 }
     87  warnings::warnif("deprecated", "util::cp_r() is deprecated, using FileUtils::copyFilesrecursive() instead");
     88  return &FileUtils::copyFilesRecursive(@_);
     89}
     90
    34991# recursively copies a file or group of files
    35092# syntax: cp_r (sourcefiles, destination directory)
    … …  
    35294# another use cp instead
    35395sub cp_r_nosvn {
    354     my $dest = pop (@_);
    355     my (@srcfiles) = @_;
    356 
    357     # a few sanity checks
    358     if (scalar (@srcfiles) == 0) {
    359     print STDERR "util::cp_r no destination directory given\n";
    360     return;
    361     } elsif (-f $dest) {
    362     print STDERR "util::cp_r destination must be a directory\n";
    363     return;
    364     }
    365    
    366     # create destination directory if it doesn't exist already
    367     if (! -d $dest) {
    368     my $store_umask = umask(0002);
    369     mkdir ($dest, 0777);
    370     umask($store_umask);
    371     }
    372 
    373     # copy the files
    374     foreach my $file (@srcfiles) {
    375 
    376     if (!-e $file) {
    377         print STDERR "util::cp_r $file does not exist\n";
    378 
    379     } elsif (-d $file) {
    380         # make the new directory
    381         my ($filename) = $file =~ /([^\\\/]*)$/;
    382         $dest = &util::filename_cat ($dest, $filename);
    383         my $store_umask = umask(0002);
    384         mkdir ($dest, 0777);
    385         umask($store_umask);
    386 
    387         # get the contents of this directory
    388         if (!opendir (INDIR, $file)) {
    389         print STDERR "util::cp_r could not open directory $file\n";
    390         } else {
    391         my @filedir = readdir (INDIR);
    392         closedir (INDIR);
    393         foreach my $f (@filedir) {
    394             next if $f =~ /^\.\.?$/;
    395             next if $f =~ /^\.svn$/;
    396             # copy all the files in this directory
    397             my $ff = &util::filename_cat ($file, $f);
    398             &cp_r ($ff, $dest);
    399         }
    400         }
    401 
    402     } else {
    403         &cp($file, $dest);
    404     }
    405     }
     96  warnings::warnif("deprecated", "util::cp_r_nosvn() is deprecated, using FileUtils::copyFilesRecursiveNoSVN() instead");
     97  return &FileUtils::copyFilesRecursiveNoSVN(@_);
    40698}
    40799
    408100# copies a directory and its contents, excluding subdirectories, into a new directory
    409101sub cp_r_toplevel {
    410     my $dest = pop (@_);
    411     my (@srcfiles) = @_;
    412 
    413     # a few sanity checks
    414     if (scalar (@srcfiles) == 0) {
    415     print STDERR "util::cp_r no destination directory given\n";
    416     return;
    417     } elsif (-f $dest) {
    418     print STDERR "util::cp_r destination must be a directory\n";
    419     return;
    420     }
    421    
    422     # create destination directory if it doesn't exist already
    423     if (! -d $dest) {
    424     my $store_umask = umask(0002);
    425     mkdir ($dest, 0777);
    426     umask($store_umask);
    427     }
    428 
    429     # copy the files
    430     foreach my $file (@srcfiles) {
    431 
    432     if (!-e $file) {
    433         print STDERR "util::cp_r $file does not exist\n";
    434 
    435     } elsif (-d $file) {
    436         # make the new directory
    437         my ($filename) = $file =~ /([^\\\/]*)$/;
    438         $dest = &util::filename_cat ($dest, $filename);
    439         my $store_umask = umask(0002);
    440         mkdir ($dest, 0777);
    441         umask($store_umask);
    442 
    443         # get the contents of this directory
    444         if (!opendir (INDIR, $file)) {
    445         print STDERR "util::cp_r could not open directory $file\n";
    446         } else {
    447         my @filedir = readdir (INDIR);
    448         closedir (INDIR);
    449         foreach my $f (@filedir) {
    450             next if $f =~ /^\.\.?$/;
    451            
    452             # copy all the files in this directory, but not directories
    453             my $ff = &util::filename_cat ($file, $f);
    454             if (-f $ff) {
    455             &cp($ff, $dest);
    456             #&cp_r ($ff, $dest);
    457             }
    458         }
    459         }
    460 
    461     } else {
    462         &cp($file, $dest);
    463     }
    464     }
     102  warnings::warnif("deprecated", "util::cp_r_toplevel() is deprecated, using FileUtils::recursiveCopyTopLevel() instead");
     103  return &FileUtils::recursiveCopyTopLevel(@_);
    465104}
    466105
    467106sub mk_dir {
    468     my ($dir) = @_;
    469 
    470     my $store_umask = umask(0002);
    471     my $mkdir_ok = mkdir ($dir, 0777);
    472     umask($store_umask);
    473    
    474     if (!$mkdir_ok)
    475     {
    476     print STDERR "util::mk_dir could not create directory $dir\n";
    477     return;
    478     }
     107  warnings::warnif("deprecated", "util::mk_dir() is deprecated, using FileUtils::makeDirectory() instead");
     108  return &FileUtils::makeDirectory(@_);
    479109}
    480110
    … …  
    483113# slightly faster (surprisingly) - Stefan.
    484114sub mk_all_dir {
    485     my ($dir) = @_;
    486 
    487     # use / for the directory separator, remove duplicate and
    488     # trailing slashes
    489     $dir=~s/[\\\/]+/\//g;
    490     $dir=~s/[\\\/]+$//;
    491 
    492     # make sure the cache directory exists
    493     my $dirsofar = "";
    494     my $first = 1;
    495     foreach my $dirname (split ("/", $dir)) {
    496     $dirsofar .= "/" unless $first;
    497     $first = 0;
    498 
    499     $dirsofar .= $dirname;
    500 
    501     next if $dirname =~ /^(|[a-z]:)$/i;
    502     if (!-e $dirsofar)
    503         {
    504         my $store_umask = umask(0002);
    505         my $mkdir_ok = mkdir ($dirsofar, 0777);
    506         umask($store_umask);
    507         if (!$mkdir_ok)
    508         {
    509             print STDERR "util::mk_all_dir could not create directory $dirsofar\n";
    510             return;
    511         }
    512         }
    513     }
     115  warnings::warnif("deprecated", "util::mk_all_dir() is deprecated, using FileUtils::makeAllDirectories() instead");
     116  return &FileUtils::makeAllDirectories(@_);
    514117}
    515118
    516119# make hard link to file if supported by OS, otherwise copy the file
    517120sub hard_link {
    518     my ($src, $dest, $verbosity) = @_;
    519 
    520     # remove trailing slashes from source and destination files
    521     $src =~ s/[\\\/]+$//;
    522     $dest =~ s/[\\\/]+$//;
    523 
    524 ##    print STDERR "**** src = ", unicode::debug_unicode_string($src),"\n";
    525     # a few sanity checks
    526     if (-e $dest) {
    527     # destination file already exists
    528     return;
    529     }
    530     elsif (!-e $src) {
    531     print STDERR "util::hard_link source file \"$src\" does not exist\n";
    532     return 1;
    533     }
    534     elsif (-d $src) {
    535     print STDERR "util::hard_link source \"$src\" is a directory\n";
    536     return 1;
    537     }
    538 
    539     my $dest_dir = &File::Basename::dirname($dest);
    540     mk_all_dir($dest_dir) if (!-e $dest_dir);
    541 
    542 
    543     if (!link($src, $dest)) {
    544     if ((!defined $verbosity) || ($verbosity>2)) {
    545         print STDERR "util::hard_link: unable to create hard link. ";
    546         print STDERR " Copying file: $src -> $dest\n";
    547     }
    548     &File::Copy::copy ($src, $dest);
    549     }
    550     return 0;
     121  warnings::warnif("deprecated", "util::hard_link() is deprecated, using FileUtils::hardLink() instead");
     122  return &FileUtils::hardLink(@_);
    551123}
    552124
    553125# make soft link to file if supported by OS, otherwise copy file
    554126sub soft_link {
    555     my ($src, $dest, $ensure_paths_absolute) = @_;
    556 
    557     # remove trailing slashes from source and destination files
    558     $src =~ s/[\\\/]+$//;
    559     $dest =~ s/[\\\/]+$//;
    560 
    561     # Ensure file paths are absolute IF requested to do so
    562     # Soft_linking didn't work for relative paths
    563     if(defined $ensure_paths_absolute && $ensure_paths_absolute) {
    564     # We need to ensure that the src file is the absolute path
    565     # See http://perldoc.perl.org/File/Spec.html
    566     if(!File::Spec->file_name_is_absolute( $src ))  { # it's relative
    567         $src = File::Spec->rel2abs($src); # make absolute
    568     }
    569     # Might as well ensure that the destination file's absolute path is used
    570     if(!File::Spec->file_name_is_absolute( $dest )) {
    571         $dest = File::Spec->rel2abs($dest); # make absolute
    572     }
    573     }
    574 
    575     # a few sanity checks
    576     if (!-e $src) {
    577     print STDERR "util::soft_link source file $src does not exist\n";
    578     return 0;
    579     }
    580 
    581     my $dest_dir = &File::Basename::dirname($dest);
    582     mk_all_dir($dest_dir) if (!-e $dest_dir);
    583 
    584     if ($ENV{'GSDLOS'} =~ /^windows$/i) {
    585        
    586     # symlink not supported on windows
    587     &File::Copy::copy ($src, $dest);
    588 
    589     } elsif (!eval {symlink($src, $dest)}) {
    590     print STDERR "util::soft_link: unable to create soft link.\n";
    591     return 0;
    592     }
    593 
    594     return 1;
     127  warnings::warnif("deprecated", "util::soft_link() is deprecated, using FileUtils::softLink() instead");
     128  return &FileUtils::softLink(@_);
    595129}
    596130
    … …  
    625159}
    626160
    627 
    628 sub fd_exists
    629 {
    630     my $filename_full_path = shift @_;
    631     my $test_op = shift @_ || "-e";
    632 
    633     # By default tests for existance of file or directory (-e)
    634     # Can be made more specific by providing second parameter (e.g. -f or -d)
    635 
    636     my $exists = 0;
    637 
    638     if ($ENV{'GSDLOS'} =~ m/^windows$/i) {
    639     require Win32;
    640     my $filename_short_path = Win32::GetShortPathName($filename_full_path);
    641     if (!defined $filename_short_path) {
    642         # Was probably still in UTF8 form (not what is needed on Windows)
    643         my $unicode_filename_full_path = eval "decode(\"utf8\",\$filename_full_path)";
    644         if (defined $unicode_filename_full_path) {
    645         $filename_short_path = Win32::GetShortPathName($unicode_filename_full_path);
    646         }
    647     }
    648     $filename_full_path = $filename_short_path;
    649     }
    650 
    651     if (defined $filename_full_path) {
    652     $exists = eval "($test_op \$filename_full_path)";
    653     }
    654 
    655     return $exists;
    656 }
    657 
    658 sub file_exists
    659 {
    660     my ($filename_full_path) = @_;
    661 
    662     return fd_exists($filename_full_path,"-f");
    663 }
    664 
    665 sub dir_exists
    666 {
    667     my ($filename_full_path) = @_;
    668 
    669     return fd_exists($filename_full_path,"-d");
    670 }
    671 
    672 
     161sub fd_exists {
     162  warnings::warnif("deprecated", "util::fd_exists() is deprecated, using FileUtils::fileTest() instead");
     163  return &FileUtils::fileTest(@_);
     164}
     165
     166sub file_exists {
     167  warnings::warnif("deprecated", "util::file_exists() is deprecated, using FileUtils::fileExists() instead");
     168  return &FileUtils::fileExists(@_);
     169}
     170
     171sub dir_exists {
     172  warnings::warnif("deprecated", "util::dir_exists() is deprecated, using FileUtils::directoryExists() instead");
     173  return &FileUtils::directoryExists(@_);
     174}
    673175
    674176# updates a copy of a directory in some other part of the filesystem
    … …  
    676178# both $fromdir and $todir should be absolute paths
    677179sub cachedir {
    678     my ($fromdir, $todir, $verbosity) = @_;
    679     $verbosity = 1 unless defined $verbosity;
    680 
    681     # use / for the directory separator, remove duplicate and
    682     # trailing slashes
    683     $fromdir=~s/[\\\/]+/\//g;
    684     $fromdir=~s/[\\\/]+$//;
    685     $todir=~s/[\\\/]+/\//g;
    686     $todir=~s/[\\\/]+$//;
    687 
    688     &mk_all_dir ($todir);
    689 
    690     # get the directories in ascending order
    691     if (!opendir (FROMDIR, $fromdir)) {
    692     print STDERR "util::cachedir could not read directory $fromdir\n";
    693     return;
    694     }
    695     my @fromdir = grep (!/^\.\.?$/, sort(readdir (FROMDIR)));
    696     closedir (FROMDIR);
    697 
    698     if (!opendir (TODIR, $todir)) {
    699     print STDERR "util::cacedir could not read directory $todir\n";
    700     return;
    701     }
    702     my @todir = grep (!/^\.\.?$/, sort(readdir (TODIR)));
    703     closedir (TODIR);
    704 
    705     my $fromi = 0;
    706     my $toi = 0;
    707            
    708     while ($fromi < scalar(@fromdir) || $toi < scalar(@todir)) {
    709 #   print "fromi: $fromi toi: $toi\n";
    710 
    711     # see if we should delete a file/directory
    712     # this should happen if the file/directory
    713     # is not in the from list or if its a different
    714     # size, or has an older timestamp
    715     if ($toi < scalar(@todir)) {
    716         if (($fromi >= scalar(@fromdir)) ||
    717         ($todir[$toi] lt $fromdir[$fromi] ||
    718          ($todir[$toi] eq $fromdir[$fromi] &&
    719           &differentfiles("$fromdir/$fromdir[$fromi]","$todir/$todir[$toi]",
    720                   $verbosity)))) {
    721 
    722         # the files are different
    723         &rm_r("$todir/$todir[$toi]");
    724         splice(@todir, $toi, 1); # $toi stays the same
    725 
    726         } elsif ($todir[$toi] eq $fromdir[$fromi]) {
    727         # the files are the same
    728         # if it is a directory, check its contents
    729         if (-d "$todir/$todir[$toi]") {
    730             &cachedir ("$fromdir/$fromdir[$fromi]",
    731                    "$todir/$todir[$toi]", $verbosity);
    732         }
    733 
    734         $toi++;
    735         $fromi++;
    736         next;
    737         }
    738     }
    739  
    740     # see if we should insert a file/directory
    741     # we should insert a file/directory if there
    742     # is no tofiles left or if the tofile does not exist
    743     if ($fromi < scalar(@fromdir) && ($toi >= scalar(@todir) ||
    744                       $todir[$toi] gt $fromdir[$fromi])) {
    745         &cp_r ("$fromdir/$fromdir[$fromi]", "$todir/$fromdir[$fromi]");
    746         splice (@todir, $toi, 0, $fromdir[$fromi]);
    747 
    748         $toi++;
    749         $fromi++;
    750     }
    751     }
     180  warnings::warnif("deprecated", "util::cachedir() is deprecated, using FileUtils::synchronizeDirectories() instead");
     181  return &FileUtils::synchronizeDirectories(@_);
    752182}
    753183
    … …  
    757187# $file2 is allowed to be newer than $file1
    758188sub differentfiles {
    759     my ($file1, $file2, $verbosity) = @_;
    760     $verbosity = 1 unless defined $verbosity;
    761 
    762     $file1 =~ s/\/+$//;
    763     $file2 =~ s/\/+$//;
    764    
    765     my ($file1name) = $file1 =~ /\/([^\/]*)$/;
    766     my ($file2name) = $file2 =~ /\/([^\/]*)$/;
    767 
    768     return -1 unless (-e $file1 && -e $file2);
    769     if ($file1name ne $file2name) {
    770     print STDERR "filenames are not the same\n" if ($verbosity >= 2);
    771     return 1;
    772     }
    773 
    774     my @file1stat = stat ($file1);
    775     my @file2stat = stat ($file2);
    776 
    777     if (-d $file1) {
    778     if (! -d $file2) {
    779         print STDERR "one file is a directory\n" if ($verbosity >= 2);
    780         return 1;
    781     }
    782     return 0;
    783     }
    784 
    785     # both must be regular files
    786     unless (-f $file1 && -f $file2) {
    787     print STDERR "one file is not a regular file\n" if ($verbosity >= 2);
    788     return 1;
    789     }
    790 
    791     # the size of the files must be the same
    792     if ($file1stat[7] != $file2stat[7]) {
    793     print STDERR "different sized files\n" if ($verbosity >= 2);
    794     return 1;
    795     }
    796 
    797     # the second file cannot be older than the first
    798     if ($file1stat[9] > $file2stat[9]) {
    799     print STDERR "file is older\n" if ($verbosity >= 2);
    800     return 1;
    801     }
    802 
    803     return 0;
     189  warnings::warnif("deprecated", "util::differentfiles() is deprecated, using FileUtils::differentFiles() instead");
     190  return &FileUtils::differentFiles(@_);
    804191}
    805192
    … …  
    822209    }
    823210
    824     my $tmpdir = filename_cat($ENV{'GSDLHOME'}, "tmp");
     211    my $tmpdir = &FileUtils::filenameConcatenate($ENV{'GSDLHOME'}, "tmp");
    825212    &mk_all_dir ($tmpdir) unless -e $tmpdir;
    826213
    827214    my $count = 1000;
    828215    my $rand = int(rand $count);
    829     my $full_tmp_filename = &filename_cat($tmpdir, "F$rand$opt_dot_file_ext");
     216    my $full_tmp_filename = &FileUtils::filenameConcatenate($tmpdir, "F$rand$opt_dot_file_ext");
    830217
    831218    while (-e $full_tmp_filename) {
    832219    $rand = int(rand $count);
    833     $full_tmp_filename = &filename_cat($tmpdir, "F$rand$opt_dot_file_ext");
     220    $full_tmp_filename = &FileUtils::filenameConcatenate($tmpdir, "F$rand$opt_dot_file_ext");
    834221    $count++;
    835222    }
    … …  
    850237    }
    851238
    852     $tmp_dirname = &util::filename_cat($tmp_dirname, "tmp");
     239    $tmp_dirname = &FileUtils::filenameConcatenate($tmp_dirname, "tmp");
    853240    &util::mk_dir($tmp_dirname) if (!-e $tmp_dirname);
    854241
    … …  
    856243    # if documents have the same name
    857244    my $timestamp = time;
    858     my $time_tmp_dirname = &util::filename_cat($tmp_dirname, $timestamp);
     245    my $time_tmp_dirname = &FileUtils::filenameConcatenate($tmp_dirname, $timestamp);
    859246    $tmp_dirname = $time_tmp_dirname;
    860247    my $i = 1;
    … …  
    895282    }
    896283    $output_ext= lc($output_ext);
    897     my $tmp_filename = &util::filename_cat($tmp_dirname, "$tailname$output_ext");
     284    my $tmp_filename = &FileUtils::filenameConcatenate($tmp_dirname, "$tailname$output_ext");
    898285   
    899286    return $tmp_filename;
    … …  
    902289sub get_toplevel_tmp_dir
    903290{
    904     return filename_cat($ENV{'GSDLHOME'}, "tmp");
     291    return &FileUtils::filenameConcatenate($ENV{'GSDLHOME'}, "tmp");
    905292}
    906293
    … …  
    940327
    941328sub filename_cat {
    942     my $first_file = shift(@_);
    943     my (@filenames) = @_;
    944 
    945 #   Useful for debugging
    946 #     -- might make sense to call caller(0) rather than (1)??
    947 #   my ($cpackage,$cfilename,$cline,$csubr,$chas_args,$cwantarray) = caller(1);
    948 #   print STDERR "Calling method: $cfilename:$cline $cpackage->$csubr\n";
    949    
    950     # If first_file is not null or empty, then add it back into the list
    951     if (defined $first_file && $first_file =~ /\S/) {
    952     unshift(@filenames, $first_file);
    953     }
    954 
    955     my $filename = join("/", @filenames);
    956 
    957     # remove duplicate slashes and remove the last slash
    958     if ($ENV{'GSDLOS'} =~ /^windows$/i) {
    959     $filename =~ s/[\\\/]+/\\/g;
    960     } else {
    961     $filename =~ s/[\/]+/\//g;
    962     # DB: want a filename abc\de.html to remain like this
    963     }
    964     $filename =~ s/[\\\/]$//;
    965 
    966     return $filename;
     329  # I've disabled this warning for now, as every Greenstone perl
     330  # script seems to make use of this function and so you drown in a
     331  # sea of deprecated warnings [jmt12]
     332#  warnings::warnif("deprecated", "util::filename_cat() is deprecated, using FileUtils::filenameConcatenate() instead");
     333  return &FileUtils::filenameConcatenate(@_);
    967334}
    968335
    … …  
    1074441    my $filename_full_path = $file;
    1075442    # add on directory if present
    1076     $filename_full_path = &util::filename_cat ($base_dir, $file) if $base_dir =~ /\S/;
     443    $filename_full_path = &FileUtils::filenameConcatenate($base_dir, $file) if $base_dir =~ /\S/;
    1077444   
    1078445    my $filename_no_path = $file;
    … …  
    1106473    # use filename_cat to clean up trailing slashes and
    1107474    # multiple slashes
    1108     $filename1 = filename_cat ($filename1);
    1109     $filename2 = filename_cat ($filename2);
     475    $filename1 = &FileUtils::filenameConcatenate($filename1);
     476    $filename2 = &FileUtils::filenameConcatenate($filename2);
    1110477
    1111478    # filenames not case sensitive on windows
    … …  
    1237604    my ($base_dir,$file,$gli) = @_;
    1238605
    1239     my $filename_full_path = &util::filename_cat($base_dir,$file);
     606    my $filename_full_path = &FileUtils::filenameConcatenate($base_dir,$file);
    1240607
    1241608    if ($ENV{'GSDLOS'} =~ m/^windows$/i) {
    … …  
    1327694sub filename_is_absolute
    1328695{
    1329     my ($filename) = @_;
    1330 
    1331     if ($ENV{'GSDLOS'} =~ /^windows$/i) {
    1332     return ($filename =~ m/^(\w:)?\\/);
    1333     }
    1334     else {
    1335     return ($filename =~ m/^\//);
    1336     }
     696  warnings::warnif("deprecated", "util::filename_is_absolute() is deprecated, using FileUtils::isFilenameAbsolute() instead");
     697  return &FileUtils::isFilenameAbsolute(@_);
    1337698}
    1338699
    … …  
    1441802
    1442803    if (!defined $collectdir || $collectdir eq "") {
    1443     $collectdir = &filename_cat ($ENV{'GSDLHOME'}, "collect");
     804    $collectdir = &FileUtils::filenameConcatenate($ENV{'GSDLHOME'}, "collect");
    1444805    }
    1445806
    … …  
    1462823    # are defined
    1463824    $ENV{'GSDLCOLLECTION'} = $collection;
    1464     $ENV{'GSDLCOLLECTDIR'} = &filename_cat ($collectdir, $collection);
     825    $ENV{'GSDLCOLLECTDIR'} = &FileUtils::filenameConcatenate($collectdir, $collection);
    1465826
    1466827    # make sure this collection exists
    … …  
    1487848    if (!defined $collectdir || $collectdir eq "") {
    1488849    die "GSDL3HOME not set.\n" unless defined $ENV{'GSDL3HOME'};
    1489     $collectdir = &filename_cat ($ENV{'GSDL3HOME'}, "sites", $site, "collect");
     850    $collectdir = &FileUtils::filenameConcatenate($ENV{'GSDL3HOME'}, "sites", $site, "collect");
    1490851    }
    1491852
    … …  
    1523884    if (defined $ENV{'GSDLCOLLECTDIR'} && $ENV{'GSDLCOLLECTDIR'} ne "") {
    1524885        my $test_collect_etc_filename
    1525         = &util::filename_cat($ENV{'GSDLCOLLECTDIR'},"etc", $file);
     886        = &FileUtils::filenameConcatenate($ENV{'GSDLCOLLECTDIR'},"etc", $file);
    1526887       
    1527888        if (-e $test_collect_etc_filename) {
    … …  
    1530891    }
    1531892    my $test_main_etc_filename
    1532         = &util::filename_cat($ENV{'GSDLHOME'},"etc", $file);
     893        = &FileUtils::filenameConcatenate($ENV{'GSDLHOME'},"etc", $file);
    1533894    if (-e $test_main_etc_filename) {
    1534895        push(@locations,$test_main_etc_filename);
    … …  
    1553914# A method to check if a directory is empty (note that an empty directory still has non-zero size!!!)
    1554915# Code is from http://episteme.arstechnica.com/eve/forums/a/tpc/f/6330927813/m/436007700831
    1555 sub is_dir_empty
    1556 {
    1557     my ($path) = @_;
    1558     opendir DIR, $path;
    1559     while(my $entry = readdir DIR) {
    1560         next if($entry =~ /^\.\.?$/);
    1561         closedir DIR;
    1562         return 0;
    1563     }
    1564     closedir DIR;
    1565     return 1;
     916sub is_dir_empty {
     917  warnings::warnif("deprecated", "util::is_dir_empty() is deprecated, using FileUtils::isDirectoryEmpty() instead");
     918  return &FileUtils::isDirectoryEmpty(@_);
    1566919}
    1567920
    … …  
    16691022    if($ENV{'GSDL3SRCHOME'}) {
    16701023    $defaultUrlprefix = "/greenstone3";
    1671     $configfile = &util::filename_cat($ENV{'GSDL3SRCHOME'}, "packages", "tomcat", "conf", "Catalina", "localhost", "greenstone3.xml");
     1024    $configfile = &FileUtils::filenameConcatenate($ENV{'GSDL3SRCHOME'}, "packages", "tomcat", "conf", "Catalina", "localhost", "greenstone3.xml");
    16721025    push(@propertynames, qw/path\s*\=/);
    16731026    } else {
    16741027    $defaultUrlprefix = "/greenstone";
    1675     $configfile = &util::filename_cat($ENV{'GSDLHOME'}, "cgi-bin", &os_dir(), "gsdlsite.cfg");
     1028    $configfile = &FileUtils::filenameConcatenate($ENV{'GSDLHOME'}, "cgi-bin", &os_dir(), "gsdlsite.cfg");
    16761029    push(@propertynames, (qw/\nhttpprefix/, qw/\ngwcgi/)); # inspect one property then the other
    16771030    }
    … …  
    17771130   
    17781131    if($ENV{'PERLPATH'}) {
    1779         # OR: # $perl_exec = &util::filename_cat($ENV{'PERLPATH'},"perl");
     1132        # OR: # $perl_exec = &FileUtils::filenameConcatenate($ENV{'PERLPATH'},"perl");
    17801133        if($ENV{'GSDLOS'} =~ m/windows/) {
    17811134            $perl_exec = "$ENV{'PERLPATH'}\\Perl.exe";
    … …  
    18041157    if(defined $ENV{'GSDLHOME'}) { # should be, as this script would be launched from the cmd line
    18051158                               # after running setup.bat or from GLI which also runs setup.bat
    1806     my $java_bin = &util::filename_cat($ENV{'GSDLHOME'},"packages","jre","bin");
     1159    my $java_bin = &FileUtils::filenameConcatenate($ENV{'GSDLHOME'},"packages","jre","bin");
    18071160    if(-d $java_bin) {
    1808         $java = &util::filename_cat($java_bin,"java");
     1161        $java = &FileUtils::filenameConcatenate($java_bin,"java");
    18091162        $java = "\"".$java."\""; # quoted to preserve spaces in path
    18101163    }
    … …  
    18441197   
    18451198    if (defined $collect_dir && $collect_dir) { # ensure not empty string either
    1846         return &util::filename_cat($collect_dir,$colgroup, $collection);
     1199        return &FileUtils::filenameConcatenate($collect_dir,$colgroup, $collection);
    18471200    }
    18481201    elsif (defined($ENV{'GSDLCOLLECTDIR'})) {
    … …  
    18511204    else {
    18521205        if (defined $site) {
    1853             return &util::filename_cat($ENV{'GSDL3HOME'},"sites",$site,"collect",$colgroup, $collection);
     1206            return &FileUtils::filenameConcatenate($ENV{'GSDL3HOME'},"sites",$site,"collect",$colgroup, $collection);
    18541207        }
    18551208        else {
    1856             return &util::filename_cat($ENV{'GSDLHOME'},"collect",$colgroup, $collection);
     1209            return &FileUtils::filenameConcatenate($ENV{'GSDLHOME'},"collect",$colgroup, $collection);
    18571210        }
    18581211    }
    … …  
    18641217{
    18651218    my ($output_dir, $convert_basename, $convert_to) = @_;
    1866     opendir(DIR, $output_dir) || die "can't opendir $output_dir: $!"; 
    1867 
    18681219    my $page_num = "";
     1220
     1221    opendir(DIR, $output_dir) || die "can't opendir $output_dir: $!";
    18691222    my @dir_files = grep {-f "$output_dir/$_"} readdir(DIR);
    1870 
    1871     # Sort files in the directory by page_num   
     1223    closedir DIR;
     1224
     1225    # Sort files in the directory by page_num
    18721226    sub page_number {
    18731227    my ($dir) = @_;
    … …  
    18781232    }
    18791233
    1880     # sort the files in the directory in the order of page_num rather than lexically. 
     1234    # sort the files in the directory in the order of page_num rather than lexically.
    18811235    @dir_files = sort { page_number($a) <=> page_number($b) } @dir_files;
    18821236
    … …  
    18891243    }
    18901244
    1891     my $item_file = &util::filename_cat($output_dir, $convert_basename.".item");
    1892     open(FILE,">$item_file");   
    1893     print FILE "<PagedDocument>\n";
     1245    my $item_file = &FileUtils::filenameConcatenate($output_dir, $convert_basename.".item");
     1246    my $item_fh;
     1247    &FileUtils::openFileHandle($item_file, 'w', \$item_fh);
     1248    print $item_fh "<PagedDocument>\n";
    18941249
    18951250    foreach my $file (@dir_files){
    … …  
    18971252        $page_num = page_number($file);
    18981253        $page_num++ if $starts_at_0; # image numbers start at 0, so add 1
    1899         print FILE "   <Page pagenum=\"$page_num\" imgfile=\"$file\" txtfile=\"\"/>\n";
    1900     }
    1901     }
    1902 
    1903     print FILE "</PagedDocument>\n";
    1904     close FILE;
    1905     closedir DIR;
     1254        print $item_fh "   <Page pagenum=\"$page_num\" imgfile=\"$file\" txtfile=\"\"/>\n";
     1255    }
     1256    }
     1257
     1258    print $item_fh "</PagedDocument>\n";
     1259    &FileUtils::closeFileHandle($item_file, \$item_fh);
    19061260    return $item_file;
    19071261}
    19081262
     1263
     1264# /** @function augmentINC()
     1265#  * Prepend a path (if it exists) onto INC but only if it isn't already in
     1266#  * INC
     1267#  * @param $new_path The path to add as necessary
     1268#  * @author jmt12
     1269#  */
     1270sub augmentINC
     1271{
     1272  my ($new_path) = @_;
     1273  my $did_add_path = 0;
     1274  # will need to be replaced with FileUtils::directoryExists() call eventually
     1275  if (-d $new_path)
     1276  {
     1277    my $did_find_path = 0;
     1278    foreach my $existing_path (@INC)
     1279    {
     1280      if ($existing_path eq $new_path)
     1281      {
     1282        $did_find_path = 1;
     1283        last;
     1284      }
     1285    }
     1286    if (!$did_find_path)
     1287    {
     1288      unshift(@INC, $new_path);
     1289      $did_add_path = 1;
     1290    }
     1291  }
     1292  return $did_add_path;
     1293}
     1294# /** augmentINC($new_path) **/
     1295
    190912961;
Note: See TracChangeset for help on using the changeset viewer.