fix return values of TLMedia->new, don't die, but return undef

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

2 files changed, 13 insertions, 2 deletions

diff --git a/Master/tlpkg/TeXLive/TLMedia.pm b/Master/tlpkg/TeXLive/TLMedia.pm
index dfa2c2669bd..6d974ec34c9 100644
--- a/Master/tlpkg/TeXLive/TLMedia.pm
+++ b/Master/tlpkg/TeXLive/TLMedia.pm
@@ -43,6 +43,7 @@ sub new
   }
   debug("Loading $location/$InfraLocation/$DatabaseName ...\n");
   my $tlpdb = TeXLive::TLPDB->new(root => "$location");
+  return(undef) unless defined($tlpdb);
   my (@all_c, @std_c, @lang_c, @lang_doc_c);
   my (@schemes);
   my %revs;
diff --git a/Master/tlpkg/TeXLive/TLPDB.pm b/Master/tlpkg/TeXLive/TLPDB.pm
index 2db071c352b..4f1aebaf247 100644
--- a/Master/tlpkg/TeXLive/TLPDB.pm
+++ b/Master/tlpkg/TeXLive/TLPDB.pm
@@ -78,6 +78,9 @@ is used to download the file.
 The C<$path> can start with C<file:/> in which case it is treated as
 a file on the filesystem in the usual way.
 
+Returns either an object of type C<TeXLive::TLPDB>, or undef if the root
+was given but no package could be read from that location.
+
 =cut
 
 sub new { 
@@ -90,7 +93,11 @@ sub new {
   $_listdir = $params{'listdir'} if defined($params{'listdir'});
   bless $self, $class;
   if (defined($self->{'root'})) {
-    $self->from_file("$self->{'root'}/$InfraLocation/$DatabaseName");
+    my $nr_packages_read = $self->from_file("$self->{'root'}/$InfraLocation/$DatabaseName");
+    if ($nr_packages_read == 0) {
+      # that is bad, we cannot read anything, so return undef
+      return(undef);
+    }
   }
   return $self;
 }
@@ -179,6 +186,8 @@ root was not given at generation time.  If C<$filename> begins
 with C<http://> or C<ftp://>, the program C<wget> is used to download
 the file. The prefix C<file:/> is treated the expected way.
 
+It returns the actual number of packages (TLPOBJs) read from C<$filename>.
+
 =cut
 
 sub from_file {
@@ -255,8 +264,9 @@ sub from_file {
     }
   } until (!$ret);
   if (!$found) {
-    die("Cannot read any package from $path, seems not to be a TLPDB!");
+    tlwarn("Cannot read any package from $path, seems not to be a TLPDB!");
   }
+  return($found);
 }
 
 =pod