summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rwxr-xr-xMaster/tlpkg/bin/tlprm228
1 files changed, 228 insertions, 0 deletions
diff --git a/Master/tlpkg/bin/tlprm b/Master/tlpkg/bin/tlprm
new file mode 100755
index 00000000000..57153c254f3
--- /dev/null
+++ b/Master/tlpkg/bin/tlprm
@@ -0,0 +1,228 @@
+#!/usr/bin/env perl
+# $Id$
+# Copyright 2007 Karl Berry.
+# This file is licensed under the GNU General Public License version 2
+# or any later version.
+#
+# Remove a package from the TeX Live source repository.
+# We use this when a package becomes obsolete, gets merged, or whatever.
+# It doesn't currently handle package removals from an installation.
+
+our $mydir;
+
+BEGIN {
+ $^W = 1;
+ ($mydir = $0) =~ s,/[^/]*$,,;
+ unshift (@INC, "$mydir/..");
+}
+
+use strict;
+
+use TeXLive::TLPDB;
+use TeXLive::TLPSRC;
+use Pod::Usage;
+use Getopt::Long;
+use Cwd 'abs_path';
+
+our $opt_debug = 0;
+my $opt_svn = 1;
+my $man = 0;
+my $help = 0;
+
+GetOptions("svn!",
+ "debug!", "help|?" => \$help, "man" => \$man) or pod2usage(2);
+
+pod2usage(1) if $help;
+pod2usage(-exitstatus => 0, -verbose => 2) if $man;
+
+exit (&main ());
+
+
+sub main
+{
+ my $failure_count = 0;
+
+ # xx should default in TLPDB.
+ chomp (my $Master = `cd $mydir/../.. && pwd`);
+ my $tlpdb = TeXLive::TLPDB->new (location => "$Master/texlive.tlpdb");
+
+ foreach my $f (@ARGV) {
+ my $obj = $tlpdb->get_package ($f);
+ if (! $obj) {
+ warn "$0: no TeX Live package named $f (in $Master/texlive.tlpdb).\n";
+ $failure_count++;
+ next;
+ }
+
+ my @files = $obj->all_files;
+ if ($opt_svn) {
+ my $tlpsrc = new TeXLive::TLPSRC;
+ $tlpsrc->from_file ($f);
+ push (@files, $tlpsrc->_srcfile); # also want to remove the tlpsrc file.
+
+ # The paths in tlpdb are relative to Master, so we chdir there so
+ # that Cwd::abs_path can work.
+ chdir ($Master) || die "chdir($Master) failed: $!";
+
+ # Commonly, we want to remove entire directories, not just all the
+ # files in the directory.
+ my @removals = &collapse_dirs (@files);
+ my $removals = join ("", map { "$_\n" } @removals);
+
+ my $TMPDIR = $ENV{"TMPDIR"} || "/tmp";
+ my $rm_file = "$TMPDIR/tlprm.rm";
+ unlink ($rm_file);
+ `printf "$removals" >$rm_file`;
+
+ my @lines = `grep -l 'depend.*/$f\$' $Master/tlpkg/tlpsrc/collection-*`;
+ my $commit_file = "$TMPDIR/tlprm.commit";
+ unlink ($commit_file);
+ `printf "$removals" >$commit_file`;
+ `printf "@lines" >>$commit_file`;
+
+ print "first edit collections:\n", @lines;
+ print "then svn remove `cat $rm_file`\n";
+ print "then svn commit -m'rm $f' `cat $commit_file`\n";
+
+ if (1) { # maybe only if debugging?
+ print "\nremovals ($rm_file):\n";
+ print `cat $rm_file`;
+ print "\ncommits ($commit_file):\n";
+ print `cat $commit_file`;
+ print "\nlist of files being removed:\n";
+ print "$_\n" foreach @files;
+ }
+
+ } else {
+ die "sorry, can only do svn removals now.";
+ # maybe later it will make sense to extend this for removals
+ # from an installation.
+ }
+ }
+
+ # Instead of rewriting the database here, I think we're better off
+ # just doing it nightly or whatever. For --svn purposes anyway.
+
+ return $failure_count;
+}
+
+
+# Return FILES, filtered with containing directories. That is, look at
+# the containing directories of each FILE. If every file within a given
+# dir is included in FILES, replace those files with the directory name
+# in the return list. Any files with sibling files not included are
+# retained.
+#
+# We do not try to check anything recursively. It doesn't buy us
+# anything, since what we will eventually be doing is running svn
+# commands to remove these dirs/files, and it's harmless to list subdirs.
+#
+sub collapse_dirs
+{
+ my (@files) = @_;
+ my @ret = ();
+ my %by_dir;
+
+ # construct hash of all directories mentioned, values are lists of the
+ # files in that directory.
+ for my $f (@files) {
+ my $abs_f = abs_path ($f);
+ die ("oops, no abs_path($f) from " . `pwd`) unless $abs_f;
+ (my $d = $abs_f) =~ s,/[^/]*$,,;
+ my @a = exists $by_dir{$d} ? @{$by_dir{$d}} : ();
+ push (@a, $abs_f);
+ $by_dir{$d} = \@a;
+ }
+
+ # for each of our directories, see if we are removing everything in
+ # the directory. if so, return the directory; else return the
+ # individual files.
+ for my $d (sort keys %by_dir) {
+ opendir (DIR, $d) || die "opendir($d) failed: $!";
+ my @dirents = readdir (DIR);
+ closedir (DIR) || warn "closedir($d) failed: $!";
+
+ # initialize test hash with all the files we saw in this dir.
+ # (These idioms are due to "Finding Elements in One Array and Not
+ # Another" in the Perl Cookbook.)
+ my %seen;
+ my @rmfiles = @{$by_dir{$d}};
+ @seen{@rmfiles} = ();
+
+ # see if everything is the same.
+ my @dironly = ();
+ for my $dirent (@dirents) {
+ next if $dirent =~ /^\.(\.|svn)?$/; # ignore . .. .svn
+
+ my $item = "$d/$dirent"; # prepend directory for comparison
+ if (! exists $seen{$item}) {
+ push (@dironly, $item);
+ last; # no need to keep looking after the first.
+ }
+ }
+
+ push (@ret, @dironly ? @{$by_dir{$d}} : $d);
+ }
+
+ return @ret;
+}
+
+__END__
+
+=head1 NAME
+
+tlprm - remove a TeX Live package
+
+=head1 SYNOPSIS
+
+tlprm [OPTION]... [TLPKG]...
+
+Set up to remove the specified TeX Live packages from the source repository.
+
+=head1 OPTIONS
+
+=over 8
+
+=item B<-svn>
+Print the Subversion commands that will do the actual removal. This is
+the default mode of operation.
+
+=item B<-help>
+Print brief help message and exit.
+
+=item B<-man>
+Print formatted manual page and exit.
+
+=item B<-debug>
+Give debug messages from the TeX Live modules.
+
+=back
+
+=head1 DESCRIPTION
+
+By default (or with the C<--svn> option), B<tlprm> merely prints
+commands to remove TeX Live packages from the source repository, e.g.,
+when a package becomes obsolete or merged. It does not actually run any
+commands, remove anything, or change the TeX Live package database or
+anything else.
+
+No dependency or other checking is done. It also does not remove the
+given package from any collection(s) where it is present.
+
+Perhaps someday this will be extended to remove a package from an actual
+installation.
+
+=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: #