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

Last change on this file since 29243 was 29243, checked in by jmt12, 10 years ago

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