add size computation code to TLPDB, and use it in tlmgr2 to show the

total size and the size of each package in $::machinereadable


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

1 files changed, 73 insertions, 4 deletions

diff --git a/Master/tlpkg/TeXLive/TLPDB.pm b/Master/tlpkg/TeXLive/TLPDB.pm
index 122a53f161a..b65eef1d5e7 100644
--- a/Master/tlpkg/TeXLive/TLPDB.pm
+++ b/Master/tlpkg/TeXLive/TLPDB.pm
@@ -52,6 +52,7 @@ C<TeXLive::TLPDB> -- A database of TeX Live Packages
   $tlpdb->option($key, [$value]);
   $tlpdb->add_symlinks();
   $tlpdb->remove_symlinks();
+  $tlpdb->sizes_of_packages($opt_src, $opt_doc [, @packs ]);
 
   TeXLive::TLPDB->listdir([$dir]);
   $tlpdb->generate_listfiles([$destdir]);
@@ -61,11 +62,13 @@ C<TeXLive::TLPDB> -- A database of TeX Live Packages
 =cut
 
 use TeXLive::TLConfig qw($CategoriesRegexp $DefaultCategory $InfraLocation
-      $DatabaseName $MetaCategoriesRegexp);
+      $DatabaseName $MetaCategoriesRegexp $Archive);
 use TeXLive::TLUtils qw(dirname mkdirhier member win32 info debug ddebug
                         tlwarn);
 use TeXLive::TLPOBJ;
 
+use Cwd 'abs_path';
+
 my $_listdir;
 
 =pod
@@ -359,7 +362,6 @@ adds new dependencies they are not necessarily fulfilled.
 sub add_tlpcontainer {
   my ($self, $package, $ziplocation, $archrefs, $dest) = @_;
   my @archs;
-  require Cwd;
   if (defined($archrefs)) {
     @archs = @$archrefs;
   }
@@ -379,7 +381,6 @@ sub _add_tlpcontainer {
   my ($self, $package, $ziplocation, $arch, $dest) = @_;
   my $unpackprog;
   my $args;
-  require Cwd;
   # WARNING: If you change the location of the texlive.tlpdb this
   # has to be changed, too!!
   if (not(defined($dest))) { 
@@ -1101,7 +1102,75 @@ sub remove_symlinks {
 
 =pod
 
-=item C<< $tlpdb->option_XXXXX >>
+=item C<< $tlpdb->sizes_of_packages ( $opt_src, $opt_doc, [ @packs ] ) >>
+
+This function returns a reference to a hash with package names as keys
+and the sizes in bytes as values. The sizes are computed for the arguments,
+or all packages if nothing was given.
+
+In case something has been computed one addition key is added C<__TOTAL__>
+which contains the total size of all packages under discussion.
+
+=cut
+
+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 = 'CD';
+    } elsif (-d "$root/texmf/web2c") {
+      $media = 'DVD';
+    } else {
+      die "$0: that should not happen, no proper location found!";
+    }
+  }
+  my %tlpsizes;
+  my %tlpobjs;
+  my $totalsize;
+  foreach my $p (@packs) {
+    $tlpobjs{$p} = $self->get_package($p);
+    if (!defined($tlpobjs{$p})) {
+      warn "STRANGE: $p not to be found in ", $self->root;
+      next;
+    }
+    if ($media ne 'DVD') {
+      # 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}->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;
+    }
+    $totalsize += $tlpsizes{$p};
+  }
+  if ($totalsize) {
+    $tlpsizes{'__TOTAL__'} = $totalsize;
+  }
+  return \%tlpsizes;
+}
+
+
+
+
+=pod
+
+=item C<< $tlpdb->option_XXXXX >ize += $tlpsizes{$p};
+
 
 Need to be documented