(install_packages): if we can't open the tlpobj

for writing, sleep and try again for a while on
Windows.  From TANAKA Takuji, 19 Apr 2014 23:02:29.


git-svn-id: svn://tug.org/texlive/trunk@33564 c570f23f-e606-0410-a88d-b1316a301751

1 files changed, 13 insertions, 4 deletions

diff --git a/Master/tlpkg/TeXLive/TLUtils.pm b/Master/tlpkg/TeXLive/TLUtils.pm
index 0df6b7c9258..df3a31564d3 100644
--- a/Master/tlpkg/TeXLive/TLUtils.pm
+++ b/Master/tlpkg/TeXLive/TLUtils.pm
@@ -201,6 +201,7 @@ use Cwd;
 use Digest::MD5;
 use Getopt::Long;
 use File::Temp;
+use Time::HiRes;
 
 use TeXLive::TLConfig;
 
@@ -1398,12 +1399,20 @@ sub install_packages {
       $tlpobj->replace_reloc_prefix;
     }
     $totlpdb->add_tlpobj($tlpobj);
+
     # we have to write out the tlpobj file since it is contained in the
-    # archives (.tar.xz) but at uncompressed-media install time we don't have them
+    # archives (.tar.xz), but at uncompressed-media install time we
+    # don't have them.
     my $tlpod = $totlpdb->root . "/tlpkg/tlpobj";
-    mkdirhier( $tlpod );
-    open(TMP,">$tlpod/".$tlpobj->name.".tlpobj") ||
-      die "$0: open tlpobj " . $tlpobj->name . "failed: $!";
+    mkdirhier($tlpod);
+    my $count = 0;
+    my $tlpobj_file = ">$tlpod/" . $tlpobj->name . ".tlpobj";
+    until (open(TMP, $tlpobj_file)) {
+      # The open might fail for no good reason on Windows.
+      # Try again for a while, but not forever.
+      if ($count++ == 100) { die "$0: open($tlpobj_file) failed: $!"; }
+      Time::HiRes::sleep(0.01);  # sleep briefly
+    }
     $tlpobj->writeout(\*TMP);
     close(TMP);
     $donesize += $tlpsizes{$package};