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

Revision 30287, 23.3 KB (checked in by jmt12, 5 years ago)

Extending error messages a bit to differentiate between linking that failed and linking that has been disabled (for testing purposes)

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