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

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

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