texlive[45275] Master/texmf-dist/scripts/texlive/tlmgr.pl: fixing

[commits+preining at tug.org]

Revision: 45275
          http://tug.org/svn/texlive?view=revision&revision=45275
Author:   preining
Date:     2017-09-12 02:47:29 +0200 (Tue, 12 Sep 2017)
Log Message:
-----------
fixing tlmgr info output for unknown packages

Modified Paths:
--------------
    trunk/Master/texmf-dist/scripts/texlive/tlmgr.pl

Modified: trunk/Master/texmf-dist/scripts/texlive/tlmgr.pl
===================================================================
--- trunk/Master/texmf-dist/scripts/texlive/tlmgr.pl	2017-09-12 00:21:33 UTC (rev 45274)
+++ trunk/Master/texmf-dist/scripts/texlive/tlmgr.pl	2017-09-12 00:47:29 UTC (rev 45275)
@@ -3702,9 +3702,9 @@
       print "installed:   No\n";
       return($F_OK);
     }
-    #if (!$remotetlpdb) {
-    #  init_tlmedia_or_die();
-    #}
+    if (!$remotetlpdb) {
+      init_tlmedia_or_die(1);
+    }
     if (defined($tag)) {
       if (!$remotetlpdb->is_virtual) {
         tlwarn("$prg: specifying implicit tags not allowed for non-virtual databases!\n");
@@ -3724,40 +3724,34 @@
         tlwarn("$prg: Cannot find package $pkg in repository $tag\n");
         return($F_WARNING);
       }
-      if ($remotetlpdb->is_virtual) {
+      my @cand = $remotetlpdb->candidates($pkg);
+      if (@cand) {
+        # if @cand is not empty, then we have a virtual database
         # we might have a package that is available in a
         # subsidiary repository, but not installable
         # because it is not pinned
         # we will list it but warn about this fact
-        my @cand = $remotetlpdb->candidates($pkg);
-        if (@cand) {
-          my $first = shift @cand;
-          if (defined($first)) {
-            tlwarn("$prg: strange, we have a first candidate but no tlp: $pkg\n");
-            return($F_WARNING);
-          }
-          # already shifted away the first element
-          if ($#cand >= 0) {
-            # recursively showing all tags, but warn
-            print "package:     ", $pkg, "\n";
-            print "WARNING:     This package is not pinned but present in subsidiary repositories\n";
-            print "WARNING:     As long as it is not pinned it is not installable.\n";
-            print "WARNING:     Listing all available copies of the package.\n";
-            my @aaa;
-            for my $a (@cand) {
-              my ($t,$r) = split(/\//, $a, 2);
-              push @aaa, "$pkg" . '@' . $t;
-            }
-            $ret |= action_info(@aaa);
-            return($ret);
-          } else {
-            tlwarn("$prg: strange, package listed but no residual candidates: $pkg\n");
-            return($F_WARNING);
-          }
-        } else {
-          tlwarn("$prg: strange, package listed but no candidates: $pkg\n");
+        # useless test, @cand will always be defined becuase $remotetlpdb is virtual
+        my $first = shift @cand;
+        if (defined($first)) {
+          tlwarn("$prg: strange, we have a first candidate but no tlp: $pkg\n");
           return($F_WARNING);
         }
+        # already shifted away the first element
+        if ($#cand >= 0) {
+          # recursively showing all tags, but warn
+          print "package:     ", $pkg, "\n";
+          print "WARNING:     This package is not pinned but present in subsidiary repositories\n";
+          print "WARNING:     As long as it is not pinned it is not installable.\n";
+          print "WARNING:     Listing all available copies of the package.\n";
+          my @aaa;
+          for my $a (@cand) {
+            my ($t,$r) = split(/\//, $a, 2);
+            push @aaa, "$pkg" . '@' . $t;
+          }
+          $ret |= action_info(@aaa);
+          return($ret);
+        }
       }
       # we didn't find a package like this, so use search
       info("$prg: cannot find package $pkg, searching for other matches:\n");