summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorKarl Berry <karl@freefriends.org>2009-06-29 17:13:07 +0000
committerKarl Berry <karl@freefriends.org>2009-06-29 17:13:07 +0000
commitbcdef55875102900ae7616a89d60847ddd6f0d38 (patch)
treefd0c675675ab7f65c73e9f405f2039170898924e
parent018499b87155c7d0617941e0f7c5c494149ebc29 (diff)
(copy): just return without copying if the input
does not exist (Hartmut mail to tex-live, 28 Jun 2009 23:47:04). Update documentation. Reformat function for style. git-svn-id: svn://tug.org/texlive/trunk@14006 c570f23f-e606-0410-a88d-b1316a301751
-rw-r--r--Master/tlpkg/TeXLive/TLUtils.pm81
1 files changed, 45 insertions, 36 deletions
diff --git a/Master/tlpkg/TeXLive/TLUtils.pm b/Master/tlpkg/TeXLive/TLUtils.pm
index cb3209a1be6..cee4fe62ec0 100644
--- a/Master/tlpkg/TeXLive/TLUtils.pm
+++ b/Master/tlpkg/TeXLive/TLUtils.pm
@@ -739,79 +739,88 @@ sub rmtree {
=item C<copy("-f", $file, $destfile)>
-Copy file C<$file> to directory C<$target_dir>, or to the C<$destfile> in
-the second case. No external programs
-are involved. Since we need C<sysopen()>, the Perl module C<Fcntl.pm>
-is required. The time stamps are preserved and symlinks are created
-on UNIX systems. On Windows, C<(-l $file)> will certainly never
-return 'C<true>' and symlinks will be copied as regular files.
+Copy file C<$file> to directory C<$target_dir>, or to the C<$destfile>
+in the second case. No external programs are involved. Since we need
+C<sysopen()>, the Perl module C<Fcntl.pm> is required. The time stamps
+are preserved and symlinks are created on Unix systems. On Windows,
+C<(-l $file)> will never return 'C<true>' and so symlinks will be
+(uselessly) copied as regular files.
-C<copy> invokes C<mkdirhier> if target directories do not exist.
-Files have mode C<0777>-I<umask> if they are executable and
-C<0666>-I<umask> otherwise.
+C<copy> invokes C<mkdirhier> if target directories do not exist. Files
+have mode C<0777>-I<umask> if they are executable and C<0666>-I<umask>
+otherwise.
-Note that C<copy> will work with file:/ prefixes, too.
+C<$file> can begin with a file:/ prefix.
+
+If C<$file> is not readable, we return without copying anything. (This
+can happen when the database and files are not in perfect sync.) On the
+other file, if the destination is not writable, or the writing fails,
+that is a fatal error.
=cut
-sub copy {
- my $infile=shift;
+sub copy
+{
+ my $infile = shift;
my $filemode = 0;
- if ($infile eq "-f") {
- # second argument is a file!!!
+ if ($infile eq "-f") { # second argument is a file
$filemode = 1;
$infile = shift;
}
my $destdir=shift;
+
my $outfile;
my @stat;
my $mode;
my $buffer;
my $offset;
my $filename;
- my $dirmode=0755;
- my $blocksize=2048;
+ my $dirmode = 0755;
+ my $blocksize = $TeXLive::TLConfig::BlockSize;
- $infile =~ s!^file://*!/!i;
- $filename=basename "$infile";
+ $infile =~ s!^file://*!/!i; # remove file:/ url prefix
+ $filename = basename "$infile";
if ($filemode) {
- # we actually got a destination file
+ # given a destination file
$outfile = $destdir;
$destdir = dirname($outfile);
} else {
- $outfile="$destdir/$filename";
+ $outfile = "$destdir/$filename";
}
- mkdirhier ("$destdir") unless -d "$destdir";
+ mkdirhier ($destdir) unless -d "$destdir";
if (-l "$infile") {
- symlink readlink "$infile", "$destdir/$filename";
+ symlink (readlink $infile, "$destdir/$filename");
} else {
- open (IN, $infile) || die "open($infile) failed: $!";
+ if (! open (IN, $infile)) {
+ warn "open($infile) failed, not copying: $!";
+ return;
+ }
binmode IN;
- $mode=(-x "$infile")? oct("0777"):oct("0666");
- $mode-=umask;
+ $mode = (-x "$infile") ? oct("0777") : oct("0666");
+ $mode -= umask;
open (OUT, ">$outfile") || die "open(>$outfile) failed: $!";
binmode OUT;
chmod $mode, "$outfile";
- while ($read=sysread IN, $buffer, $blocksize) {
- die "system read error: $!\n" unless defined $read;
- $offset=0;
+ while ($read = sysread (IN, $buffer, $blocksize)) {
+ die "read($infile) failed: $!\n" unless defined $read;
+ $offset = 0;
while ($read) {
- $written=syswrite OUT, $buffer, $read, $offset;
- die "system write error: $!\n" unless defined $written;
- $read-=$written;
- $offset+=$written;
+ $written = syswrite (OUT, $buffer, $read, $offset);
+ die "write($outfile) failed: $!" unless defined $written;
+ $read -= $written;
+ $offset += $written;
}
}
- close OUT;
- close IN;
- @stat=lstat "$infile";
- utime $stat[8], $stat[9], "$outfile";
+ close (OUT) || warn "close($outfile) failed: $!";
+ close IN || warn "close($infile) failed: $!";;
+ @stat = lstat ("$infile");
+ utime ($stat[8], $stat[9], $outfile);
}
}