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

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

Adding makeAllDirectories() (which I'd only implemented in LocalFS) to FileUtils (which in turn calls the Driver specific makeDirectory() recursively) and added test for this function
File size: 22.7 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 &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 (!-e $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.