TLMedia: allow initialization either as

	TLMedia->new($location)
or
	TLMedia->new(-location => $location)
to make it more coherent with others. In the second case you can also add
	TLMedia->new(-location => $location, -tlpdbfile => $path)
which initializes the tlpdb from $path but assuming $location as location.


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

1 files changed, 34 insertions, 5 deletions

diff --git a/Master/tlpkg/TeXLive/TLMedia.pm b/Master/tlpkg/TeXLive/TLMedia.pm
index 773f0550e08..90af2763348 100644
--- a/Master/tlpkg/TeXLive/TLMedia.pm
+++ b/Master/tlpkg/TeXLive/TLMedia.pm
@@ -14,9 +14,24 @@ use TeXLive::TLPDB;
 
 sub new
 {
-  my ($class, $location) = @_;
-  my $media;
+  my ($class, @args) = @_;
+  # 0 elements -> -1
+  # 1 arg      ->  0
+  # even args  ->  uneven
+  my $location;
+  my %params;
   my $self = { };
+  my $tlpdbfile;
+  if ($#args % 2) {
+    # even number of arguments, the first must be the location
+    %params = @args;
+    $location = $params{'-location'};
+    $tlpdbfile = $params{'-tlpdbfile'};
+  } else {
+    # odd number of arguments
+    $location = shift @args;
+  }
+  my $media;
   # of no argument is given we assume NET and default URL
   if (!defined($location)) {
     return;
@@ -40,9 +55,23 @@ sub new
       return;
     }
   }
-  debug("Loading $location/$InfraLocation/$DatabaseName ...\n");
-  my $tlpdb = TeXLive::TLPDB->new(root => $location);
-  return(undef) unless defined($tlpdb);
+  my $tlpdb;
+  if (defined($tlpdbfile)) {
+    # we got the tlpdb file for a specific location
+    debug("Loading TLPDB from $tlpdbfile for $location ...\n");
+    $tlpdb = TeXLive::TLPDB->new;
+    if ($tlpdb->from_file($tlpdbfile)) {
+      # found a positive number of packages
+      $tlpdb->root($location);
+    } else {
+      # couldn't read from tlpdb
+      return(undef);
+    }
+  } else {
+    debug("Loading $location/$InfraLocation/$DatabaseName ...\n");
+    $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;