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

Revision 27386, 14.0 KB (checked in by jmt12, 6 years ago)

Forgot these were just symbolic links to my Dropbox folder - adding in the actual files

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