root/gs2-extensions/parallel-building/trunk/src/perllib/FileUtils/LocalFS.pm @ 27567

Revision 27567, 13.4 KB (checked in by jmt12, 6 years ago)

Found a printWarning that I handed changed to use the FileUtils? version

Line 
1###############################################################################
2#
3# LocalFS.pm -- file functions acting upon the local filesystem
4#
5# A component of the Greenstone digital library software from the New Zealand
6# Digital Library Project at the University of Waikato, New Zealand.
7#
8# Copyright (C) 2013 New Zealand Digital Library Project
9#
10# This program is free software; you can redistribute it and/or modify it under
11# the terms of the GNU General Public License as published by the Free Software
12# Foundation; either version 2 of the License, or (at your option) any later
13# version.
14#
15# This program is distributed in the hope that it will be useful, but WITHOUT
16# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
17# FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
18# details.
19#
20# You should have received a copy of the GNU General Public License along with
21# this program; if not, write to the Free Software Foundation, Inc., 675 Mass
22# Ave, Cambridge, MA 02139, USA.
23#
24###############################################################################
25
26package FileUtils::LocalFS;
27
28# Pragma
29use strict;
30
31
32## @function canRead()
33#
34sub canRead
35{
36  my $path = shift(@_);
37  return &fileTest($path, '-R');
38}
39## canRead()
40
41
42## @function closeFileHandle
43#
44sub closeFileHandle
45{
46  my $fh_ref = shift(@_);
47  close($$fh_ref);
48  return 1;
49}
50## closeFileHandle()
51
52
53## @function filenameConcatenate()
54#
55sub filenameConcatenate
56{
57  my $first_file = shift(@_);
58  my (@filenames) = @_;
59
60  #   Useful for debugging
61  #     -- might make sense to call caller(0) rather than (1)??
62  #   my ($cpackage,$cfilename,$cline,$csubr,$chas_args,$cwantarray) = caller(1);
63  #   print STDERR "Calling method: $cfilename:$cline $cpackage->$csubr\n";
64
65  # If first_file is not null or empty, then add it back into the list
66  if (defined $first_file && $first_file =~ /\S/) {
67    unshift(@filenames, $first_file);
68  }
69
70  my $filename = join("/", @filenames);
71
72  # remove duplicate slashes and remove the last slash
73  if ($ENV{'GSDLOS'} =~ /^windows$/i) {
74    $filename =~ s/[\\\/]+/\\/g;
75  } else {
76    $filename =~ s/[\/]+/\//g;
77    # DB: want a filename abc\de.html to remain like this
78  }
79  $filename =~ s/[\\\/]$//;
80
81  return $filename;
82}
83## filenameConcatenate()
84
85
86## @function fileSize()
87#
88sub fileSize
89{
90  my ($filename_full_path) = @_;
91  return -s $filename_full_path;
92}
93## fileStatus()
94
95
96## @function fileTest()
97#
98sub fileTest
99{
100  my $filename_full_path = shift(@_);
101  # By default tests for existance of file or directory (-e)
102  # Can be made more specific by providing second parameter (e.g. -f or -d)
103  my $test_op = shift(@_) || '-e';
104
105  my $exists = 0;
106
107  if ($ENV{'GSDLOS'} =~ m/^windows$/i) {
108    require Win32;
109    my $filename_short_path = Win32::GetShortPathName($filename_full_path);
110    if (!defined $filename_short_path) {
111      # Was probably still in UTF8 form (not what is needed on Windows)
112      my $unicode_filename_full_path = eval "decode(\"utf8\",\$filename_full_path)";
113      if (defined $unicode_filename_full_path) {
114        $filename_short_path = Win32::GetShortPathName($unicode_filename_full_path);
115      }
116    }
117    $filename_full_path = $filename_short_path;
118  }
119
120  if (defined $filename_full_path) {
121    $exists = eval "($test_op \$filename_full_path)";
122  }
123
124  # The eval may result in exists being undefined, but we need to return
125  # something
126  return ($exists || 0);
127}
128## fileTest()
129
130
131## @function isFilenameAbsolute()
132#
133sub isFilenameAbsolute
134{
135  my ($filename) = @_;
136  if ($ENV{'GSDLOS'} =~ /^windows$/i)
137  {
138    return ($filename =~ m/^(\w:)?\\/);
139  }
140  return ($filename =~ m/^\//);
141}
142# isFilenameAbsolute()
143
144
145## @function isHDFS
146#
147sub isHDFS
148{
149  return 0;
150}
151## isHDFS()
152
153
154## @function linkFile()
155#
156sub linkFile
157{
158  my ($mode, $src, $dest, $ensure_paths_absolute) = @_;
159
160  # remove trailing slashes from source and destination files
161  $src =~ s/[\\\/]+$//;
162  $dest =~ s/[\\\/]+$//;
163
164  # Ensure file paths are absolute IF requested to do so
165  # Soft_linking didn't work for relative paths
166  if($mode eq 'HARD' || (defined $ensure_paths_absolute && $ensure_paths_absolute))
167  {
168    # We need to ensure that the src file is the absolute path
169    # See http://perldoc.perl.org/File/Spec.html
170    if(!File::Spec->file_name_is_absolute( $src ))
171    {
172      # it's relative
173      $src = File::Spec->rel2abs($src); # make absolute
174    }
175    # Might as well ensure that the destination file's absolute path is used
176    if(!File::Spec->file_name_is_absolute( $dest ))
177    {
178      $dest = File::Spec->rel2abs($dest); # make absolute
179    }
180  }
181
182  # a few sanity checks
183  if (!-e $src)
184  {
185    &FileUtils::printError('Source file does not exist: ' . $src);
186    return 0;
187  }
188
189  my $dest_dir = &File::Basename::dirname($dest);
190  if (!-e $dest_dir)
191  {
192    &makeAllDirectories($dest_dir);
193  }
194
195  if ($ENV{'GSDLOS'} =~ /^windows$/i)
196  {
197    # symlink not supported on windows
198    &FileUtils::printWarning('Symlink not supported on windows');
199  }
200  elsif ($mode eq 'HARD')
201  {
202    if (!eval {link($src, $dest)})
203    {
204      &FileUtils::printWarning('Unable to create hard link: ' . $dest);
205    }
206  }
207  elsif ($mode eq 'SOFT')
208  {
209    if (!eval {symlink($src, $dest)})
210    {
211      &FileUtils::printWarning('Unable to create soft link: ' . $src);
212    }
213  }
214  else
215  {
216    &FileUtils::printError('Unknown mode requested: ' . $mode);
217  }
218  if (!-e $dest)
219  {
220    &FileUtils::printWarning('linkFile', 'Link failed. Attempting to copy instead.');
221    &File::Copy::copy ($src, $dest);
222  }
223  return (-e $dest);
224}
225# /** linkFile() **/
226
227## @function makeDirectory()
228#
229sub makeDirectory
230{
231  my $dir = shift(@_);
232  my $store_umask = umask(0002);
233  my $mkdir_ok = mkdir ($dir, 0777);
234  umask($store_umask);
235  return $mkdir_ok;
236}
237## makeDirectory()
238
239
240## @function modificationTime()
241#
242sub modificationTime
243{
244  my $path = shift(@_);
245  my @file_status = stat($path);
246  return $file_status[9];
247}
248## modificationTime()
249
250## @function openFileHandle()
251#
252sub openFileHandle
253{
254  my $path = shift(@_);
255  my $mode = shift(@_);
256  my $fh_ref = shift(@_);
257  my $encoding = shift(@_);
258  my $mode_symbol;
259  if ($mode eq 'w' || $mode eq '>')
260  {
261    $mode_symbol = '>';
262    $mode = 'writing';
263  }
264  elsif ($mode eq 'a' || $mode eq '>>')
265  {
266    $mode_symbol = '>>';
267    $mode = 'appending';
268  }
269  else
270  {
271    $mode_symbol = '<';
272    $mode = 'reading';
273  }
274  if (defined $encoding)
275  {
276    $mode_symbol .= ':' . $encoding;
277  }
278  if (!open($$fh_ref, $mode_symbol, $path))
279  {
280    &FileUtils::printError('Failed to open file for ' . $mode . ': ' . $path, 1);
281  }
282  return 1;
283}
284## openFileHandle()
285
286# /**
287#  */
288sub readDirectory
289{
290  my $path = shift(@_);
291  opendir(DH, $path) or &FileUtils::printError('Failed to open directory for reading: ' . $path, 1);
292  my @files = readdir(DH);
293  close(DH);
294  return \@files;
295}
296# /** readDirectory() **/
297
298
299## @function removeFiles()
300#
301sub removeFiles
302{
303  my $file = shift(@_);
304  my $result = 0;
305  if (!-e $file && !-l $file)
306  {
307    &FileUtils::printError('File does not exist: ' . $file);
308  }
309  elsif ((!-f $file) && (!-l $file))
310  {
311    &FileUtils::printError('Not a regular file: ' . $file);
312  }
313  else
314  {
315    $result = unlink($file);
316    if (!$result)
317    {
318      &FileUtils::printError('Failed to remove file: ' . $file);
319    }
320  }
321  return $result;
322}
323## removeFiles()
324
325
326## @function removeFilesFiltered()
327#
328# recursive removal
329#
330sub removeFilesFiltered
331{
332  my ($files, $file_accept_re, $file_reject_re) = @_;
333  #   my ($cpackage,$cfilename,$cline,$csubr,$chas_args,$cwantarray) = caller(2);
334  #   my ($lcfilename) = ($cfilename =~ m/([^\\\/]*)$/);
335  #   print STDERR "** Calling method (2): $lcfilename:$cline $cpackage->$csubr\n";
336  my @files_array = (ref $files eq "ARRAY") ? @$files : ($files);
337
338  my $num_removed = 0;
339
340  foreach my $file (@files_array)
341  {
342    # remove trailing slashes
343    $file =~ s/[\/\\]+$//;
344
345    if (!-e $file)
346    {
347      print STDERR "util::filtered_rm_r $file does not exist\n";
348    }
349    # don't recurse down symbolic link
350    elsif ((-d $file) && (!-l $file))
351    {
352      # get the contents of this directory
353      if (!opendir (INDIR, $file))
354      {
355        print STDERR "util::filtered_rm_r could not open directory $file\n";
356      }
357      else
358      {
359        my @filedir = grep (!/^\.\.?$/, readdir (INDIR));
360        closedir (INDIR);
361
362        # remove all the files in this directory
363        map {$_="$file/$_";} @filedir;
364        $num_removed += &FileUtils::LocalFS::removeFilesFiltered(\@filedir, $file_accept_re, $file_reject_re);
365
366        if (!defined $file_accept_re && !defined $file_reject_re)
367        {
368          # remove this directory
369          if (!rmdir $file)
370          {
371            print STDERR "util::filtered_rm_r couldn't remove directory $file\n";
372          }
373          else
374          {
375            $num_removed++;
376          }
377        }
378      }
379    }
380    else
381    {
382      next if (defined $file_reject_re && ($file =~ m/$file_reject_re/));
383
384      if ((!defined $file_accept_re) || ($file =~ m/$file_accept_re/))
385      {
386        # remove this file
387        $num_removed += &removeFiles($file);
388      }
389    }
390  }
391  return $num_removed;
392}
393## removeFilesFiltered()
394
395
396## @function removeFilesRecursive()
397#
398sub removeFilesRecursive
399{
400  my $path = shift(@_);
401  # use the more general (but reterospectively written filteredRemove()
402  # function with no accept or reject expressions
403  return FileUtils::LocalFS::removeFilesFiltered($path, undef, undef);
404}
405## removeFilesRecursive()
406
407
408## @function supportsSymbolicLink
409#
410sub supportsSymbolicLink
411{
412  return 1;
413}
414## supportsSymbolicLink()
415
416
417## @function synchronizeDirectory()
418#
419# updates a copy of a directory in some other part of the filesystem
420# verbosity settings are: 0=low, 1=normal, 2=high
421# both $fromdir and $todir should be absolute paths
422#
423sub synchronizeDirectory
424{
425  my ($fromdir, $todir, $verbosity) = @_;
426  $verbosity = 1 unless defined $verbosity;
427
428  # use / for the directory separator, remove duplicate and
429  # trailing slashes
430  $fromdir=~s/[\\\/]+/\//g;
431  $fromdir=~s/[\\\/]+$//;
432  $todir=~s/[\\\/]+/\//g;
433  $todir=~s/[\\\/]+$//;
434
435  &mk_all_dir ($todir);
436
437  # get the directories in ascending order
438  if (!opendir (FROMDIR, $fromdir))
439  {
440    print STDERR "util::cachedir could not read directory $fromdir\n";
441    return;
442  }
443  my @fromdir = grep (!/^\.\.?$/, sort(readdir (FROMDIR)));
444  closedir (FROMDIR);
445
446  if (!opendir (TODIR, $todir))
447  {
448    print STDERR "util::cacedir could not read directory $todir\n";
449    return;
450  }
451  my @todir = grep (!/^\.\.?$/, sort(readdir (TODIR)));
452  closedir (TODIR);
453
454  my $fromi = 0;
455  my $toi = 0;
456
457  while ($fromi < scalar(@fromdir) || $toi < scalar(@todir))
458  {
459    #   print "fromi: $fromi toi: $toi\n";
460
461    # see if we should delete a file/directory
462    # this should happen if the file/directory
463    # is not in the from list or if its a different
464    # size, or has an older timestamp
465    if ($toi < scalar(@todir))
466    {
467      if (($fromi >= scalar(@fromdir)) ||
468          ($todir[$toi] lt $fromdir[$fromi] ||
469           ($todir[$toi] eq $fromdir[$fromi] &&
470            &differentfiles("$fromdir/$fromdir[$fromi]","$todir/$todir[$toi]",
471                            $verbosity))))
472      {
473        # the files are different
474        &rm_r("$todir/$todir[$toi]");
475        splice(@todir, $toi, 1); # $toi stays the same
476      }
477      elsif ($todir[$toi] eq $fromdir[$fromi])
478      {
479        # the files are the same
480        # if it is a directory, check its contents
481        if (-d "$todir/$todir[$toi]")
482        {
483          &synchronizeDirectory("$fromdir/$fromdir[$fromi]", "$todir/$todir[$toi]", $verbosity);
484        }
485
486        $toi++;
487        $fromi++;
488        next;
489      }
490    }
491
492    # see if we should insert a file/directory
493    # we should insert a file/directory if there
494    # is no tofiles left or if the tofile does not exist
495    if ($fromi < scalar(@fromdir) && ($toi >= scalar(@todir) ||
496                                      $todir[$toi] gt $fromdir[$fromi]))
497    {
498      &cp_r ("$fromdir/$fromdir[$fromi]", "$todir/$fromdir[$fromi]");
499      splice (@todir, $toi, 0, $fromdir[$fromi]);
500      $toi++;
501      $fromi++;
502    }
503  }
504}
505## synchronizeDirectory()
506
507
508# /**
509#  */
510sub transferFile
511{
512  my ($mode, $file, $dest) = @_;
513  # remove trailing slashes from source and destination files
514  $file =~ s/[\\\/]+$//;
515  $dest =~ s/[\\\/]+$//;
516  my $tempdest = $dest;
517  if (!-e $file)
518  {
519    &FileUtils::printError('File does not exist: ' . $file);
520  }
521  else
522  {
523    if (-d $tempdest)
524    {
525      my ($filename) = $file =~ /([^\\\/]+)$/;
526      $tempdest .= "/$filename";
527    }
528    # start by processing any move request
529    if ($mode eq 'MOVE')
530    {
531      &File::Copy::move($file, $tempdest);
532    }
533    # now if we were instead doing a copy, or if the move request above failed
534    # for some reason, we process a copy request
535    if ($mode eq 'COPY' || !-e $tempdest)
536    {
537      &File::Copy::copy($file, $tempdest);
538    }
539    # finally, we check if a successful move command has somehow left the origin
540    # file lying around (rename partially succeeded - for instance when moving
541    # hardlinks)
542    if ($mode eq 'MOVE' && -e $tempdest && -e $file)
543    {
544      unlink($file);
545    }
546  }
547  # Have we successfully moved the file?
548  my $result = 0;
549  if (-e $tempdest)
550  {
551    if ($mode eq 'MOVE')
552    {
553      if (-e $file)
554      {
555        &FileUtils::printError('Failed to remove original file during move: ' . $file);
556      }
557      else
558      {
559        $result = 1;
560      }
561    }
562    else
563    {
564      $result = 1;
565    }
566  }
567  else
568  {
569    &FileUtils::printError('Failed to move/copy file: ' . $file);
570  }
571  return $result;
572}
573# /** moveFile() **/
574
5751;
Note: See TracBrowser for help on using the browser.