source: gs2-extensions/parallel-building/trunk/src/perllib/FileUtils/LocalFS.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: 13.3 KB
Line 
1###############################################################################
2#
3# LocalFS.pm -- file functions acting upon the local filesystem
4#
5# A component of the Greenstone digital library software from the New Zealand
6# Digital Library Project at the University of Waikato, New Zealand.
7#
8# Copyright (C) 2013 New Zealand Digital Library Project
9#
10# This program is free software; you can redistribute it and/or modify it under
11# the terms of the GNU General Public License as published by the Free Software
12# Foundation; either version 2 of the License, or (at your option) any later
13# version.
14#
15# This program is distributed in the hope that it will be useful, but WITHOUT
16# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
17# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
18# details.
19#
20# You should have received a copy of the GNU General Public License along with
21# this program; if not, write to the Free Software Foundation, Inc., 675 Mass
22# Ave, Cambridge, MA 02139, USA.
23#
24###############################################################################
25
26package FileUtils::LocalFS;
27
28# Pragma
29use strict;
30
31
32## @function canRead()
33#
34sub canRead
35{
36 my $path = shift(@_);
37 return &fileTest($path, '-R');
38}
39## canRead()
40
41
42## @function closeFileHandle
43#
44sub closeFileHandle
45{
46 my $fh_ref = shift(@_);
47 close($$fh_ref);
48 return 1;
49}
50## closeFileHandle()
51
52
53## @function filenameConcatenate()
54#
55sub filenameConcatenate
56{
57 my $first_file = shift(@_);
58 my (@filenames) = @_;
59
60 # Useful for debugging
61 # -- might make sense to call caller(0) rather than (1)??
62 # my ($cpackage,$cfilename,$cline,$csubr,$chas_args,$cwantarray) = caller(1);
63 # print STDERR "Calling method: $cfilename:$cline $cpackage->$csubr\n";
64
65 # If first_file is not null or empty, then add it back into the list
66 if (defined $first_file && $first_file =~ /\S/) {
67 unshift(@filenames, $first_file);
68 }
69
70 my $filename = join("/", @filenames);
71
72 # remove duplicate slashes and remove the last slash
73 if ($ENV{'GSDLOS'} =~ /^windows$/i) {
74 $filename =~ s/[\\\/]+/\\/g;
75 } else {
76 $filename =~ s/[\/]+/\//g;
77 # DB: want a filename abc\de.html to remain like this
78 }
79 $filename =~ s/[\\\/]$//;
80
81 return $filename;
82}
83## filenameConcatenate()
84
85
86## @function fileSize()
87#
88sub fileSize
89{
90 my ($filename_full_path) = @_;
91 return -s $filename_full_path;
92}
93## fileStatus()
94
95
96## @function fileTest()
97#
98sub fileTest
99{
100 my $filename_full_path = shift(@_);
101 # By default tests for existance of file or directory (-e)
102 # Can be made more specific by providing second parameter (e.g. -f or -d)
103 my $test_op = shift(@_) || '-e';
104
105 my $exists = 0;
106
107 if ($ENV{'GSDLOS'} =~ m/^windows$/i) {
108 require Win32;
109 my $filename_short_path = Win32::GetShortPathName($filename_full_path);
110 if (!defined $filename_short_path) {
111 # Was probably still in UTF8 form (not what is needed on Windows)
112 my $unicode_filename_full_path = eval "decode(\"utf8\",\$filename_full_path)";
113 if (defined $unicode_filename_full_path) {
114 $filename_short_path = Win32::GetShortPathName($unicode_filename_full_path);
115 }
116 }
117 $filename_full_path = $filename_short_path;
118 }
119
120 if (defined $filename_full_path) {
121 $exists = eval "($test_op \$filename_full_path)";
122 }
123
124 # The eval may result in exists being undefined, but we need to return
125 # something
126 return ($exists || 0);
127}
128## fileTest()
129
130
131## @function isFilenameAbsolute()
132#
133sub isFilenameAbsolute
134{
135 my ($filename) = @_;
136 if ($ENV{'GSDLOS'} =~ /^windows$/i)
137 {
138 return ($filename =~ m/^(\w:)?\\/);
139 }
140 return ($filename =~ m/^\//);
141}
142# isFilenameAbsolute()
143
144
145## @function linkFile()
146#
147sub linkFile
148{
149 my ($mode, $src, $dest, $ensure_paths_absolute) = @_;
150
151 # remove trailing slashes from source and destination files
152 $src =~ s/[\\\/]+$//;
153 $dest =~ s/[\\\/]+$//;
154
155 # Ensure file paths are absolute IF requested to do so
156 # Soft_linking didn't work for relative paths
157 if($mode eq 'HARD' || (defined $ensure_paths_absolute && $ensure_paths_absolute))
158 {
159 # We need to ensure that the src file is the absolute path
160 # See http://perldoc.perl.org/File/Spec.html
161 if(!File::Spec->file_name_is_absolute( $src ))
162 {
163 # it's relative
164 $src = File::Spec->rel2abs($src); # make absolute
165 }
166 # Might as well ensure that the destination file's absolute path is used
167 if(!File::Spec->file_name_is_absolute( $dest ))
168 {
169 $dest = File::Spec->rel2abs($dest); # make absolute
170 }
171 }
172
173 # a few sanity checks
174 if (!-e $src)
175 {
176 &FileUtils::printError('Source file does not exist: ' . $src);
177 return 0;
178 }
179
180 my $dest_dir = &File::Basename::dirname($dest);
181 if (!-e $dest_dir)
182 {
183 &makeAllDirectories($dest_dir);
184 }
185
186 if ($ENV{'GSDLOS'} =~ /^windows$/i)
187 {
188 # symlink not supported on windows
189 &FileUtils::printWarning('Symlink not supported on windows');
190 }
191 elsif ($mode eq 'HARD')
192 {
193 if (!eval {link($src, $dest)})
194 {
195 &FileUtils::printWarning('Unable to create hard link: ' . $dest);
196 }
197 }
198 elsif ($mode eq 'SOFT')
199 {
200 if (!eval {symlink($src, $dest)})
201 {
202 &FileUtils::printWarning('Unable to create soft link: ' . $src);
203 }
204 }
205 else
206 {
207 &FileUtils::printError('Unknown mode requested: ' . $mode);
208 }
209 if (!-e $dest)
210 {
211 &_printWarning('linkFile', 'Link failed. Attempting to copy instead.');
212 &File::Copy::copy ($src, $dest);
213 }
214 return (-e $dest);
215}
216# /** linkFile() **/
217
218## @function makeDirectory()
219#
220sub makeDirectory
221{
222 my $dir = shift(@_);
223 my $store_umask = umask(0002);
224 my $mkdir_ok = mkdir ($dir, 0777);
225 umask($store_umask);
226 return $mkdir_ok;
227}
228## makeDirectory()
229
230
231## @function modificationTime()
232#
233sub modificationTime
234{
235 my $path = shift(@_);
236 my @file_status = stat($path);
237 return $file_status[9];
238}
239## modificationTime()
240
241## @function openFileHandle()
242#
243sub openFileHandle
244{
245 my $path = shift(@_);
246 my $mode = shift(@_);
247 my $fh_ref = shift(@_);
248 my $encoding = shift(@_);
249 my $mode_symbol;
250 if ($mode eq 'w' || $mode eq '>')
251 {
252 $mode_symbol = '>';
253 $mode = 'writing';
254 }
255 elsif ($mode eq 'a' || $mode eq '>>')
256 {
257 $mode_symbol = '>>';
258 $mode = 'appending';
259 }
260 else
261 {
262 $mode_symbol = '<';
263 $mode = 'reading';
264 }
265 if (defined $encoding)
266 {
267 $mode_symbol .= ':' . $encoding;
268 }
269 if (!open($$fh_ref, $mode_symbol, $path))
270 {
271 &FileUtils::printError('Failed to open file for ' . $mode . ': ' . $path, 1);
272 }
273 return 1;
274}
275## openFileHandle()
276
277# /**
278# */
279sub readDirectory
280{
281 my $path = shift(@_);
282 opendir(DH, $path) or &FileUtils::printError('Failed to open directory for reading: ' . $path, 1);
283 my @files = readdir(DH);
284 close(DH);
285 return \@files;
286}
287# /** readDirectory() **/
288
289
290## @function removeFiles()
291#
292sub removeFiles
293{
294 my $file = shift(@_);
295 my $result = 0;
296 if (!-e $file && !-l $file)
297 {
298 &FileUtils::printError('File does not exist: ' . $file);
299 }
300 elsif ((!-f $file) && (!-l $file))
301 {
302 &FileUtils::printError('Not a regular file: ' . $file);
303 }
304 else
305 {
306 $result = unlink($file);
307 if (!$result)
308 {
309 &FileUtils::printError('Failed to remove file: ' . $file);
310 }
311 }
312 return $result;
313}
314## removeFiles()
315
316
317## @function removeFilesFiltered()
318#
319# recursive removal
320#
321sub removeFilesFiltered
322{
323 my ($files, $file_accept_re, $file_reject_re) = @_;
324 # my ($cpackage,$cfilename,$cline,$csubr,$chas_args,$cwantarray) = caller(2);
325 # my ($lcfilename) = ($cfilename =~ m/([^\\\/]*)$/);
326 # print STDERR "** Calling method (2): $lcfilename:$cline $cpackage->$csubr\n";
327 my @files_array = (ref $files eq "ARRAY") ? @$files : ($files);
328
329 my $num_removed = 0;
330
331 foreach my $file (@files_array)
332 {
333 # remove trailing slashes
334 $file =~ s/[\/\\]+$//;
335
336 if (!-e $file)
337 {
338 print STDERR "util::filtered_rm_r $file does not exist\n";
339 }
340 # don't recurse down symbolic link
341 elsif ((-d $file) && (!-l $file))
342 {
343 # get the contents of this directory
344 if (!opendir (INDIR, $file))
345 {
346 print STDERR "util::filtered_rm_r could not open directory $file\n";
347 }
348 else
349 {
350 my @filedir = grep (!/^\.\.?$/, readdir (INDIR));
351 closedir (INDIR);
352
353 # remove all the files in this directory
354 map {$_="$file/$_";} @filedir;
355 $num_removed += &FileUtils::LocalFS::removeFilesFiltered(\@filedir, $file_accept_re, $file_reject_re);
356
357 if (!defined $file_accept_re && !defined $file_reject_re)
358 {
359 # remove this directory
360 if (!rmdir $file)
361 {
362 print STDERR "util::filtered_rm_r couldn't remove directory $file\n";
363 }
364 else
365 {
366 $num_removed++;
367 }
368 }
369 }
370 }
371 else
372 {
373 next if (defined $file_reject_re && ($file =~ m/$file_reject_re/));
374
375 if ((!defined $file_accept_re) || ($file =~ m/$file_accept_re/))
376 {
377 # remove this file
378 $num_removed += &removeFiles($file);
379 }
380 }
381 }
382 return $num_removed;
383}
384## removeFilesFiltered()
385
386
387## @function removeFilesRecursive()
388#
389sub removeFilesRecursive
390{
391 my $path = shift(@_);
392 # use the more general (but reterospectively written filteredRemove()
393 # function with no accept or reject expressions
394 return FileUtils::LocalFS::removeFilesFiltered($path, undef, undef);
395}
396## removeFilesRecursive()
397
398
399## @function supportsSymbolicLink
400#
401sub supportsSymbolicLink
402{
403 return 1;
404}
405## supportsSymbolicLink()
406
407
408## @function synchronizeDirectory()
409#
410# updates a copy of a directory in some other part of the filesystem
411# verbosity settings are: 0=low, 1=normal, 2=high
412# both $fromdir and $todir should be absolute paths
413#
414sub synchronizeDirectory
415{
416 my ($fromdir, $todir, $verbosity) = @_;
417 $verbosity = 1 unless defined $verbosity;
418
419 # use / for the directory separator, remove duplicate and
420 # trailing slashes
421 $fromdir=~s/[\\\/]+/\//g;
422 $fromdir=~s/[\\\/]+$//;
423 $todir=~s/[\\\/]+/\//g;
424 $todir=~s/[\\\/]+$//;
425
426 &mk_all_dir ($todir);
427
428 # get the directories in ascending order
429 if (!opendir (FROMDIR, $fromdir))
430 {
431 print STDERR "util::cachedir could not read directory $fromdir\n";
432 return;
433 }
434 my @fromdir = grep (!/^\.\.?$/, sort(readdir (FROMDIR)));
435 closedir (FROMDIR);
436
437 if (!opendir (TODIR, $todir))
438 {
439 print STDERR "util::cacedir could not read directory $todir\n";
440 return;
441 }
442 my @todir = grep (!/^\.\.?$/, sort(readdir (TODIR)));
443 closedir (TODIR);
444
445 my $fromi = 0;
446 my $toi = 0;
447
448 while ($fromi < scalar(@fromdir) || $toi < scalar(@todir))
449 {
450 # print "fromi: $fromi toi: $toi\n";
451
452 # see if we should delete a file/directory
453 # this should happen if the file/directory
454 # is not in the from list or if its a different
455 # size, or has an older timestamp
456 if ($toi < scalar(@todir))
457 {
458 if (($fromi >= scalar(@fromdir)) ||
459 ($todir[$toi] lt $fromdir[$fromi] ||
460 ($todir[$toi] eq $fromdir[$fromi] &&
461 &differentfiles("$fromdir/$fromdir[$fromi]","$todir/$todir[$toi]",
462 $verbosity))))
463 {
464 # the files are different
465 &rm_r("$todir/$todir[$toi]");
466 splice(@todir, $toi, 1); # $toi stays the same
467 }
468 elsif ($todir[$toi] eq $fromdir[$fromi])
469 {
470 # the files are the same
471 # if it is a directory, check its contents
472 if (-d "$todir/$todir[$toi]")
473 {
474 &synchronizeDirectory("$fromdir/$fromdir[$fromi]", "$todir/$todir[$toi]", $verbosity);
475 }
476
477 $toi++;
478 $fromi++;
479 next;
480 }
481 }
482
483 # see if we should insert a file/directory
484 # we should insert a file/directory if there
485 # is no tofiles left or if the tofile does not exist
486 if ($fromi < scalar(@fromdir) && ($toi >= scalar(@todir) ||
487 $todir[$toi] gt $fromdir[$fromi]))
488 {
489 &cp_r ("$fromdir/$fromdir[$fromi]", "$todir/$fromdir[$fromi]");
490 splice (@todir, $toi, 0, $fromdir[$fromi]);
491 $toi++;
492 $fromi++;
493 }
494 }
495}
496## synchronizeDirectory()
497
498
499# /**
500# */
501sub transferFile
502{
503 my ($mode, $file, $dest) = @_;
504 # remove trailing slashes from source and destination files
505 $file =~ s/[\\\/]+$//;
506 $dest =~ s/[\\\/]+$//;
507 my $tempdest = $dest;
508 if (!-e $file)
509 {
510 &FileUtils::printError('File does not exist: ' . $file);
511 }
512 else
513 {
514 if (-d $tempdest)
515 {
516 my ($filename) = $file =~ /([^\\\/]+)$/;
517 $tempdest .= "/$filename";
518 }
519 # start by processing any move request
520 if ($mode eq 'MOVE')
521 {
522 &File::Copy::move($file, $tempdest);
523 }
524 # now if we were instead doing a copy, or if the move request above failed
525 # for some reason, we process a copy request
526 if ($mode eq 'COPY' || !-e $tempdest)
527 {
528 &File::Copy::copy($file, $tempdest);
529 }
530 # finally, we check if a successful move command has somehow left the origin
531 # file lying around (rename partially succeeded - for instance when moving
532 # hardlinks)
533 if ($mode eq 'MOVE' && -e $tempdest && -e $file)
534 {
535 unlink($file);
536 }
537 }
538 # Have we successfully moved the file?
539 my $result = 0;
540 if (-e $tempdest)
541 {
542 if ($mode eq 'MOVE')
543 {
544 if (-e $file)
545 {
546 &FileUtils::printError('Failed to remove original file during move: ' . $file);
547 }
548 else
549 {
550 $result = 1;
551 }
552 }
553 else
554 {
555 $result = 1;
556 }
557 }
558 else
559 {
560 &FileUtils::printError('Failed to move/copy file: ' . $file);
561 }
562 return $result;
563}
564# /** moveFile() **/
565
5661;
Note: See TracBrowser for help on using the repository browser.