diff options
author | Karl Berry <karl@freefriends.org> | 2009-06-29 17:13:07 +0000 |
---|---|---|
committer | Karl Berry <karl@freefriends.org> | 2009-06-29 17:13:07 +0000 |
commit | bcdef55875102900ae7616a89d60847ddd6f0d38 (patch) | |
tree | fd0c675675ab7f65c73e9f405f2039170898924e | |
parent | 018499b87155c7d0617941e0f7c5c494149ebc29 (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.pm | 81 |
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); } } |