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

Revision 30352, 24.4 KB (checked in by jmt12, 5 years ago)

Adding in a function to test whether a File driver has a certain function. Also adding in support for an optional driver funtion to determine if a certain path is special (and so shouldn't be changed) or not

Line 
1###########################################################################
2#
3# FileUtils.pm -- functions for dealing with files. Will delegate to the
4#                 appropriate filesystem driver based upon any file
5#                 protocol specified and dependent on configuration as
6#                 defined by the collection admin
7#
8# A component of the Greenstone digital library software
9# from the New Zealand Digital Library Project at the
10# University of Waikato, New Zealand.
11#
12# Copyright (C) 2013 New Zealand Digital Library Project
13#
14# This program is free software; you can redistribute it and/or modify
15# it under the terms of the GNU General Public License as published by
16# the Free Software Foundation; either version 2 of the License, or
17# (at your option) any later version.
18#
19# This program is distributed in the hope that it will be useful,
20# but WITHOUT ANY WARRANTY; without even the implied warranty of
21# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
22# GNU General Public License for more details.
23#
24# You should have received a copy of the GNU General Public License
25# along with this program; if not, write to the Free Software
26# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
27#
28###########################################################################
29
30package FileUtils;
31
32# Perl Modules
33use strict;
34use Symbol qw<qualify>;
35
36# Greenstone Modules
37use util;
38
39# Configuration
40my $debug = 0;
41my $linking_disabled = 0;
42
43# Globals
44my $done_link_warning = 0;
45
46## @function _callFunction($driver_name, $function_name, ...)
47#
48# Make a function call to a dynamically loaded database driver.
49# @param $driver_name - The name of the file protocol driver to load
50# @param $function_name - The function within the driver to call
51# @param <rest> - The parameters to be passed to the function called
52#
53sub _callFunction
54{
55  my $driver_name = shift(@_);
56  my $function_name = shift(@_);
57  &_prettyPrint(0, $driver_name, $function_name, @_) unless (!$debug);
58  # Need to look within fileutils directory
59  my $package_name = 'FileUtils::' . $driver_name;
60  # Try to load the requested infodb type
61  if (!&_loadDriver($package_name))
62  {
63    &printError('Failed to load requested file protocol driver: ' . $package_name, 1);
64  }
65  # Then make call to the newly created package
66  no strict;
67  # Better check that the function we are about to call exists
68  my $symbol = qualify($function_name, $package_name);
69  unless ( defined &{$symbol} )
70  {
71    &printError('Function not found: ' . $package_name . '::' . $function_name, 1);
72  }
73  # Call the function and get result if applicable
74  my $result = &{$symbol}(@_);
75  &_prettyPrint(1, $result) unless (!$debug);
76  return $result;
77}
78## callFunction()
79
80
81## @function _hasFunction()
82#
83sub _hasFunction
84{
85    my $driver_name = shift(@_);
86    my $function_name = shift(@_);
87    # Need to look within fileutils directory
88    my $package_name = 'FileUtils::' . $driver_name;
89    # Try to load the requested infodb type
90    if (!&_loadDriver($package_name))
91    {
92    &printError('Failed to load requested file protocol driver: ' . $package_name, 1);
93    }
94    # Then make call to the newly created package
95    no strict;
96    # Check if the function call exists
97    my $symbol = qualify($function_name, $package_name);
98    return defined &{$symbol};
99}
100## _hasFunction()
101
102
103## @function _prettyPrint()
104#
105# Print a debugging message to STDERR constructed from the <rest> based upon
106# the type.
107# @param type - If 0, output the start of a function with a listing of its
108#               parameters. If 1, output the result of a function. 2 is
109#               used for function errors. Default to simply printing what-
110#               ever else is in <rest>
111#
112sub _prettyPrint
113{
114  my $type = shift(@_);
115  if (!defined $type || $type > 2)
116  {
117    $type = -1;
118  }
119  my ($package, $filename, $line, $function) = caller(1);
120  my $message;
121  # Start of a function
122  if (0 == $type)
123  {
124    $message = $package . '::' . $function . '(';
125    my $argument = shift(@_);
126    my $first = 1;
127    while (defined $argument)
128    {
129      if (!$first)
130      {
131        $message .= ', ';
132      }
133      else
134      {
135        $first = 0;
136      }
137      if ($argument =~ /\D/)
138      {
139        $message .= '"' . $argument . '"';
140      }
141      else
142      {
143        $message .= $argument;
144      }
145      $argument = shift(@_);
146    }
147    $message .= ')';
148  }
149  # Result of a function
150  elsif (1 == $type)
151  {
152    $message = $package . '::' . $function . '() => ';
153    my $result = shift(@_);
154    if ($result =~ /\D/)
155    {
156      $message .= '"' . $result . '"';
157    }
158    else
159    {
160      $message .= $result;
161    }
162  }
163  elsif (2 == $type)
164  {
165    my $error = shift(@_);
166    $message = 'Error in ' . $package . '::' . $function . '()! ' . $error;
167  }
168  # Else we leave the message as it is
169  else
170  {
171    $message = join("\n", @_);
172  }
173  print STDERR "[" . time() . "] " . $message . "\n";
174}
175## _prettyPrint()
176
177# /** @function _determineDriver()
178#  *  Given a file path determine the appropriate protocol. For now anything
179#  *  other than a full path beginning with an explicit protocol will default
180#  *  to using 'local' file functions.
181#  *  @return 'local'
182#  */
183sub _determineDriver
184{
185  my $path = shift(@_);
186  &_prettyPrint(0, $path) unless (!$debug);
187  # Determine the appropriate driver from the protocol
188  my $driver = 'LocalFS';
189  # - this is were I'll eventually have the ability to configure
190  #   what driver handles what protocol, hopefully from the collect.cfg
191  my $colon_index = index($path, ':');
192  if ($colon_index > -1)
193  {
194    my $protocol = substr($path, 0, $colon_index);
195    # check the perl module exists
196    eval 'require "FileUtils/' . $protocol . '.pm"';
197    #eval
198    #{
199    #  require 'FileUtils/' . $protocol . '.pm';
200    #};
201    if ($@)
202    {
203      print STDERR 'Warning! FileUtils::_determineDriver() driver not found (defaulting to local filesystem):' . $protocol . "\n" . $@ . "\n";
204    }
205    else
206    {
207      $driver = $protocol;
208    }
209  }
210  &_prettyPrint(1, $driver) unless (!$debug);
211  return $driver;
212}
213# /** _determineDriver()
214
215# /** @function _loadDriver($class, ...)
216#  *  Runtime class loading for use in FileUtils to load various protocol
217#  *  drivers, possibly configured in the collect.cfg, at runtime.
218#  *  @param $class - The class name (including any path) to load
219#  *  @param <rest> - any function aliases you want exported
220#  */
221sub _loadDriver
222{
223  my $class = shift(@_);
224  &_prettyPrint(0, $class) unless (!$debug);
225  # Convert the Perl Module-like name into a file path
226  (my $file = "$class.pm") =~ s|::|/|g;
227  # - ensure we haven't already loaded this class
228  unless( $INC{$file} )
229  {
230    require $file;
231  }
232  # - this is the magic that actually instantiates the class (rubberstamp?)
233  # - we pass @_ to action any function aliases exports requested
234  eval
235  {
236    $class->import(@_);
237  };
238  # - by now the driver file should have been loaded
239  my $result = defined $INC{$file};
240  &_prettyPrint(1, $result) unless (!$debug);
241  return $result;
242}
243# /** _loadDriver($class, ...) **/
244
245################################################################################
246
247
248## @function printError()
249#
250sub printError
251{
252  my ($message, $fatal) = @_;
253  my ($package, $filename, $line, $function) = caller(1);
254  if (defined $!)
255  {
256    $message .= ' (' . $! . ')';
257  }
258  if (defined $fatal && $fatal)
259  {
260    die('Fatal Error! ' . $package . '::' . $function . '() - ' . $message ."\n");
261  }
262  else
263  {
264    print STDERR 'Error! ' . $package . '::' . $function . '() - ' . $message ."\n";
265  }
266}
267## printError()
268
269
270## @function printWarning
271#
272sub printWarning
273{
274  my ($message) = @_;
275  my ($package, $filename, $line, $function) = caller(1);
276  print STDERR 'Warning! ' . $package . '::' . $function . '() - ' . $message . "\n";
277}
278## printWarning()
279
280################################################################################
281######################## Legacy function name mappings  ########################
282################################################################################
283# Note: there are lots of functions involving files/directories/paths etc found
284# in utils.pm that are not represented here. My intention was to just have those
285# functions that need to be dynamic based on filesystem, or need some rejigging
286# to be filesystem aware. This is an argument, I guess, for moving some of the
287# other functions here so that they are nicely encapsulated - but the question
288# is what to do with functions like filename_within_directory_url_format() which
289# is more URL based than file based... dunno.
290################################################################################
291
292sub cachedir {return synchronizeDirectory(@_);}
293sub cp {return copyFiles(@_);}
294sub cp_r {print "implement cp_r()";}
295sub cp_r_nosvn {print "implement cp_r_nosvn()";}
296sub cp_r_toplevel {print "implement cp_r_toplevel()";}
297sub differentfiles {return &differentFiles(@_);}
298sub dir_exists {return &directoryExists(@_);}
299sub file_exists {return &fileExists(@_);}
300sub file_lastmodified {return &modificationTime(@_);}
301sub file_readdir {return readDirectory(@_);}
302sub file_size {return &fileSize(@_);}
303sub filename_cat {return filenameConcatenate(@_);}
304sub filename_is_absolute {return &isFilenameAbsolute();};
305sub filtered_rm_r {print "implement filtered_rm_r()";}
306sub hard_link {print "implement hard_link()";}
307sub is_dir_empty {return &isDirectoryEmpty();}
308sub mk_all_dir {return &makeAllDirectories(@_);}
309sub mk_dir {return &makeDirectory(@_);}
310sub mv {return &moveFiles(@_);}
311sub mv_dir_contents {print "implement mv_dir_contents()";}
312sub rm {print "implement rm()";}
313sub rm_debug {print "implement rm_debug()";}
314sub rm_r {print "implement rm_r()";}
315sub soft_link {print "implement soft_link()";}
316
317################################################################################
318########## Common functions  ##########
319################################################################################
320# Note: these are the file-based functions that are not dynamic in themselves,
321# but that need significant changes to support multiple possible filesystems.
322################################################################################
323
324
325## @function differentFiles
326# (previous util.pm version used -e, -d, and 'stat', none of which support
327#  *  filesystems such as hadoop)
328#  */
329sub differentFiles
330{
331  my ($file1, $file2, $verbosity) = @_;
332  if (!defined $verbosity)
333  {
334    $verbosity = 1
335  }
336
337  # remove trailing slashes
338  $file1 =~ s/\/+$//;
339  $file2 =~ s/\/+$//;
340
341  # chop off the last part of the path as the file/dir name
342  my ($file1name) = $file1 =~ /\/([^\/]*)$/;
343  my ($file2name) = $file2 =~ /\/([^\/]*)$/;
344
345  # - cheapest first; test the two filename strings are the same
346  if ($file1name ne $file2name)
347  {
348    print STDERR "filenames are not the same\n" if ($verbosity >= 2);
349    return 1;
350  }
351
352  if (!&pathExists($file1) || !&pathExists($file2))
353  {
354    print STDERR "one or other file doesn't exist\n" if ($verbosity >= 2);
355    return -1;
356  }
357
358  if (&directoryExists($file1))
359  {
360    if (!&directoryExists($file2))
361    {
362      print STDERR "one file is a directory\n" if ($verbosity >= 2);
363      return 1;
364    }
365    return 0;
366  }
367
368  # both must be regular files
369  unless (&fileExists($file1) && &fileExists($file2))
370  {
371    print STDERR "one file is not a regular file\n" if ($verbosity >= 2);
372    return 1;
373  }
374
375  # the size of the files must be the same
376  if (&fileSize($file1) != &fileSize($file2))
377  {
378    print STDERR "different sized files\n" if ($verbosity >= 2);
379    return 1;
380  }
381
382  # the second file cannot be older than the first
383  if (&modificationTime($file1) > &modificationTime($file2))
384  {
385    print STDERR "file is older\n" if ($verbosity >= 2);
386    return 1;
387  }
388
389  return 0;
390}
391# /** differentFiles() **/
392
393
394## @function fileGetContents()
395#
396sub fileGetContents
397{
398  my ($path) = @_;
399  my $content;
400  my $driver = &FileUtils::_determineDriver($path);
401  my $filesize = &FileUtils::_callFunction($driver, 'fileSize', $path);
402  my $fh;
403  &FileUtils::_callFunction($driver, 'openFileHandle', $path, '<', \$fh);
404  sysread($fh, $content, $filesize);
405  &FileUtils::_callFunction($driver, 'closeFileHandle', \$fh);
406  return $content;
407}
408## fileGetContents()
409
410
411## @function filePutContents()
412#
413sub filePutContents
414{
415  my $path = shift(@_);
416  my $str = shift(@_);
417  my $driver = &FileUtils::_determineDriver($path);
418  my $fh;
419  &FileUtils::_callFunction($driver, 'openFileHandle', $path, '>', \$fh);
420  print $fh $str;
421  &FileUtils::_callFunction($driver, 'closeFileHandle', \$fh);
422  return 1;
423}
424## filePutContents(path, str)
425
426
427## @function makeAllDirectories()
428#
429# in case anyone cares - I did some testing (using perls Benchmark module)
430# on this subroutine against File::Path::mkpath (). mk_all_dir() is apparently
431# slightly faster (surprisingly) - Stefan.
432#
433sub makeAllDirectories
434{
435  my ($raw_dir) = @_;
436  # use / for the directory separator, remove duplicate and
437  # trailing slashes
438  $raw_dir = &sanitizePath($raw_dir);
439  # ensure the directory doesn't already exist
440  if (&directoryExists($raw_dir))
441  {
442    return 0;
443  }
444  if ($raw_dir =~ /^(.+?:\/\/)?(.*)/)
445  {
446    my $dirsofar = '';
447    if (defined $1)
448    {
449      $dirsofar = $1;
450    }
451    my $dir = $2;
452    my $first = 1;
453    foreach my $dirname (split ("/", $dir))
454    {
455      $dirsofar .= "/" unless $first;
456      $first = 0;
457      $dirsofar .= $dirname;
458      next if $dirname =~ /^(|[a-z]+:)$/i;
459      # we can't create some directories (drivers specific)
460      if (&isSpecialDirectory($dirsofar)) {
461      next;
462      }
463      if (!&directoryExists($dirsofar))
464      {
465        my $mkdir_ok = &makeDirectory($dirsofar);
466        if (!$mkdir_ok)
467        {
468          &FileUtils::printError('Could not create directory: ' . $dirsofar);
469          return 0;
470        }
471      }
472    }
473  }
474  return (&directoryExists($raw_dir));
475}
476## makeAllDirectories()
477
478
479## @function sanitizePath()
480#
481sub sanitizePath
482{
483  my ($path) = @_;
484  # fortunately filename concatenate will perform all the double slash removal,
485  # end slash removal we need, and in a protocol aware fashion
486  return &filenameConcatenate($path);
487}
488## sanitizePath()
489
490
491################################################################################
492
493
494## @function canRead()
495#
496sub canRead
497{
498  my $path = shift(@_);
499  my $driver = &FileUtils::_determineDriver($path);
500  return &FileUtils::_callFunction($driver, 'canRead', $path, @_);
501}
502## canRead()
503
504
505## @function closeFileHandle()
506#
507sub closeFileHandle
508{
509  my $path = shift(@_);
510  my $driver = &FileUtils::_determineDriver($path);
511  return &FileUtils::_callFunction($driver, 'closeFileHandle', @_);
512}
513## closeFileHandle()
514
515# /**
516#  */
517sub copyFiles
518{
519  return &transferFiles(@_, 'COPY');
520}
521# /** copyFiles() **/
522
523# /**
524#  */
525sub directoryExists
526{
527  my $path = shift(@_);
528  my $driver = &FileUtils::_determineDriver($path);
529  return &FileUtils::_callFunction($driver, 'fileTest', $path, '-d');
530}
531# /** directoryExists($path) **/
532
533# /** @function file_exists($path)
534#  *  Determine if the given file path exists on the target filesystem
535#  *  @param path - the path to the file to test
536#  *  @return true if the file exists, false otherwise
537sub fileExists
538{
539  my $path = shift(@_);
540  my $driver = &FileUtils::_determineDriver($path);
541  my $result = &FileUtils::_callFunction($driver, 'fileTest', $path, '-f');
542  return $result;
543}
544# /** fileExists(path) **/
545
546# /** @function filenameConcatenate(<rest>)
547#  */
548sub filenameConcatenate
549{
550  my $first_path_part = shift(@_);
551  my $path = '';
552  if (defined $first_path_part)
553  {
554    my $driver = &FileUtils::_determineDriver($first_path_part);
555    $path = &FileUtils::_callFunction($driver, 'filenameConcatenate', $first_path_part, @_);
556  }
557  return $path;
558}
559# /** filenameConcatenate(<rest>) **/
560
561# /**
562#  */
563sub fileSize
564{
565  my $path = shift(@_);
566  my $driver = &_determineDriver($path);
567  return &_callFunction($driver, 'fileSize', $path);
568}
569# /** fileSize() **/
570
571## @function hardLink()
572#
573sub hardLink
574{
575  my $src_file = shift(@_);
576  my $dst_file = shift(@_);
577  my $src_driver = &FileUtils::_determineDriver($src_file);
578  my $dst_driver = &FileUtils::_determineDriver($dst_file);
579  # you can only symbolic link within the same file system - always
580  if ($src_driver eq 'LocalFS' && $src_driver eq $dst_driver && !$linking_disabled)
581  {
582    &FileUtils::_callFunction($src_driver, 'linkFile', 'HARD', $src_file, $dst_file);
583  }
584  # substitute a copy
585  else
586  {
587      if (!$done_link_warning)
588      {
589      if ($src_driver ne 'LocalFS' || $dst_driver ne 'LocalFS')
590      {
591          &printWarning('Cannot symbolic hardlink between non-local file systems - copying all files instead');
592      }
593      else
594      {
595          &printWarning('Symbolic hardlinking disabled  - copying all files instead');
596      }
597      $done_link_warning = 1;
598      }
599      &transferFiles($src_file, $dst_file, 'COPY');
600  }
601}
602## hardLink()
603
604
605## @function isFilenameAbolsute()
606#
607# Determine if the given path is an absolute path (as compared to relative)
608#
609sub isFilenameAbsolute
610{
611  my $path = shift(@_);
612  my $driver = &FileUtils::_determineDriver($path);
613  return &FileUtils::_callFunction($driver, 'isFilenameAbsolute', $path, '-l');
614}
615## isFilenameAbsolute()
616
617
618## @function isHDFS()
619#
620sub isHDFS
621{
622  my $path = shift(@_);
623  my $driver = &FileUtils::_determineDriver($path);
624  my $result = &FileUtils::_callFunction($driver, 'isHDFS');
625  ###rint STDERR "[DEBUG] FileUtils::isHDFS(" . $path . ") => " . $result . "\n";
626  return $result;
627}
628## isHDFS()
629
630
631## @function isSpecialDirectory()
632#
633sub isSpecialDirectory
634{
635    my $path = shift(@_);
636    my $driver = &FileUtils::_determineDriver($path);
637    my $result = 0; # not special
638    if (&FileUtils::_hasFunction($driver, 'isSpecialDirectory'))
639    {
640    $result = &FileUtils::_callFunction($driver, 'isSpecialDirectory', $path);
641    }
642    return $result;
643}
644## isSpecialDirectory()
645
646
647## @function isSymbolicLink()
648#
649# Determine if the given path is a symbolic link
650#
651sub isSymbolicLink
652{
653  my $path = shift(@_);
654  my $driver = &FileUtils::_determineDriver($path);
655  return &FileUtils::_callFunction($driver, 'fileTest', $path, '-l');
656}
657## isSymbolicLink()
658
659
660# /**
661#  */
662sub makeDirectory
663{
664  my $path = shift(@_);
665  my $driver = &FileUtils::_determineDriver($path);
666  # check if the directory already exists - in which case our job is done :)
667  my $result = &FileUtils::_callFunction($driver, 'fileTest', $path, '-d');
668  # not yet - better try and create it then
669  if (!$result)
670  {
671    $result = &FileUtils::_callFunction($driver, 'makeDirectory', $path);
672  }
673  return $result;
674}
675# /** makeDirectory(path) **/
676
677# /**
678#  */
679sub modificationTime
680{
681  my $path = shift(@_);
682  my $driver = &_determineDriver($path);
683  return &_callFunction($driver, 'modificationTime', $path);
684}
685# /** modificationTime() **/
686
687# /**
688#  */
689sub moveFiles
690{
691  return &transferFiles(@_, 'MOVE');
692}
693# /** moveFiles() **/
694
695# /**
696#  */
697sub openFileHandle
698{
699  my $path = shift(@_);
700  # I'll set mode to read by default, as that is less destructive to precious
701  # files on your system...
702  my $mode = shift(@_) || '<';
703  # the all important determining of the driver by protocol
704  my $driver = &FileUtils::_determineDriver($path);
705  # the function call will return true on success, with the reference to the
706  # file handle hopefully populated with a lovely file descriptor
707  return &FileUtils::_callFunction($driver, 'openFileHandle', $path, $mode, @_);
708}
709# /** openFileHandle($file_handle_ref, $path, $mode) **/
710
711## @function pathExists()
712#
713# Determine if a certain path exists on the file system - regardless of whether
714# it is a file or a directory (the equivalent of -e)
715#
716sub pathExists
717{
718  my $path = shift(@_);
719  my $driver = &FileUtils::_determineDriver($path);
720  return &FileUtils::_callFunction($driver, 'fileTest', $path, '-e');
721}
722## pathExists()
723
724
725## @function readDirectory()
726#
727# Provide a function to return the files within a directory that is aware
728# of protocols other than file://
729# @param $dirname  the full path to the directory
730#
731sub readDirectory
732{
733  my $path = shift(@_);
734  my $driver = &FileUtils::_determineDriver($path);
735  return &FileUtils::_callFunction($driver, 'readDirectory', $path);
736}
737## readDirectory()
738
739
740## @function removeFiles()
741#
742# Removes files (but not directories)
743# @param files - An array of filepaths to remove
744#
745sub removeFiles
746{
747  my (@files) = @_;
748  my $num_removed = 0;
749  # Remove the files
750  foreach my $path (@files)
751  {
752    my $driver = &FileUtils::_determineDriver($path);
753    if (&FileUtils::_callFunction($driver, 'removeFiles', $path))
754    {
755      $num_removed++;
756    }
757  }
758  # Check to make sure all of them were removed
759  if ($num_removed != scalar(@files))
760  {
761    &printError('Not all files were removed');
762    $num_removed = 0;
763  }
764  return $num_removed;
765}
766## removeFile(files)
767
768
769## @function removeFilesFiltered()
770#
771sub removeFilesFiltered
772{
773  my $maybe_paths = shift(@_);
774  my @paths = (ref $maybe_paths eq "ARRAY") ? @$maybe_paths : ($maybe_paths);
775  my $num_removed = 0;
776  foreach my $path (@paths)
777  {
778    my $driver = &FileUtils::_determineDriver($path);
779    $num_removed += &FileUtils::_callFunction($driver, 'removeFilesFiltered', $path, @_);
780  }
781  return $num_removed;
782}
783## removeFilesFiltered()
784
785
786## @function removeFilesRecursive()
787#
788# The equivalent of "rm -rf" with all the dangers therein
789#
790sub removeFilesRecursive
791{
792  my $maybe_paths = shift(@_);
793  my @paths = (ref $maybe_paths eq "ARRAY") ? @$maybe_paths : ($maybe_paths);
794  my $num_removed = 0;
795  foreach my $path (@paths)
796  {
797    my $driver = &FileUtils::_determineDriver($path);
798    $num_removed += &FileUtils::_callFunction($driver, 'removeFilesRecursive', $path);
799  }
800  return $num_removed;
801}
802## removeFilesRecursive()
803
804
805## @function softLink()
806#
807sub softLink
808{
809  my $src_file = shift(@_);
810  my $dst_file = shift(@_);
811  my $src_driver = &FileUtils::_determineDriver($src_file);
812  my $dst_driver = &FileUtils::_determineDriver($dst_file);
813  # you can only symbolic link within the same file system - always
814  if ($src_driver eq 'LocalFS' && $src_driver eq $dst_driver && !$linking_disabled)
815  {
816    &FileUtils::_callFunction($src_driver, 'linkFile', 'SOFT', $src_file, $dst_file, @_);
817  }
818  # substitute a copy
819  elsif ($src_driver ne 'LocalFS')
820  {
821    if (!$done_link_warning)
822    {
823      &printWarning('Cannot symbolic link on non-local file systems - copying all files instead');
824      $done_link_warning = 1;
825    }
826    &transferFiles($src_file, $dst_file, 'COPY');
827  }
828  else
829  {
830    if (!$done_link_warning)
831    {
832      &printWarning('Cannot symbolic link between file systems - copying all files instead');
833      $done_link_warning = 1;
834    }
835    &transferFiles($src_file, $dst_file, 'COPY');
836  }
837}
838## softLink()
839
840
841## @function supportsSymbolicLink()
842#
843sub supportsSymbolicLink
844{
845  my $path = shift(@_);
846  my $driver = &FileUtils::_determineDriver($path);
847  &FileUtils::_callFunction($driver, 'supportsSymbolicLink');
848}
849## supportsSymbolicLink()
850
851
852## @function synchronizeDirectory()
853#
854sub synchronizeDirectory
855{
856  my $fromdir = shift(@_);
857  my $driver = &FileUtils::_determineDriver($fromdir);
858  &FileUtils::_callFunction($driver, 'synchronizeDirectory', $fromdir, @_);
859}
860## synchronizeDirectory()
861
862
863## @function transferFiles()
864# @param paths - one or more source paths
865# @param dst_path - the destination path
866# @param mode - copy or move
867#
868sub transferFiles
869{
870  my $transfer_mode = pop(@_);
871  my $dst_path = pop(@_);
872  my (@src_paths) = @_;
873  &_prettyPrint(0, @src_paths, $dst_path, $transfer_mode) unless (!$debug);
874  my $result = 0;
875  my $dst_driver = &_determineDriver($dst_path);
876  if (scalar (@src_paths) == 0)
877  {
878    &printError('No destination directory given');
879  }
880  elsif ((scalar (@src_paths) > 1) && (!&directoryExists($dst_path)))
881  {
882    &printError('If multiple source files are given the destination must be a directory');
883  }
884  else
885  {
886    foreach my $src_path (@src_paths)
887    {
888      my $src_driver = &_determineDriver($src_path);
889      if ($src_driver eq 'LocalFS')
890      {
891        # Local to local
892        if ($dst_driver eq 'LocalFS')
893        {
894          $result += &_callFunction($src_driver, 'transferFile', $transfer_mode, $src_path, $dst_path);
895        }
896        # Local to X
897        else
898        {
899          $result += &_callFunction($dst_driver, 'transferFileFromLocal', $transfer_mode, $src_path, $dst_path);
900        }
901      }
902      # X to Local
903      elsif ($dst_driver eq 'LocalFS')
904      {
905        $result += &_callFunction($src_driver, 'transferFileToLocal', $transfer_mode, $src_path, $dst_path);
906      }
907      # X to X
908      elsif ($src_driver eq $dst_driver)
909      {
910        $result += &_callFunction($src_driver, 'transferFile', $transfer_mode, $src_path, $dst_path);
911      }
912      # X to Y... not supported
913      else
914      {
915        &printError('transfer between two non-local file systems not supported');
916      }
917    }
918    $result = (scalar(@src_paths) == $result);
919  }
920  return $result;
921}
922## transferFiles()
923
9241;
Note: See TracBrowser for help on using the browser.