source: gs2-extensions/parallel-building/trunk/src/perllib/FileUtils.pm@ 27491

Last change on this file since 27491 was 27491, checked in by jmt12, 11 years ago

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