Conservancy/gpl-compliance-tools
6
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Improve move/copy/make_path error handling; switch move() ⇒ rename()

Browse source 
It turns out that File::Copy->move() does *not* follow POSIX mv's
semantics when doing `mv DIRECTORY_1 DIRECTORY_2`.  It's quite clear
that it will do somethine like `mv DIRECTORY_1/* DIRECTORY_2`.

As such, while I'd prefer not to use the system-dependent rename()
Perl function here, that has the semantics I want.

In the process, error handling for the clals to move(), copy() and
make_path are improved.  I thought autodie was catching these, but
it's not.
This commit is contained in:
Bradley M. Kuhn 2023-06-03 08:32:34 -07:00
parent 9da387af88
commit 3f0716c9f0
1 changed files with 19 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

25
build-label-upi-number.plx
View file

@ -101,12 +101,15 @@ sub ProcessDocumentDirectory($$$) {
ProcessDocumentDirectory($rfp, $fullFilePath, catfile($numberedOutputDir, $file)); ProcessDocumentDirectory($rfp, $fullFilePath, catfile($numberedOutputDir, $file));
} elsif (-f $fullFilePath) { } elsif (-f $fullFilePath) {
my $upiFull = NextUPI(); my $upiFull = NextUPI();
make_path($numberedOutputDir, { mode => 0755 }); unless (-d $numberedOutputDir) {
make_path($numberedOutputDir, { mode => 0755 }) or die "unable to make directory $numberedOutputDir: $!";
}
my($volume, $directories, $bareFileName) = File::Spec->splitpath($fullFilePath); my($volume, $directories, $bareFileName) = File::Spec->splitpath($fullFilePath);
die("Something wrong, since file name is empty on $fullFilePath") unless defined $bareFileName and $bareFileName !~ /^\s*$/; die("Something wrong, since file name is empty on $fullFilePath") unless defined $bareFileName and $bareFileName !~ /^\s*$/;
my $fileName = $upiFull . '-' . $GROUP_NAMES_BY_DIR{$GROUP} . '-' . $bareFileName; my $fileName = $upiFull . '-' . $GROUP_NAMES_BY_DIR{$GROUP} . '-' . $bareFileName;
my $copiedFile = catfile($numberedOutputDir, $fileName); my $copiedFile = catfile($numberedOutputDir, $fileName);
copy($fullFilePath, catfile($numberedOutputDir, $fileName)); copy($fullFilePath, catfile($numberedOutputDir, $fileName))
or die "unable to copy($fullFilePath, catfile($numberedOutputDir, $fileName))";
} else { } else {
die("\"$fullFilePath\" is a strange file type, not handled!"); die("\"$fullFilePath\" is a strange file type, not handled!");
} }
@ -170,7 +173,7 @@ sub ProcessMailDir($$$) {
push(@CSV_OUTPUT_ROWS, [ $upiFull, $fileName, uc($rfp), $GROUP_NAMES_BY_DIR{$GROUP} ]); push(@CSV_OUTPUT_ROWS, [ $upiFull, $fileName, uc($rfp), $GROUP_NAMES_BY_DIR{$GROUP} ]);
} }
my $copiedFile = catfile($outputDir, $fileName); my $copiedFile = catfile($outputDir, $fileName);
copy($msgFile, $copiedFile); copy($msgFile, $copiedFile) or die "unable to copy($msgFile, $copiedFile)";
system('/usr/bin/unix2dos', '-q', $copiedFile); system('/usr/bin/unix2dos', '-q', $copiedFile);
die "unable to copy $msgFile to $copiedFile" unless -f $copiedFile; die "unable to copy $msgFile to $copiedFile" unless -f $copiedFile;
} }
@ -199,14 +202,24 @@ while (my $rfp = readdir $topDH) {
} }
my $nativeOutputDirOneUp = File::Spec->rel2abs(catfile($OUTPUT_TOPLEVEL_DIR, $native, $rfp, $bucketName)); my $nativeOutputDirOneUp = File::Spec->rel2abs(catfile($OUTPUT_TOPLEVEL_DIR, $native, $rfp, $bucketName));
my $numberedOutputDir = File::Spec->rel2abs(catfile($OUTPUT_TOPLEVEL_DIR, $numbered, $rfp, $bucketName, $typeName)); my $numberedOutputDir = File::Spec->rel2abs(catfile($OUTPUT_TOPLEVEL_DIR, $numbered, $rfp, $bucketName, $typeName));
make_path($nativeOutputDirOneUp, { mode => 0755 }); unless (-d $nativeOutputDirOneUp) {
make_path($numberedOutputDir, { mode => 0755 }); make_path($nativeOutputDirOneUp, { mode => 0755 }) or die "unable to create path $nativeOutputDirOneUp: $!";
}
unless (-d $numberedOutputDir) {
make_path($numberedOutputDir, { mode => 0755 }) or die "unable to create path $numberedOutputDir: $!";
}
my $destDir = catfile($nativeOutputDirOneUp, $typeName);
if ($typeName =~ /email/i) { if ($typeName =~ /email/i) {
ProcessMailDir($rfp, $typeDirName, $numberedOutputDir); ProcessMailDir($rfp, $typeDirName, $numberedOutputDir);
} else { } else {
ProcessDocumentDirectory($rfp, $typeDirName, $numberedOutputDir); ProcessDocumentDirectory($rfp, $typeDirName, $numberedOutputDir);
} }
move($typeDirName, $nativeOutputDirOneUp); die "cannot move to the directory we want this in" unless -d $nativeOutputDirOneUp;
rename($typeDirName, $destDir) or die "unable to move $typeDirName to $destDir: $!";
# move($typeDirName, $nativeOutputDirOneUp) or die "unable to move($typeDirName, $nativeOutputDirOneUp)";
# Note: the above doesn't atually rename the directory from one place
# to another; it moves the file contents into the destination directory. IOW, File::Copy->move() doesn't have POSIX mv
} }
closedir $bucketDH; closedir $bucketDH;
} }