merge TLMedia functionality into TLPDB and get rid of TLMedia

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

2 files changed, 535 insertions, 661 deletions

diff --git a/Master/tlpkg/TeXLive/TLMedia.pm b/Master/tlpkg/TeXLive/TLMedia.pm
deleted file mode 100644
index 2c3be124b4b..00000000000
--- a/Master/tlpkg/TeXLive/TLMedia.pm
+++ /dev/null
@@ -1,615 +0,0 @@
-# $Id$
-# TeXLive::TLMedia.pm - module for accessing TeX Live Media
-# Copyright 2008, 2009, 2010 Norbert Preining
-# This file is licensed under the GNU General Public License version 2
-# or any later version.
-
-package TeXLive::TLMedia;
-
-my $svnrev = '$Revision$';
-my $_modulerevision;
-if ($svnrev =~ m/: ([0-9]+) /) {
-  $_modulerevision = $1;
-} else {
-  $_modulerevision = "unknown";
-}
-sub module_revision {
-  return $_modulerevision;
-}
-
-
-use TeXLive::TLConfig;
-use TeXLive::TLUtils qw(copy win32 dirname mkdirhier basename download_file
-                        merge_into debug ddebug info tlwarn log);
-use TeXLive::TLPDB;
-use TeXLive::TLWinGoo;
-
-sub new
-{
-  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;
-  }
-  # no default by itself ...
-  # $location = "$TeXLiveURL" unless (defined($location));
-  # do media autodetection
-  if ($location =~ m,http://|ftp://,) {
-    $media = 'NET';
-  } else {
-    if ($location =~ m,file://*(.*)$,) {
-      $location = "/$1";
-    }
-    if (-d "$location/texmf/web2c") {
-      $media = 'local_uncompressed';
-    } elsif (-d "$location/$Archive") {
-      $media = 'local_compressed';
-    } else {
-      # we cannot find the right type, return undefined, that should
-      # make people notice
-      return;
-    }
-  }
-  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;
-  foreach my $pkg ($tlpdb->list_packages) {
-    my $tlpobj = $tlpdb->{'tlps'}{$pkg};
-    $revs{$tlpobj->name} = $tlpobj->revision;
-    if ($tlpobj->category eq "Collection") {
-      push @all_c, $pkg;
-      if ($pkg =~ /collection-lang/) {
-        push @lang_c, $pkg;
-      } elsif ($pkg =~ /documentation/) {
-        if ($pkg =~ /documentation-base/) {
-          push @std_c, $pkg;
-        } else {
-          push @lang_doc_c, $pkg;
-        }
-      } else {
-        push @std_c, $pkg;
-      }
-    } elsif ($tlpobj->category eq "Scheme") {
-      push @schemes, $pkg;
-    }
-  }
-  my (@systems);
-  @systems = $tlpdb->available_architectures;
-  $self->{'media'} = $media;
-  $self->{'location'} = $location;
-  $self->{'tlpdb'} = $tlpdb;
-  $self->{'release'} = $tlpdb->config_release;
-  @{ $self->{'all_collections'} } = @all_c;
-  @{ $self->{'std_collections'} } = @std_c;
-  @{ $self->{'lang_collections'} } = @lang_c;
-  @{ $self->{'lang_doc_collections'} } = @lang_doc_c;
-  @{ $self->{'schemes'} } = @schemes;
-  @{ $self->{'systems'} } = @systems;
-  %{ $self->{'pkgrevs'} } = %revs;
-  bless $self, $class;
-  return $self;
-}
-
-# returns a scalar (0) on error
-# returns a reference to a hash with actions on success
-sub install_package {
-  my ($self, $pkg, $totlpdb, $nopostinstall, $fallbackmedia) = @_;
-  my $fromtlpdb = $self->tlpdb;
-  my $ret;
-  die("TLMedia not initialized, cannot find tlpdb!") unless (defined($fromtlpdb));
-  my $tlpobj = $fromtlpdb->get_package($pkg);
-  if (!defined($tlpobj)) {
-    if (defined($fallbackmedia)) {
-      if ($ret = $fallbackmedia->install_package($pkg,$totlpdb, $nopostinstall)) {
-        debug("installed $pkg from fallback\n");
-        return $ret;
-      } else {
-        tlwarn("$0: Cannot find package $pkg (in fallback, either)\n");
-        return 0;
-      }
-    } else {
-      tlwarn("$0: Cannot find package $pkg\n");
-      return 0;
-    }
-  } else {
-    my $container_src_split = $fromtlpdb->config_src_container;
-    my $container_doc_split = $fromtlpdb->config_doc_container;
-    # get options about src/doc splitting from $totlpdb
-    my $opt_src = $totlpdb->option("install_srcfiles");
-    my $opt_doc = $totlpdb->option("install_docfiles");
-    my $real_opt_doc = $opt_doc;
-    my $reloc = 1 if $tlpobj->relocated;
-    my $container;
-    my @installfiles;
-    my $location = $self->location;
-    # make sure that there is no terminal / in $location, otherwise we
-    # will get double // somewhere
-    $location =~ s!/$!!;
-    foreach ($tlpobj->runfiles) {
-      # s!^!$location/!;
-      push @installfiles, $_;
-    }
-    foreach ($tlpobj->allbinfiles) {
-      # s!^!$location/!;
-      push @installfiles, $_;
-    }
-    if ($opt_src) {
-      foreach ($tlpobj->srcfiles) {
-        # s!^!$location/!;
-        push @installfiles, $_;
-      }
-    }
-    if ($real_opt_doc) {
-      foreach ($tlpobj->docfiles) {
-        # s!^!$location/!;
-        push @installfiles, $_;
-      }
-    }
-    my $media = $self->media;
-    if ($media eq 'local_uncompressed') {
-      $container = \@installfiles;
-    } elsif ($media eq 'local_compressed') {
-      if (-r "$location/$Archive/$pkg.zip") {
-        $container = "$location/$Archive/$pkg.zip";
-      } elsif (-r "$location/$Archive/$pkg.tar.xz") {
-        $container = "$location/$Archive/$pkg.tar.xz";
-      } else {
-        tlwarn("Cannot find a package $pkg (.zip or .xz) in $location/$Archive\n");
-        next;
-      }
-    } elsif (&media eq 'NET') {
-      $container = "$location/$Archive/$pkg.$DefaultContainerExtension";
-    }
-    $self->_install_package ($container, $reloc, \@installfiles, $totlpdb) 
-      || return(0);
-    # if we are installing from local_compressed or NET we have to fetch the respective
-    # source and doc packages $pkg.source and $pkg.doc and install them, too
-    if (($media eq 'NET') || ($media eq 'local_compressed')) {
-      # we install split containers under the following conditions:
-      # - the container were split generated
-      # - src/doc files should be installed
-      # (- the package is not already a split one (like .i386-linux))
-      # the above test has been removed because it would mean that
-      #   texlive.infra.doc.tar.xz
-      # will never be installed, and we do already check that there
-      # are at all src/doc files, which in split packages of the form 
-      # foo.ARCH are not present. And if they are present, than that is fine,
-      # too (bin-foobar.win32.doc.tar.xz)
-      # - there are actually src/doc files present
-      if ($container_src_split && $opt_src && $tlpobj->srcfiles) {
-        my $srccontainer = $container;
-        $srccontainer =~ s/(\.tar\.xz|\.zip)$/.source$1/;
-        $self->_install_package ($srccontainer, $reloc, \@installfiles, $totlpdb) 
-          || return(0);
-      }
-      if ($container_doc_split && $real_opt_doc && $tlpobj->docfiles) {
-        my $doccontainer = $container;
-        $doccontainer =~ s/(\.tar\.xz|\.zip)$/.doc$1/;
-        $self->_install_package ($doccontainer, $reloc, \@installfiles, $totlpdb) 
-          || return(0);
-      }
-      #
-      # if we installed from NET/local_compressed and we got a relocatable container
-      # make sure that the stray texmf-dist/tlpkg directory is removed
-      # in USER MODE that should NOT be done because we keep the information
-      # there, but for now do it unconditionally
-      if ($tlpobj->relocated) {
-        my $reloctree = $totlpdb->root . "/" . $TeXLive::TLConfig::RelocTree;
-        my $tlpkgdir = $reloctree . "/" . $TeXLive::TLConfig::InfraLocation;
-        my $tlpod = $tlpkgdir .  "/tlpobj";
-        TeXLive::TLUtils::rmtree($tlpod) if (-d $tlpod);
-        # we try to remove the tlpkg directory, that will succeed only
-        # if it is empty. So in normal installations it won't be, but
-        # if we are installing a relocated package it is texmf-dist/tlpkg
-        # which will be (hopefully) empty
-        rmdir($tlpkgdir) if (-d "$tlpkgdir");
-      }
-    }
-    # we don't want to have wrong information in the tlpdb, so remove the
-    # src/doc files if they are not installed ...
-    if (!$opt_src) {
-      $tlpobj->clear_srcfiles;
-    }
-    if (!$real_opt_doc) {
-      $tlpobj->clear_docfiles;
-    }
-    # if a package is relocatable we have to cancel the reloc prefix
-    # and unset the relocated setting
-    # before we save it to the local tlpdb
-    if ($tlpobj->relocated) {
-      $tlpobj->cancel_reloc_prefix;
-      $tlpobj->relocated(0);
-    }
-    # we have to write out the tlpobj file since it is contained in the
-    # archives (.tar.xz) but at DVD install time we don't have them
-    my $tlpod = $totlpdb->root . "/tlpkg/tlpobj";
-    mkdirhier( $tlpod );
-    open(TMP,">$tlpod/".$tlpobj->name.".tlpobj") or
-      die("Cannot open tlpobj file for ".$tlpobj->name);
-    $tlpobj->writeout(\*TMP);
-    close(TMP);
-    $totlpdb->add_tlpobj($tlpobj);
-    $totlpdb->save;
-    # compute the return value
-    TeXLive::TLUtils::announce_execute_actions("enable", $tlpobj);
-    if (!$nopostinstall) {
-      # do the postinstallation actions
-      #
-      # Run the post installation code in the postaction tlpsrc entries
-      # in case we are on w32 and the admin did install for himself only
-      # we switch off admin mode
-      if (win32() && admin() && !$totlpdb->option("w32_multi_user")) {
-        non_admin();
-      }
-      # for now desktop_integration maps to both installation
-      # of desktop shortcuts and menu items, but we can split them later
-      &TeXLive::TLUtils::do_postaction("install", $tlpobj,
-        $totlpdb->option("file_assocs"),
-        $totlpdb->option("desktop_integration"),
-        $totlpdb->option("desktop_integration"),
-        $totlpdb->option("post_code"));
-    }
-  }
-  return 1;
-}
-
-#
-# _install_package
-# actually does the installation work
-# returns 1 on success and 0 on error
-#
-sub _install_package {
-  my ($self, $what, $reloc, $filelistref, $totlpdb) = @_;
-
-  my $media = $self->media;
-  my $target = $totlpdb->root;
-  my $tempdir = "$target/temp";
-
-  my @filelist = @$filelistref;
-
-  # we assume that $::progs has been set up!
-  my $wget = $::progs{'wget'};
-  my $xzdec = $::progs{'xzdec'};
-  if (!defined($wget) || !defined($xzdec)) {
-    tlwarn("_install_package: programs not set up properly, strange.\n");
-    return(0);
-  }
-
-  if (ref $what) {
-    # we are getting a ref to a list of files, so install from DVD
-    my $location = $self->location;
-    foreach my $file (@$what) {
-      # @what is taken, not @filelist!
-      # is this still needed?
-      my $dn=dirname($file);
-      mkdirhier("$target/$dn");
-      copy "$location/$file", "$target/$dn";
-    }
-    # we always assume that copy will work
-    return(1);
-  } elsif ($what =~ m,\.tar(\.xz)?$,) {
-    my $type = defined($1) ? "xz" : "tar";
-      
-    $target .= "/$TeXLive::TLConfig::RelocTree" if $reloc;
-
-    # this is the case when we install from local_compressed or the NET, or a backup
-    #
-    # in all other cases we create temp files .tar.xz (or use the present
-    # one), xzdec them, and then call tar
-
-    my $fn = basename($what);
-    my $pkg = $fn;
-    $pkg =~ s/\.tar(\.xz)?$//;
-    mkdirhier("$tempdir");
-    my $tarfile;
-    my $remove_tarfile = 1;
-    if ($type eq "xz") {
-      my $xzfile = "$tempdir/$fn";
-      $tarfile  = "$tempdir/$fn"; $tarfile =~ s/\.xz$//;
-      my $xzfile_quote = $xzfile;
-      my $tarfile_quote = $tarfile;
-      my $target_quote = $target;
-      if (win32()) {
-        $xzfile =~ s!/!\\!g;
-        $xzfile_quote = "\"$xzfile\"";
-        $tarfile =~ s!/!\\!g;
-        $tarfile_quote = "\"$tarfile\"";
-        $target =~ s!/!\\!g;
-        $target_quote = "\"$target\"";
-      }
-      if ($what =~ m,http://|ftp://,) {
-        # we are installing from the NET
-        # download the file and put it into temp
-        if (!download_file($what, $xzfile) || (! -r $xzfile)) {
-          tlwarn("Downloading \n");
-          tlwarn("   $what\n");
-          tlwarn("did not succeed, please retry.\n");
-          unlink($tarfile, $xzfile);
-          return(0);
-        }
-      } else {
-        # we are installing from local compressed files
-        # copy it to temp
-        copy($what, $tempdir);
-      }
-      debug("un-xzing $xzfile to $tarfile\n");
-      system("$xzdec < $xzfile_quote > $tarfile_quote");
-      if (! -f $tarfile) {
-        tlwarn("_install_package: Unpacking $xzfile failed, please retry.\n");
-        unlink($tarfile, $xzfile);
-        return(0);
-      }
-      unlink($xzfile);
-    } else {
-      $tarfile = "$tempdir/$fn";
-      if ($what =~ m,http://|ftp://,) {
-        if (!download_file($what, $tarfile) || (! -r $tarfile)) {
-          tlwarn("Downloading \n");
-          tlwarn("   $what\n");
-          tlwarn("failed, please retry.\n");
-          unlink($tarfile);
-          return(0);
-        }
-      } else {
-        $tarfile = $what;
-        $remove_tarfile = 0;
-      }
-    }
-    my $ret = TeXLive::TLUtils::untar($tarfile, $target, $remove_tarfile);
-    # remove the $pkg.tlpobj, we recreate it anyway again
-    unlink ("$target/tlpkg/tlpobj/$pkg.tlpobj") 
-      if (-r "$target/tlpkg/tlpobj/$pkg.tlpobj");
-    return $ret;
-  } else {
-    tlwarn("_install_package: Don't know how to install $what\n");
-    return(0);
-  }
-}
-
-#
-# remove_package removes a single package with all files (including the
-# # tlpobj files) and the entry from the tlpdb.
-sub remove_package {
-  my ($self, $pkg, %opts) = @_;
-  my $localtlpdb = $self->tlpdb;
-  my $tlp = $localtlpdb->get_package($pkg);
-  if (!defined($tlp)) {
-    tlwarn ("$pkg: package not present, cannot remove\n");
-  } else {
-    my $currentarch = $self->platform();
-    if ($pkg eq "texlive.infra" || $pkg eq "texlive.infra.$currentarch") {
-      log ("Not removing $pkg, it is essential!\n");
-      return 0;
-    }
-    # we have to chdir to $localtlpdb->root
-    my $Master = $localtlpdb->root;
-    chdir ($Master) || die "chdir($Master) failed: $!";
-    my @files = $tlp->all_files;
-    # also remove the .tlpobj file
-    push @files, "tlpkg/tlpobj/$pkg.tlpobj";
-    # and the ones from src/doc splitting
-    if (-r "tlpkg/tlpobj/$pkg.source.tlpobj") {
-      push @files, "tlpkg/tlpobj/$pkg.source.tlpobj";
-    }
-    if (-r "tlpkg/tlpobj/$pkg.doc.tlpobj") {
-      push @files, "tlpkg/tlpobj/$pkg.doc.tlpobj";
-    }
-    #
-    # some packages might be relocated, thus having the RELOC prefix
-    # in user mode we just remove the prefix, in normal mode we
-    # replace it with texmf-dist
-    # since we don't have user mode 
-    if ($tlp->relocated) {
-      for (@files) {
-        s:^$RelocPrefix/:$RelocTree/:;
-      }
-    }
-    #
-    # we want to check that a file is only listed in one package, so
-    # in case that a file to be removed is listed in another package
-    # we will warn and *not* remove it
-    my %allfiles;
-    for my $p ($localtlpdb->list_packages) {
-      next if ($p eq $pkg); # we have to skip the to be removed package
-      for my $f ($localtlpdb->get_package($p)->all_files) {
-      	$allfiles{$f} = $p;
-      }
-    }
-    my @goodfiles = ();
-    my @badfiles = ();
-    my @debugfiles = ();
-    for my $f (@files) {
-      # in usermode we have to add texmf-dist again for comparison
-      if (defined($allfiles{$f})) {
-        # this file should be removed but is mentioned somewhere, too
-        # take into account if we got a warn list
-        if (defined($opts{'remove-warn-files'})) {
-          my %a = %{$opts{'remove-warn-files'}};
-          if (defined($a{$f})) {
-            push @badfiles, $f;
-          } else {
-            # NO NOTHING HERE!!!
-            # DON'T PUSH IT ON @goodfiles, it will be removed, which we do
-            # NOT want. We only want to supress the warning!
-            push @debugfiles, $f;
-          }
-        } else {
-          push @badfiles, $f;
-        }
-      } else {
-        push @goodfiles, $f;
-      }
-    }
-    if ($#debugfiles >= 0) {
-      debug("The following files will not be removed due to the removal of $pkg.\n");
-      debug("But we do not warn on it because they are moved to other packages.\n");
-      for my $f (@debugfiles) {
-        debug(" $f - $allfiles{$f}\n");
-      }
-    }
-    if ($#badfiles >= 0) {
-      # warn the user
-      tlwarn("The following files should be removed due to the removal of $pkg,\n");
-      tlwarn("but are part of another package, too.\n");
-      for my $f (@badfiles) {
-        tlwarn(" $f - $allfiles{$f}\n");
-      }
-    }
-    #
-    # Run only the postaction code thing now since afterwards the
-    # files will be gone ...
-    if (defined($opts{'nopostinstall'}) && $opts{'nopostinstall'}) {
-      &TeXLive::TLUtils::do_postaction("remove", $tlp,
-        0, # option_file_assocs,
-        0, # option_desktop_integration, menu part
-        0, # option_desktop_integration, desktop part
-        $localtlpdb->option("post_code"));
-    }
-    # 
-    my @removals = &TeXLive::TLUtils::removed_dirs (@goodfiles);
-    # now do the removal
-    for my $entry (@goodfiles) {
-      unlink $entry;
-    }
-    for my $d (@removals) {
-      rmdir $d;
-    }
-    $localtlpdb->remove_package($pkg);
-    TeXLive::TLUtils::announce_execute_actions("disable", $tlp);
-    # should we save at each removal???
-    # advantage: the tlpdb actually reflects what is installed
-    # disadvantage: removing a collection calls the save routine several times
-    # still I consider it better that the tlpdb is in a consistent state
-    $localtlpdb->save;
-    #
-    # Run the post installation code in the postaction tlpsrc entries
-    # in case we are on w32 and the admin did install for himself only
-    # we switch off admin mode
-    if (win32() && admin() && !$localtlpdb->option("w32_multi_user")) {
-      non_admin();
-    }
-    #
-    # Run the post installation code in the postaction tlpsrc entries
-    # the postaction code part cannot be evaluated now since the
-    # files are already removed.
-    # Again, desktop integration maps to desktop and menu links
-    if (!$nopostinstall) {
-      &TeXLive::TLUtils::do_postaction("remove", $tlp,
-        $localtlpdb->option("file_assocs"),
-        $localtlpdb->option("desktop_integration"),
-        $localtlpdb->option("desktop_integration"),
-        0);
-    }
-  }
-  return 1;
-}
-
-
-# member access functions
-#
-sub media { my $self = shift ; return $self->{'media'}; }
-sub location { my $self = shift ; return $self->{'location'}; }
-sub tlpdb { my $self = shift ; return $self->{'tlpdb'}; }
-sub release { my $self = shift ; return $self->{'release'}; }
-sub all_collections { my $self = shift; return @{ $self->{'all_collections'} }; }
-sub std_collections { my $self = shift; return @{ $self->{'std_collections'} }; }
-sub lang_collections { my $self = shift; return @{ $self->{'lang_collections'} }; }
-sub lang_doc_collections { my $self = shift; return @{ $self->{'lang_doc_collections'} }; }
-sub schemes { my $self = shift; return @{ $self->{'schemes'} }; }
-sub systems { my $self = shift; return @{ $self->{'systems'} }; }
-
-# deduce the platform of the referenced media as follows:
-# - if the $tlpdb->setting("platform") is there it overrides the detected
-#   setting
-# - if it is not there call TLUtils::platform()
-sub platform {
-  # try to deduce the platform
-  my $self = shift;
-  my $tlpdb = $self->tlpdb;
-  if (defined($tlpdb)) {
-    my $ret = $tlpdb->setting("platform");
-    return $ret if defined $ret;
-  }
-  # the platform setting wasn't found in the tlpdb, try TLUtils::platform
-  return TeXLive::TLUtils::platform();
-}
-
-1;
-__END__
-
-
-=head1 NAME
-
-C<TeXLive::TLMedia> -- TeX Live Media module
-
-=head1 SYNOPSIS
-
-  use TeXLive::TLMedia;
-
-  my $tlneo = TeXLive::TLMedia->new('http://www.ctan.org/mirror/tl/');
-  my $tlcd  = TeXLive::TLMedia->new('/mnt/tl-cd/');
-  my $tldvd = TeXLive::TLMedia->new('/mnt/tl-dvd/');
-
-=head1 DESCRIPTION
-
-missing
-
-=head1 MEMBER ACCESS FUNCTIONS
-
-scalars: media, location, tlpdb, release
-lists: all_collections, std_collections, lang_collections, lang_doc_collections,
-schemes, systems
-
-=head1 SEE ALSO
-
-The modules L<TeXLive::TLConfig>, L<TeXLive::TLUtils>, L<TeXLive::TLPOBJ>, 
-L<TeXLive::TLPDB>, L<TeXLive::TLTREE>.
-
-=head1 AUTHORS AND COPYRIGHT
-
-This script and its documentation were written for the TeX Live
-distribution (L<http://tug.org/texlive>) and both are licensed under the
-GNU General Public License Version 2 or later.
-
-=cut
-
-### Local Variables:
-### perl-indent-level: 2
-### tab-width: 2
-### indent-tabs-mode: nil
-### End:
-# vim:set tabstop=2 expandtab: #
diff --git a/Master/tlpkg/TeXLive/TLPDB.pm b/Master/tlpkg/TeXLive/TLPDB.pm
index 010888ae0da..c8d7b4b0ea4 100644
--- a/Master/tlpkg/TeXLive/TLPDB.pm
+++ b/Master/tlpkg/TeXLive/TLPDB.pm
@@ -36,11 +36,12 @@ C<TeXLive::TLPDB> -- A database of TeX Live Packages
   $tlpdb->writeout;
   $tlpdb->writeout(FILEHANDLE);
   $tlpdb->save;
+  $tlpdb->media;
   $tlpdb->available_architectures();
   $tlpdb->add_tlpcontainer($pkg, $ziploc [, $archrefs [, $dest ]] );
   $tlpdb->add_tlpobj($tlpobj);
   $tlpdb->needed_by($pkg);
-  $tlpdb->remove_package($pkg);
+  $tlpdb->remove_tlpobj($pkg);
   $tlpdb->get_package("packagename");
   $tlpdb->list_packages;
   $tlpdb->expand_dependencies(["-only-arch",] $totlpdb, @list);
@@ -55,6 +56,7 @@ C<TeXLive::TLPDB> -- A database of TeX Live Packages
   $tlpdb->language_lua_lines;
   $tlpdb->package_revision("packagename");
   $tlpdb->location;
+  $tlpdb->platform;
   $tlpdb->config_src_container;
   $tlpdb->config_doc_container;
   $tlpdb->config_container_format;
@@ -68,6 +70,9 @@ C<TeXLive::TLPDB> -- A database of TeX Live Packages
   $tlpdb->settings;
   $tlpdb->setting($key, [$value]);
   $tlpdb->sizes_of_packages($opt_src, $opt_doc [, @packs ]);
+  $tlpdb->install_package($pkg, $dest_tlpdb, $nopostinstall, $fallbacktlpdb);
+  $tlpdb->remove_package($pkg, %options);
+
 
   TeXLive::TLPDB->listdir([$dir]);
   $tlpdb->generate_listfiles([$destdir]);
@@ -79,8 +84,8 @@ C<TeXLive::TLPDB> -- A database of TeX Live Packages
 use TeXLive::TLConfig qw($CategoriesRegexp $DefaultCategory $InfraLocation
       $DatabaseName $MetaCategoriesRegexp $Archive
       %TLPDBOptions %TLPDBSettings);
-use TeXLive::TLUtils qw(dirname mkdirhier member win32 info debug ddebug
-                        tlwarn);
+use TeXLive::TLUtils qw(dirname mkdirhier member win32 info log debug ddebug
+                        tlwarn basename download_file merge_into);
 use TeXLive::TLPOBJ;
 
 use Cwd 'abs_path';
@@ -116,6 +121,15 @@ sub new {
   };
   $_listdir = $params{'listdir'} if defined($params{'listdir'});
   bless $self, $class;
+  if (defined($params{'tlpdbfile'})) {
+    my $nr_packages_read
+      = $self->from_file("$self->{'root'}/$InfraLocation/$DatabaseName");
+    if ($nr_packages_read == 0) {
+      # that is bad, we didn't read anything, so return undef.
+      return undef;
+    }
+    return $self;
+  } 
   if (defined($self->{'root'})) {
     my $nr_packages_read
       = $self->from_file("$self->{'root'}/$InfraLocation/$DatabaseName");
@@ -185,14 +199,14 @@ sub needed_by {
 
 =pod
 
-=item C<< $tlpdb->remove_package($pkg) >>
+=item C<< $tlpdb->remove_tlpobj($pkg) >>
 
 Remove the package named C<$pkg> from the tlpdb. Gives a warning if the
 package is not present
 
 =cut
 
-sub remove_package {
+sub remove_tlpobj {
   my ($self,$pkg) = @_;
   if (defined($self->{'tlps'}{$pkg})) {
     delete $self->{'tlps'}{$pkg};
@@ -228,6 +242,27 @@ sub from_file {
   }
   my $retfh;
   my $tlpdbfile;
+  # do media detection
+  my $rootpath = $self->root;
+  if ($rootpath =~ m,http://|ftp://,) {
+    $media = 'NET';
+  } else {
+    if ($rootpath =~ m,file://*(.*)$,) {
+      $rootpath = "/$1";
+    }
+    if (-d "$rootpath/texmf/web2c") {
+      $media = 'local_uncompressed';
+    } elsif (-d "$rootpath/$Archive") {
+      $media = 'local_compressed';
+    } else {
+      # we cannot find the right type, return undefined, that should
+      # make people notice
+      return 0;
+    }
+  }
+  $self->{'media'} = $media;
+  #
+  # actually load the TLPDB
   if ($path =~ m;^((http|ftp)://|file:\/\/*);) {
     debug("TLPDB.pm: trying to initialize from $path\n");
     # if we have xzdec available we try the xz file
@@ -349,6 +384,19 @@ sub save {
 
 =pod
 
+=item C<< $tlpdb->media >>
+
+Returns the media code the respective installation resides on.
+
+=cut
+
+sub media { 
+  my $self = shift ; 
+  return $self->{'media'};
+}
+
+=pod
+
 =item C<< $tlpdb->available_architectures >>
 
 The C<available_architectures> functions returns the list of available 
@@ -640,10 +688,11 @@ package named in the first argument.
 
 sub package_revision {
   my ($self,$pkg) = @_;
-  if (defined($self->{'tlps'}{$pkg})) {
-    return($self->{'tlps'}{$pkg}->revision);
+  my $tlp = $self->get_package($pkg);
+  if (defined($tlp)) {
+    return $tlp->revision;
   } else {
-    return(undef);
+    return;
   }
 }
 
@@ -661,9 +710,9 @@ available architectures as packages with revision number -1.
 sub generate_packagelist {
   my $self = shift;
   my $fd = (@_ ? $_[0] : STDOUT);
-  foreach (sort keys %{$self->{'tlps'}}) {
-    print $fd $self->{'tlps'}{$_}->name, " ",
-              $self->{'tlps'}{$_}->revision, "\n";
+  foreach (sort $self->list_packages) {
+    print $fd $self->get_package($_)->name, " ",
+              $self->get_package($_)->revision, "\n";
   }
   foreach ($self->available_architectures) {
     print $fd "$_ -1\n";
@@ -686,8 +735,8 @@ sub generate_listfiles {
   if (not(defined($destdir))) {
     $destdir = TeXLive::TLPDB->listdir;
   }
-  foreach (sort keys %{$self->{'tlps'}}) {
-    $tlp = $self->{'tlps'}{$_};
+  foreach (sort $self->list_package) {
+    $tlp = $self->get_package($_);
     $self->_generate_listfile($tlp, $destdir);
   }
 }
@@ -833,6 +882,27 @@ sub location {
 
 =pod
 
+=item C<< $tlpdb->platform >>
+
+returns the platform of this installation.
+
+=cut
+
+# deduce the platform of the referenced media as follows:
+# - if the $tlpdb->setting("platform") is there it overrides the detected
+#   setting
+# - if it is not there call TLUtils::platform()
+sub platform {
+  # try to deduce the platform
+  my $self = shift;
+  my $ret = $self->setting("platform");
+  return $ret if defined $ret;
+  # the platform setting wasn't found in the tlpdb, try TLUtils::platform
+  return TeXLive::TLUtils::platform();
+}
+
+=pod
+
 =item C<< $tlpdb->listdir >>
 
 The function C<listdir> allows to read and set the packages variable
@@ -986,21 +1056,7 @@ which contains the total size of all packages under discussion.
 sub sizes_of_packages {
   my ($self, $opt_src, $opt_doc, @packs) = @_;
   @packs || ( @packs = $self->list_packages() );
-  my $root = $self->root;
-  my $media;
-  if ($root =~ m!^(ctan$|(http|ftp)://)!i) {
-    $media = 'NET';
-  } else {
-    $root =~ s!file://*!/!i;
-    $root = abs_path($root);
-    if (-d "$root/$Archive") {
-      $media = 'local_compressed';
-    } elsif (-d "$root/texmf/web2c") {
-      $media = 'local_uncompressed';
-    } else {
-      die "$0: that should not happen, no proper location found!";
-    }
-  }
+  my $media = $self->media;
   my %tlpsizes;
   my %tlpobjs;
   my $totalsize;
@@ -1010,23 +1066,7 @@ sub sizes_of_packages {
       warn "STRANGE: $p not to be found in ", $self->root;
       next;
     }
-    if ($media ne 'local_uncompressed') {
-      # we use the container size as the measuring unit since probably
-      # downloading will be the limiting factor
-      $tlpsizes{$p} = $tlpobjs{$p}->containersize;
-      $tlpsizes{$p} += $tlpobjs{$p}->srccontainersize if $opt_src;
-      $tlpsizes{$p} += $tlpobjs{$p}->doccontainersize if $opt_doc;
-    } else {
-      # we have to add the respective sizes, that is checking for 
-      # installation of src and doc file
-      $tlpsizes{$p} = $tlpobjs{$p}->runsize;
-      $tlpsizes{$p} += $tlpobjs{$p}->srcsize if $opt_src;
-      $tlpsizes{$p} += $tlpobjs{$p}->docsize if $opt_doc;
-      my %foo = %{$tlpobjs{$p}->binsize};
-      for my $k (keys %foo) { $tlpsizes{$p} += $foo{$k}; }
-      # all the packages sizes are in blocks, so transfer that to bytes
-      $tlpsizes{$p} *= $TeXLive::TLConfig::BlockSize;
-    }
+    $tlpsizes{$p} = $self->size_of_one_package($media, $tlpobjs{$p}, $opt_src, $opt_doc);
     $totalsize += $tlpsizes{$p};
   }
   if ($totalsize) {
@@ -1035,7 +1075,456 @@ sub sizes_of_packages {
   return \%tlpsizes;
 }
 
+sub size_of_one_package {
+  my ($self, $media, $tlpobj, $opt_src, $opt_doc) = @_;
+  my $size = 0;
+  if ($media ne 'local_uncompressed') {
+    # we use the container size as the measuring unit since probably
+    # downloading will be the limiting factor
+    $size =  $tlpobj->containersize;
+    $size += $tlpobj->srccontainersize if $opt_src;
+    $size += $tlpobj->doccontainersize if $opt_doc;
+  } else {
+    # we have to add the respective sizes, that is checking for
+    # installation of src and doc file
+    $size  = $tlpobj->runsize;
+    $size += $tlpobj->srcsize if $opt_src;
+    $size += $tlpobj->docsize if $opt_doc;
+    my %foo = %{$tlpobj->binsize};
+    for my $k (keys %foo) { $size += $foo{$k}; }
+    # all the packages sizes are in blocks, so transfer that to bytes
+    $size *= $TeXLive::TLConfig::BlockSize;
+  }
+  return $size;
+}
+
+=pod
 
+=item C<< $tlpdb->install_package($pkg, $dest_tlpdb, $nopostinstall, $fallbacktlpdb) >>
+
+Installs the package $pkg into $dest_tlpdb.
+
+=cut
+
+sub install_package {
+  my ($self, $pkg, $totlpdb, $nopostinstall, $fallbackmedia) = @_;
+  my $fromtlpdb = $self;
+  my $ret;
+  die("TLPDB not initialized, cannot find tlpdb!") unless (defined($fromtlpdb));
+  my $tlpobj = $fromtlpdb->get_package($pkg);
+  if (!defined($tlpobj)) {
+    if (defined($fallbackmedia)) {
+      if ($ret = $fallbackmedia->install_package($pkg,$totlpdb, $nopostinstall)) {
+        debug("installed $pkg from fallback\n");
+        return $ret;
+      } else {
+        tlwarn("$0: Cannot find package $pkg (in fallback, either)\n");
+        return 0;
+      }
+    } else {
+      tlwarn("$0: Cannot find package $pkg\n");
+      return 0;
+    }
+  } else {
+    my $container_src_split = $fromtlpdb->config_src_container;
+    my $container_doc_split = $fromtlpdb->config_doc_container;
+    # get options about src/doc splitting from $totlpdb
+    my $opt_src = $totlpdb->option("install_srcfiles");
+    my $opt_doc = $totlpdb->option("install_docfiles");
+    my $real_opt_doc = $opt_doc;
+    my $reloc = 1 if $tlpobj->relocated;
+    my $container;
+    my @installfiles;
+    my $root = $self->root;
+    # make sure that there is no terminal / in $root, otherwise we
+    # will get double // somewhere
+    $root =~ s!/$!!;
+    foreach ($tlpobj->runfiles) {
+      # s!^!$root/!;
+      push @installfiles, $_;
+    }
+    foreach ($tlpobj->allbinfiles) {
+      # s!^!$root/!;
+      push @installfiles, $_;
+    }
+    if ($opt_src) {
+      foreach ($tlpobj->srcfiles) {
+        # s!^!$root/!;
+        push @installfiles, $_;
+      }
+    }
+    if ($real_opt_doc) {
+      foreach ($tlpobj->docfiles) {
+        # s!^!$root/!;
+        push @installfiles, $_;
+      }
+    }
+    my $media = $self->media;
+    if ($media eq 'local_uncompressed') {
+      $container = \@installfiles;
+    } elsif ($media eq 'local_compressed') {
+      if (-r "$root/$Archive/$pkg.zip") {
+        $container = "$root/$Archive/$pkg.zip";
+      } elsif (-r "$root/$Archive/$pkg.tar.xz") {
+        $container = "$root/$Archive/$pkg.tar.xz";
+      } else {
+        tlwarn("Cannot find a package $pkg (.zip or .xz) in $root/$Archive\n");
+        next;
+      }
+    } elsif (&media eq 'NET') {
+      $container = "$root/$Archive/$pkg.$DefaultContainerExtension";
+    }
+    $self->_install_package ($container, $reloc, \@installfiles, $totlpdb) 
+      || return(0);
+    # if we are installing from local_compressed or NET we have to fetch the respective
+    # source and doc packages $pkg.source and $pkg.doc and install them, too
+    if (($media eq 'NET') || ($media eq 'local_compressed')) {
+      # we install split containers under the following conditions:
+      # - the container were split generated
+      # - src/doc files should be installed
+      # (- the package is not already a split one (like .i386-linux))
+      # the above test has been removed because it would mean that
+      #   texlive.infra.doc.tar.xz
+      # will never be installed, and we do already check that there
+      # are at all src/doc files, which in split packages of the form 
+      # foo.ARCH are not present. And if they are present, than that is fine,
+      # too (bin-foobar.win32.doc.tar.xz)
+      # - there are actually src/doc files present
+      if ($container_src_split && $opt_src && $tlpobj->srcfiles) {
+        my $srccontainer = $container;
+        $srccontainer =~ s/(\.tar\.xz|\.zip)$/.source$1/;
+        $self->_install_package ($srccontainer, $reloc, \@installfiles, $totlpdb) 
+          || return(0);
+      }
+      if ($container_doc_split && $real_opt_doc && $tlpobj->docfiles) {
+        my $doccontainer = $container;
+        $doccontainer =~ s/(\.tar\.xz|\.zip)$/.doc$1/;
+        $self->_install_package ($doccontainer, $reloc, \@installfiles, $totlpdb) 
+          || return(0);
+      }
+      #
+      # if we installed from NET/local_compressed and we got a relocatable container
+      # make sure that the stray texmf-dist/tlpkg directory is removed
+      # in USER MODE that should NOT be done because we keep the information
+      # there, but for now do it unconditionally
+      if ($tlpobj->relocated) {
+        my $reloctree = $totlpdb->root . "/" . $TeXLive::TLConfig::RelocTree;
+        my $tlpkgdir = $reloctree . "/" . $TeXLive::TLConfig::InfraLocation;
+        my $tlpod = $tlpkgdir .  "/tlpobj";
+        TeXLive::TLUtils::rmtree($tlpod) if (-d $tlpod);
+        # we try to remove the tlpkg directory, that will succeed only
+        # if it is empty. So in normal installations it won't be, but
+        # if we are installing a relocated package it is texmf-dist/tlpkg
+        # which will be (hopefully) empty
+        rmdir($tlpkgdir) if (-d "$tlpkgdir");
+      }
+    }
+    # we don't want to have wrong information in the tlpdb, so remove the
+    # src/doc files if they are not installed ...
+    if (!$opt_src) {
+      $tlpobj->clear_srcfiles;
+    }
+    if (!$real_opt_doc) {
+      $tlpobj->clear_docfiles;
+    }
+    # if a package is relocatable we have to cancel the reloc prefix
+    # and unset the relocated setting
+    # before we save it to the local tlpdb
+    if ($tlpobj->relocated) {
+      $tlpobj->cancel_reloc_prefix;
+      $tlpobj->relocated(0);
+    }
+    # we have to write out the tlpobj file since it is contained in the
+    # archives (.tar.xz) but at DVD install time we don't have them
+    my $tlpod = $totlpdb->root . "/tlpkg/tlpobj";
+    mkdirhier( $tlpod );
+    open(TMP,">$tlpod/".$tlpobj->name.".tlpobj") or
+      die("Cannot open tlpobj file for ".$tlpobj->name);
+    $tlpobj->writeout(\*TMP);
+    close(TMP);
+    $totlpdb->add_tlpobj($tlpobj);
+    $totlpdb->save;
+    # compute the return value
+    TeXLive::TLUtils::announce_execute_actions("enable", $tlpobj);
+    if (!$nopostinstall) {
+      # do the postinstallation actions
+      #
+      # Run the post installation code in the postaction tlpsrc entries
+      # in case we are on w32 and the admin did install for himself only
+      # we switch off admin mode
+      if (win32() && admin() && !$totlpdb->option("w32_multi_user")) {
+        non_admin();
+      }
+      # for now desktop_integration maps to both installation
+      # of desktop shortcuts and menu items, but we can split them later
+      &TeXLive::TLUtils::do_postaction("install", $tlpobj,
+        $totlpdb->option("file_assocs"),
+        $totlpdb->option("desktop_integration"),
+        $totlpdb->option("desktop_integration"),
+        $totlpdb->option("post_code"));
+    }
+  }
+  return 1;
+}
+
+#
+# _install_package
+# actually does the installation work
+# returns 1 on success and 0 on error
+#
+sub _install_package {
+  my ($self, $what, $reloc, $filelistref, $totlpdb) = @_;
+
+  my $media = $self->media;
+  my $target = $totlpdb->root;
+  my $tempdir = "$target/temp";
+
+  my @filelist = @$filelistref;
+
+  # we assume that $::progs has been set up!
+  my $wget = $::progs{'wget'};
+  my $xzdec = $::progs{'xzdec'};
+  if (!defined($wget) || !defined($xzdec)) {
+    tlwarn("_install_package: programs not set up properly, strange.\n");
+    return(0);
+  }
+
+  if (ref $what) {
+    # we are getting a ref to a list of files, so install from DVD
+    my $root = $self->root;
+    foreach my $file (@$what) {
+      # @what is taken, not @filelist!
+      # is this still needed?
+      my $dn=dirname($file);
+      mkdirhier("$target/$dn");
+      TeXLive::TLUtils::copy "$root/$file", "$target/$dn";
+    }
+    # we always assume that copy will work
+    return(1);
+  } elsif ($what =~ m,\.tar(\.xz)?$,) {
+    my $type = defined($1) ? "xz" : "tar";
+      
+    $target .= "/$TeXLive::TLConfig::RelocTree" if $reloc;
+
+    # this is the case when we install from local_compressed or the NET, or a backup
+    #
+    # in all other cases we create temp files .tar.xz (or use the present
+    # one), xzdec them, and then call tar
+
+    my $fn = basename($what);
+    my $pkg = $fn;
+    $pkg =~ s/\.tar(\.xz)?$//;
+    mkdirhier("$tempdir");
+    my $tarfile;
+    my $remove_tarfile = 1;
+    if ($type eq "xz") {
+      my $xzfile = "$tempdir/$fn";
+      $tarfile  = "$tempdir/$fn"; $tarfile =~ s/\.xz$//;
+      my $xzfile_quote = $xzfile;
+      my $tarfile_quote = $tarfile;
+      my $target_quote = $target;
+      if (win32()) {
+        $xzfile =~ s!/!\\!g;
+        $xzfile_quote = "\"$xzfile\"";
+        $tarfile =~ s!/!\\!g;
+        $tarfile_quote = "\"$tarfile\"";
+        $target =~ s!/!\\!g;
+        $target_quote = "\"$target\"";
+      }
+      if ($what =~ m,http://|ftp://,) {
+        # we are installing from the NET
+        # download the file and put it into temp
+        if (!download_file($what, $xzfile) || (! -r $xzfile)) {
+          tlwarn("Downloading \n");
+          tlwarn("   $what\n");
+          tlwarn("did not succeed, please retry.\n");
+          unlink($tarfile, $xzfile);
+          return(0);
+        }
+      } else {
+        # we are installing from local compressed files
+        # copy it to temp
+        TeXLive::TLUtils::copy($what, $tempdir);
+      }
+      debug("un-xzing $xzfile to $tarfile\n");
+      system("$xzdec < $xzfile_quote > $tarfile_quote");
+      if (! -f $tarfile) {
+        tlwarn("_install_package: Unpacking $xzfile failed, please retry.\n");
+        unlink($tarfile, $xzfile);
+        return(0);
+      }
+      unlink($xzfile);
+    } else {
+      $tarfile = "$tempdir/$fn";
+      if ($what =~ m,http://|ftp://,) {
+        if (!download_file($what, $tarfile) || (! -r $tarfile)) {
+          tlwarn("Downloading \n");
+          tlwarn("   $what\n");
+          tlwarn("failed, please retry.\n");
+          unlink($tarfile);
+          return(0);
+        }
+      } else {
+        $tarfile = $what;
+        $remove_tarfile = 0;
+      }
+    }
+    my $ret = TeXLive::TLUtils::untar($tarfile, $target, $remove_tarfile);
+    # remove the $pkg.tlpobj, we recreate it anyway again
+    unlink ("$target/tlpkg/tlpobj/$pkg.tlpobj") 
+      if (-r "$target/tlpkg/tlpobj/$pkg.tlpobj");
+    return $ret;
+  } else {
+    tlwarn("_install_package: Don't know how to install $what\n");
+    return(0);
+  }
+}
+
+=pod
+
+=item << $tlpdb->remove_package($pkg, %options) >>
+
+removes a single pacakge with all the files and the entry in the db.
+
+=cut
+
+#
+# remove_package removes a single package with all files (including the
+# # tlpobj files) and the entry from the tlpdb.
+sub remove_package {
+  my ($self, $pkg, %opts) = @_;
+  my $localtlpdb = $self;
+  my $tlp = $localtlpdb->get_package($pkg);
+  if (!defined($tlp)) {
+    tlwarn ("$pkg: package not present, cannot remove\n");
+  } else {
+    my $currentarch = $self->platform();
+    if ($pkg eq "texlive.infra" || $pkg eq "texlive.infra.$currentarch") {
+      log ("Not removing $pkg, it is essential!\n");
+      return 0;
+    }
+    # we have to chdir to $localtlpdb->root
+    my $Master = $localtlpdb->root;
+    chdir ($Master) || die "chdir($Master) failed: $!";
+    my @files = $tlp->all_files;
+    # also remove the .tlpobj file
+    push @files, "tlpkg/tlpobj/$pkg.tlpobj";
+    # and the ones from src/doc splitting
+    if (-r "tlpkg/tlpobj/$pkg.source.tlpobj") {
+      push @files, "tlpkg/tlpobj/$pkg.source.tlpobj";
+    }
+    if (-r "tlpkg/tlpobj/$pkg.doc.tlpobj") {
+      push @files, "tlpkg/tlpobj/$pkg.doc.tlpobj";
+    }
+    #
+    # some packages might be relocated, thus having the RELOC prefix
+    # in user mode we just remove the prefix, in normal mode we
+    # replace it with texmf-dist
+    # since we don't have user mode 
+    if ($tlp->relocated) {
+      for (@files) {
+        s:^$RelocPrefix/:$RelocTree/:;
+      }
+    }
+    #
+    # we want to check that a file is only listed in one package, so
+    # in case that a file to be removed is listed in another package
+    # we will warn and *not* remove it
+    my %allfiles;
+    for my $p ($localtlpdb->list_packages) {
+      next if ($p eq $pkg); # we have to skip the to be removed package
+      for my $f ($localtlpdb->get_package($p)->all_files) {
+        $allfiles{$f} = $p;
+      }
+    }
+    my @goodfiles = ();
+    my @badfiles = ();
+    my @debugfiles = ();
+    for my $f (@files) {
+      # in usermode we have to add texmf-dist again for comparison
+      if (defined($allfiles{$f})) {
+        # this file should be removed but is mentioned somewhere, too
+        # take into account if we got a warn list
+        if (defined($opts{'remove-warn-files'})) {
+          my %a = %{$opts{'remove-warn-files'}};
+          if (defined($a{$f})) {
+            push @badfiles, $f;
+          } else {
+            # NO NOTHING HERE!!!
+            # DON'T PUSH IT ON @goodfiles, it will be removed, which we do
+            # NOT want. We only want to supress the warning!
+            push @debugfiles, $f;
+          }
+        } else {
+          push @badfiles, $f;
+        }
+      } else {
+        push @goodfiles, $f;
+      }
+    }
+    if ($#debugfiles >= 0) {
+      debug("The following files will not be removed due to the removal of $pkg.\n");
+      debug("But we do not warn on it because they are moved to other packages.\n");
+      for my $f (@debugfiles) {
+        debug(" $f - $allfiles{$f}\n");
+      }
+    }
+    if ($#badfiles >= 0) {
+      # warn the user
+      tlwarn("The following files should be removed due to the removal of $pkg,\n");
+      tlwarn("but are part of another package, too.\n");
+      for my $f (@badfiles) {
+        tlwarn(" $f - $allfiles{$f}\n");
+      }
+    }
+    #
+    # Run only the postaction code thing now since afterwards the
+    # files will be gone ...
+    if (defined($opts{'nopostinstall'}) && $opts{'nopostinstall'}) {
+      &TeXLive::TLUtils::do_postaction("remove", $tlp,
+        0, # option_file_assocs,
+        0, # option_desktop_integration, menu part
+        0, # option_desktop_integration, desktop part
+        $localtlpdb->option("post_code"));
+    }
+    # 
+    my @removals = &TeXLive::TLUtils::removed_dirs (@goodfiles);
+    # now do the removal
+    for my $entry (@goodfiles) {
+      unlink $entry;
+    }
+    for my $d (@removals) {
+      rmdir $d;
+    }
+    $localtlpdb->remove_tlpobj($pkg);
+    TeXLive::TLUtils::announce_execute_actions("disable", $tlp);
+    # should we save at each removal???
+    # advantage: the tlpdb actually reflects what is installed
+    # disadvantage: removing a collection calls the save routine several times
+    # still I consider it better that the tlpdb is in a consistent state
+    $localtlpdb->save;
+    #
+    # Run the post installation code in the postaction tlpsrc entries
+    # in case we are on w32 and the admin did install for himself only
+    # we switch off admin mode
+    if (win32() && admin() && !$localtlpdb->option("w32_multi_user")) {
+      non_admin();
+    }
+    #
+    # Run the post installation code in the postaction tlpsrc entries
+    # the postaction code part cannot be evaluated now since the
+    # files are already removed.
+    # Again, desktop integration maps to desktop and menu links
+    if (!$nopostinstall) {
+      &TeXLive::TLUtils::do_postaction("remove", $tlp,
+        $localtlpdb->option("file_assocs"),
+        $localtlpdb->option("desktop_integration"),
+        $localtlpdb->option("desktop_integration"),
+        0);
+    }
+  }
+  return 1;
+}
 
 
 =pod
@@ -1080,7 +1569,7 @@ sub _set_value_pkg {
     }
   }
   $pkg->depends(@newdeps);
-  $self->{'tlps'}{$pkgname} = $pkg;
+  $self->add_tlpobj($pkg);
 }
 
 sub _option_value {