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

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

Adding in a 'isHDFS()' function so that some plugins (SimpleVideoPlug) can know to move the files where other executables (HandbrakeCLI etc) can see them
File size: 22.9 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 isHDFS()
582#
583sub isHDFS
584{
585 my $path = shift(@_);
586 my $driver = &FileUtils::_determineDriver($path);
587 return &FileUtils::_callFunction($driver, 'isHDFS');
588}
589## isHDFS()
590
591## @function isSymbolicLink()
592#
593# Determine if the given path is a symbolic link
594#
595sub isSymbolicLink
596{
597 my $path = shift(@_);
598 my $driver = &FileUtils::_determineDriver($path);
599 return &FileUtils::_callFunction($driver, 'fileTest', $path, '-l');
600}
601## isSymbolicLink()
602
603
604# /**
605# */
606sub makeDirectory
607{
608 my $path = shift(@_);
609 my $driver = &FileUtils::_determineDriver($path);
610 # check if the directory already exists - in which case our job is done :)
611 my $result = &FileUtils::_callFunction($driver, 'fileTest', $path, '-d');
612 # not yet - better try and create it then
613 if (!$result)
614 {
615 $result = &FileUtils::_callFunction($driver, 'makeDirectory', $path);
616 }
617 return $result;
618}
619# /** makeDirectory(path) **/
620
621# /**
622# */
623sub modificationTime
624{
625 my $path = shift(@_);
626 my $driver = &_determineDriver($path);
627 return &_callFunction($driver, 'modificationTime', $path);
628}
629# /** modificationTime() **/
630
631# /**
632# */
633sub moveFiles
634{
635 return &transferFiles(@_, 'MOVE');
636}
637# /** moveFiles() **/
638
639# /**
640# */
641sub openFileHandle
642{
643 my $path = shift(@_);
644 # I'll set mode to read by default, as that is less destructive to precious
645 # files on your system...
646 my $mode = shift(@_) || '<';
647 # the all important determining of the driver by protocol
648 my $driver = &FileUtils::_determineDriver($path);
649 # the function call will return true on success, with the reference to the
650 # file handle hopefully populated with a lovely file descriptor
651 return &FileUtils::_callFunction($driver, 'openFileHandle', $path, $mode, @_);
652}
653# /** openFileHandle($file_handle_ref, $path, $mode) **/
654
655## @function pathExists()
656#
657# Determine if a certain path exists on the file system - regardless of whether
658# it is a file or a directory (the equivalent of -e)
659#
660sub pathExists
661{
662 my $path = shift(@_);
663 my $driver = &FileUtils::_determineDriver($path);
664 return &FileUtils::_callFunction($driver, 'fileTest', $path, '-e');
665}
666## pathExists()
667
668
669## @function readDirectory()
670#
671# Provide a function to return the files within a directory that is aware
672# of protocols other than file://
673# @param $dirname the full path to the directory
674#
675sub readDirectory
676{
677 my $path = shift(@_);
678 my $driver = &FileUtils::_determineDriver($path);
679 return &FileUtils::_callFunction($driver, 'readDirectory', $path);
680}
681## readDirectory()
682
683
684## @function removeFiles()
685#
686# Removes files (but not directories)
687# @param files - An array of filepaths to remove
688#
689sub removeFiles
690{
691 my (@files) = @_;
692 my $num_removed = 0;
693 # Remove the files
694 foreach my $path (@files)
695 {
696 my $driver = &FileUtils::_determineDriver($path);
697 if (&FileUtils::_callFunction($driver, 'removeFiles', $path))
698 {
699 $num_removed++;
700 }
701 }
702 # Check to make sure all of them were removed
703 if ($num_removed != scalar(@files))
704 {
705 &printError('Not all files were removed');
706 $num_removed = 0;
707 }
708 return $num_removed;
709}
710## removeFile(files)
711
712
713## @function removeFilesFiltered()
714#
715sub removeFilesFiltered
716{
717 my $maybe_paths = shift(@_);
718 my @paths = (ref $maybe_paths eq "ARRAY") ? @$maybe_paths : ($maybe_paths);
719 my $num_removed = 0;
720 foreach my $path (@paths)
721 {
722 my $driver = &FileUtils::_determineDriver($path);
723 $num_removed += &FileUtils::_callFunction($driver, 'removeFilesFiltered', $path, @_);
724 }
725 return $num_removed;
726}
727## removeFilesFiltered()
728
729
730## @function removeFilesRecursive()
731#
732# The equivalent of "rm -rf" with all the dangers therein
733#
734sub removeFilesRecursive
735{
736 my $maybe_paths = shift(@_);
737 my @paths = (ref $maybe_paths eq "ARRAY") ? @$maybe_paths : ($maybe_paths);
738 my $num_removed = 0;
739 foreach my $path (@paths)
740 {
741 my $driver = &FileUtils::_determineDriver($path);
742 $num_removed += &FileUtils::_callFunction($driver, 'removeFilesRecursive', $path);
743 }
744 return $num_removed;
745}
746## removeFilesRecursive()
747
748
749## @function softLink()
750#
751sub softLink
752{
753 my $src_file = shift(@_);
754 my $dst_file = shift(@_);
755 my $src_driver = &FileUtils::_determineDriver($src_file);
756 my $dst_driver = &FileUtils::_determineDriver($dst_file);
757 # you can only symbolic link within the same file system - always
758 if ($src_driver eq 'LocalFS' && $src_driver eq $dst_driver)
759 {
760 &FileUtils::_callFunction($src_driver, 'linkFile', 'SOFT', $src_file, $dst_file, @_);
761 }
762 # substitute a copy
763 elsif ($src_driver ne 'LocalFS')
764 {
765 &printWarning('Cannot symbolic link on non-local file systems - copying instead: ' . $src_file . ' => ' . $dst_file);
766 &transferFiles($src_file, $dst_file, 'COPY');
767 }
768 else
769 {
770 &printWarning('Cannot symbolic link between file systems - copying instead: ' . $src_file . ' => ' . $dst_file);
771 &transferFiles($src_file, $dst_file, 'COPY');
772 }
773}
774## softLink()
775
776
777## @function supportsSymbolicLink()
778#
779sub supportsSymbolicLink
780{
781 my $path = shift(@_);
782 my $driver = &FileUtils::_determineDriver($path);
783 &FileUtils::_callFunction($driver, 'supportsSymbolicLink');
784}
785## supportsSymbolicLink()
786
787
788## @function synchronizeDirectory()
789#
790sub synchronizeDirectory
791{
792 my $fromdir = shift(@_);
793 my $driver = &FileUtils::_determineDriver($fromdir);
794 &FileUtils::_callFunction($driver, 'synchronizeDirectory', $fromdir, @_);
795}
796## synchronizeDirectory()
797
798
799## @function transferFiles()
800# @param paths - one or more source paths
801# @param dst_path - the destination path
802# @param mode - copy or move
803#
804sub transferFiles
805{
806 my $transfer_mode = pop(@_);
807 my $dst_path = pop(@_);
808 my (@src_paths) = @_;
809 &_prettyPrint(0, @src_paths, $dst_path, $transfer_mode) unless (!$debug);
810 my $result = 0;
811 my $dst_driver = &_determineDriver($dst_path);
812 if (scalar (@src_paths) == 0)
813 {
814 &printError('No destination directory given');
815 }
816 elsif ((scalar (@src_paths) > 1) && (!&directoryExists($dst_path)))
817 {
818 &printError('If multiple source files are given the destination must be a directory');
819 }
820 else
821 {
822 foreach my $src_path (@src_paths)
823 {
824 my $src_driver = &_determineDriver($src_path);
825 if ($src_driver eq 'LocalFS')
826 {
827 # Local to local
828 if ($dst_driver eq 'LocalFS')
829 {
830 $result += &_callFunction($src_driver, 'transferFile', $transfer_mode, $src_path, $dst_path);
831 }
832 # Local to X
833 else
834 {
835 $result += &_callFunction($dst_driver, 'transferFileFromLocal', $transfer_mode, $src_path, $dst_path);
836 }
837 }
838 # X to Local
839 elsif ($dst_driver eq 'LocalFS')
840 {
841 $result += &_callFunction($src_driver, 'transferFileToLocal', $transfer_mode, $src_path, $dst_path);
842 }
843 # X to X
844 elsif ($src_driver eq $dst_driver)
845 {
846 $result += &_callFunction($src_driver, 'transferFile', $transfer_mode, $src_path, $dst_path);
847 }
848 # X to Y... not supported
849 else
850 {
851 &printError('transfer between two non-local file systems not supported');
852 }
853 }
854 $result = (scalar(@src_paths) == $result);
855 }
856 return $result;
857}
858## transferFiles()
859
8601;
Note: See TracBrowser for help on using the repository browser.