diff options
| -rwxr-xr-x | Master/tlpkg/bin/tlprm | 228 |
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: # |