tlpsizes: new utility script to examine collection/scheme/package sizes; doc tweaks in TLPDB.pm

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

2 files changed, 170 insertions, 18 deletions

diff --git a/Master/tlpkg/TeXLive/TLPDB.pm b/Master/tlpkg/TeXLive/TLPDB.pm
index 29a4f8bf9ed..0eeee548afc 100644
--- a/Master/tlpkg/TeXLive/TLPDB.pm
+++ b/Master/tlpkg/TeXLive/TLPDB.pm
@@ -697,22 +697,25 @@ sub _list_packages {
 =item C<< $tlpdb->expand_dependencies(["control",] $tlpdb, ($pkgs)) >>
 
 If the first argument is the string C<"-only-arch">, expands only
-dependencies of the form .ARCH.
+dependencies of the form C<.>I<ARCH>.
 
 If the first argument is C<"-no-collections">, then dependencies between
 "same-level" packages (scheme onto scheme, collection onto collection,
 package onto package) are ignored.
 
+C<-only-arch> and C<-no-collections> cannot be specified together; has
+to be one or the other.
+
 The next (or first) argument is the target TLPDB, then a list of
 packages.
 
-In the virtual case,
-if a package name is tagged with C<@repository-tag> then all the
-dependencies will still be expanded between all included databases.
-Only in case of .ARCH dependencies the repository-tag is sticky.
+In the virtual case, if a package name is tagged with C<@repository-tag>
+then all the dependencies will still be expanded between all included
+databases.  Only in case of C<.>I<ARCH> dependencies the repository-tag
+is sticky.
 
-We return the closure of the package list with respect to the depends
-operator. (Sorry, that was for mathematicians.)
+We return a list of package names, the closure of the package list with
+respect to the depends operator. (Sorry, that was for mathematicians.)
 
 =cut
 
@@ -825,7 +828,7 @@ sub find_file {
 
 =item C<< $tlpdb->collections >>
 
-The C<collections> function returns the list of all collections.
+The C<collections> function returns a list of all collection names.
 
 =cut
 
@@ -844,7 +847,7 @@ sub collections {
 
 =item C<< $tlpdb->schemes >>
 
-The C<collections> function returns the list of all schemes.
+The C<schemes> function returns a list of all scheme names.
 
 =cut
 
@@ -1009,8 +1012,8 @@ sub _generate_listfile {
   # dependencies and inclusion of packages
   foreach my $t (@lot) {
     # strange, schemes mark included collections via -, while collections
-    # themself mark deps on other collections with +. collection are
-    # never referenced in Packages
+    # themselves mark deps on other collections with +. collections are
+    # never referenced in Packages.
     if ($listname =~ m/^scheme/) {
       print TMP "-";
     } else {
@@ -1273,15 +1276,17 @@ sub config_revision {
 =item C<< $tlpdb->sizes_of_packages ( $opt_src, $opt_doc, $ref_arch_list, [ @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.
+and the sizes in bytes as values. The sizes are computed for the list of
+package names given as the fourth argument, or all packages if not
+specified.
 
-In case something has been computed one addition key is added C<__TOTAL__>
-which contains the total size of all packages under discussion.
+If anything has been computed one additional key is synthesized,
+C<__TOTAL__>, which contains the total size of all packages under
+consideration.
 
 If the third argument is a reference to a list of architectures, then
 only the sizes for the binary packages for these architectures are used,
-otherwise all sizes for all architectures are summed up.
+otherwise all sizes for all architectures are summed.
 
 =cut
 
@@ -1304,7 +1309,8 @@ sub sizes_of_packages {
       warn "STRANGE: $p not to be found in ", $self->root;
       next;
     }
-    $tlpsizes{$p} = $self->size_of_one_package($media, $tlpobjs{$p}, $opt_src, $opt_doc, @archs);
+    $tlpsizes{$p} = $self->size_of_one_package($media, $tlpobjs{$p},
+                                               $opt_src, $opt_doc, @archs);
     $totalsize += $tlpsizes{$p};
   }
   if ($totalsize) {
@@ -1334,7 +1340,7 @@ sub size_of_one_package {
         $size += $foo{$k};
       }
     }
-    # all the packages sizes are in blocks, so transfer that to bytes
+    # packages sizes are stored in blocks; transform that to bytes.
     $size *= $TeXLive::TLConfig::BlockSize;
   }
   return $size;
diff --git a/Master/tlpkg/bin/tlpsizes b/Master/tlpkg/bin/tlpsizes
new file mode 100755
index 00000000000..1ee7f83a8ae
--- /dev/null
+++ b/Master/tlpkg/bin/tlpsizes
@@ -0,0 +1,146 @@
+#!/usr/bin/env perl
+# $Id: tlpfiles 14621 2009-08-12 00:49:01Z karl $
+# Copyright 2013 Karl Berry.
+# This file is licensed under the GNU General Public License version 2
+# or any later version.
+# 
+# Return sizes for TL schemes, collections, and/or packages.
+
+our $mydir;
+
+BEGIN {
+  $^W = 1;
+  ($mydir = $0) =~ s,/[^/]*$,,;
+  unshift (@INC, "$mydir/..");
+}
+
+use strict;
+
+use TeXLive::TLPDB;
+use Pod::Usage;
+use Getopt::Long;
+
+my $opt_schemes = 0;
+my $opt_help = 0;
+
+TeXLive::TLUtils::process_logging_options ();
+GetOptions ("schemes!" => \$opt_schemes,
+            "help|?" => \$opt_help) or pod2usage (2);
+pod2usage ("-exitstatus" => 0, "-verbose" => 2) if $opt_help;
+
+exit (&main ());
+
+
+sub main {
+  chomp (my $Master = `cd $mydir/../.. && pwd`);
+    
+  my $tlpdb = TeXLive::TLPDB->new ("root" => $Master);
+  die "no tlpdb in $Master, goodbye" if ! $tlpdb;
+  
+  if (@ARGV) {
+    warn "$0: -schemes ignored, since explicit names given (@ARGV).\n"
+      if $opt_schemes;
+  } else {
+    # default to reporting on collections.
+    @ARGV = $opt_schemes ? $tlpdb->schemes : $tlpdb->collections; 
+  }
+  
+  my (%c_size, %c_pkgs);
+  my $longest_name = 0;
+  for my $name (@ARGV) {
+    # we want to get only the packages in the collection,
+    # not include other collections; hence -no-collections.
+    my @pkgs = $tlpdb->expand_dependencies ("-no-collections", $tlpdb, $name);
+ 
+    # get sizes of those packages.
+    # args say: include src, include doc, (no) platforms, just our pkgs.
+    my $pkg_sizes = $tlpdb->sizes_of_packages (1, 1, undef, @pkgs);
+
+    $c_size{$name} = $pkg_sizes->{__TOTAL__};
+    delete $pkg_sizes->{"__TOTAL__"};  # don't need that any more
+    delete $pkg_sizes->{$name};        # always includes itself, with zero size    
+
+    $c_pkgs{$name} = &pkgs_by_size (%$pkg_sizes);
+    
+    $longest_name = length ($name)  if length ($name) > $longest_name;
+  }
+  
+  for my $c (sort { $c_size{$b} <=> $c_size{$a} }
+                  keys %c_size) {
+    printf "%4d %-${longest_name}s %s\n",
+           $c_size{$c}/1024/1024, $c, $c_pkgs{$c};
+  }
+  
+  return 0;
+}
+
+
+# Return nicely-formatted single-string representation of packages and
+# their sizes (in kb), as comprised in PKG_SIZES, sorted biggest first.
+# 
+sub pkgs_by_size {
+  my (%pkg_sizes) = @_;
+  my $ret ="";
+  
+  for my $p (sort { $pkg_sizes{$b} <=> $pkg_sizes{$a} } 
+                  keys %pkg_sizes) {
+    $ret .= " ";
+    $ret .= $pkg_sizes{$p} / 1024;
+    $ret .= "/$p";
+  }
+  
+  return $ret;
+}
+
+__END__
+
+=head1 NAME
+
+tlpsizes - list sizes of TeX Live schemes, collections, or packages
+
+=head1 SYNOPSIS
+
+  tlpsizes [I<option>]... [I<tlpkg>]...
+
+=head1 OPTIONS
+
+=over 4
+
+=item B<-schemes>
+
+Report on all schemes if no I<tlpkg> is given.
+
+=item B<-help>
+
+Print this documentation and exit.
+
+=back
+
+The standard options B<-q>, B<-v>, and B<-logfile>=I<file> are also
+accepted; see the C<process_logging_options> function in
+L<TeXLive::TLUtils> for details.
+
+=head1 DESCRIPTION
+
+Print the size of each I<tlpkg>, in megabytes, largest first.  If no
+names are specified on the command line, list sizes of either all
+collections, or, if C<-schemes> is specified, all schemes.
+
+For collections and schemes, also output (on the same line) the
+constituent packages and their sizes (also largest first), in kilobytes
+this time.
+
+=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: #