update auto-backup feature to add --clean support

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

1 files changed, 155 insertions, 21 deletions

diff --git a/Master/tlpkg/etc/dev.auto-backup-feature.patch b/Master/tlpkg/etc/dev.auto-backup-feature.patch
index 3aa7e818545..aa01f1d1381 100644
--- a/Master/tlpkg/etc/dev.auto-backup-feature.patch
+++ b/Master/tlpkg/etc/dev.auto-backup-feature.patch
@@ -21,23 +21,37 @@ So if you want to set up automatic backups, do:
   tlmgr option backupdir /var/cache/texlive-backups/
   tlmgr option autobackup 5
 
+
+Cleaning mode:
+	tlmgr backup --clean[=ARG] [--backupdir=dir] [--all] [packs]
+
+if NO --clean is given, a backup is made.
+
+if --clean is given without any argument, then the value of "autobackup"
+in the tlpdb is used (should we change the name?)
+
+if --clean=ARG is given it must be either -1, 0, 1, ... with the following
+meaning:
+	-1:	do nothing, keep all backups (not very useful, but ...
+	N>=0	keep only N backups (that means for N == 0 all backups
+		will be removed)
+
+If --backupdir is NOT given we will try to initialize it from TLPDB 
+option "backupdir".
+
+
 TODO:
-. tlmgr backup clean
-  necessary? can be done by hand. But since the code is here ...
 . testing on windows
 . documentation in POD format
 . testing with .doc/.src args, and with .ARCH packages, no idea
   what is going on there
 
 ---
- texmf/scripts/texlive/tlmgr.pl |  141 ++++++++++++++++++++++++++++++++++++-----
- tlpkg/TeXLive/TLPDB.pm         |    9 ++
- 2 files changed, 136 insertions(+), 14 deletions(-)
 
-Index: Master/texmf/scripts/texlive/tlmgr.pl
+Index: texmf/scripts/texlive/tlmgr.pl
 ===================================================================
---- Master.orig/texmf/scripts/texlive/tlmgr.pl	2008-10-27 23:59:04.000000000 +0100
-+++ Master/texmf/scripts/texlive/tlmgr.pl	2008-10-27 23:59:10.000000000 +0100
+--- texmf/scripts/texlive/tlmgr.pl	(revision 11087)
++++ texmf/scripts/texlive/tlmgr.pl	(working copy)
 @@ -34,6 +34,16 @@
  #   - always do backups, let the user clean them up manually
  #   Possibly, an operation like 'tlmgr clean' for cleaning old backup could
@@ -64,7 +78,122 @@ Index: Master/texmf/scripts/texlive/tlmgr.pl
             "h|help|?" => \$opt_help) or pod2usage(2);
  
  my $action = shift;
-@@ -928,6 +938,7 @@
+@@ -731,14 +741,90 @@
+   my $opt_dry = 0;
+   my $opt_all = 0;
+   my $opt_backupdir;
++  # --clean argument
++  # can be either -1 ... don't clean
++  #               0  ... remove all backups
++  #               N  ... keep only N backups
++  # that parallels the value of autoclean in the configuration
++  # we have to be careful, because if simply --clean is given, we should
++  # check for the value saved in the tlpdb, and if that is not present
++  # do nothing. But Getopt::Long with clean:i leaves 0 in $opt_clean if
++  # it is present. So
++  # !defined($opt_clean)  -> no --clean given
++  # $opt_clean = ""       -> --clean without argument given, check tlpdb
++  # $opt_clean = -1, 0, N -> --clean=N given, check argument
++  #
++  my $opt_clean;
+   Getopt::Long::Configure(@getopt_configure_subopts);
+   GetOptions("all" => \$opt_all,
+              "backupdir=s" => \$opt_backupdir,
++             "clean:s" => \$opt_clean,
++             "n|dry-run"  => \$opt_dry,
+             ) or pod2usage(2);
++  my $clean_mode = 0;
++  $clean_mode = 1 if defined($opt_clean);
++  if ($clean_mode) {
++    if ($opt_clean eq "") {
++      # we need to check the tlpdb
++      $opt_clean = $localtlpdb->option("autobackup");
++      if (!$opt_clean) {
++        tlwarn ("--clean given without an argument, but no default clean\n");
++        tlwarn ("mode specified in the tlpdb, terminating.\n");
++        exit 1;
++      }
++    }
++    # now $opt_clean is something, but maybe not a number, check for
++    # validity
++    if ($opt_clean =~ m/^(-1|[0-9]+)$/) {
++      # get rid of leading zeros etc etc
++      $opt_clean = $opt_clean + 0;
++    } else {
++      tlwarn ("clean mode as specified on the command line or as given by default\n");
++      tlwarn ("must be an integer larger or equal than -1, terminating.\n");
++      exit 1;
++    }
++  }
++  # check the backup dir argument
++  my $die_backupdir = 0;
++  if ($opt_backupdir) {
++    my $ob = abs_path($opt_backupdir);
++    $ob && ($opt_backupdir = $ob);
++    if (! -d $opt_backupdir) {
++      tlwarn ("backupdir argument $opt_backupdir is not a directory.\n");
++      if ($clean_mode) {
++        tlwarn ("Cannot clean a non existing directory, terminating.\n");
++      } else {
++        tlwarn ("Don't know where to save backups, terminating.\n");
++      }
++      exit 1;
++    }
++  } else {
++    # no argument, check for presence in TLPDB
++    $opt_backupdir = $localtlpdb->option("backupdir");
++    if (!$opt_backupdir) {
++      if ($clean_mode) {
++        tlwarn ("Cannot clean an unknown directory, terminating.\n");
++      } else {
++        tlwarn ("Don't know where to save backups, terminating.\n");
++      }
++      exit 1;
++    }
++    # we are stil here, there is something set in tlpdb
++    my $ob = abs_path($opt_backupdir);
++    $ob && ($opt_backupdir = $ob);
++    if (! -d $opt_backupdir) {
++      tlwarn ("backupdir as set in tlpdb $opt_backupdir is not a directory.\n");
++      if ($clean_mode) {
++        tlwarn ("Cannot clean a non existing directory, terminating.\n");
++      } else {
++        tlwarn ("Don't know where to save backups, terminating.\n");
++      }
++      exit 1;
++    }
++  }
++
+   my %ret;
+   my @todo;
+-  die ("tlmgr backup needs an obligatory argument --backupdir") 
+-    unless (defined($opt_backupdir));
+   if ($opt_all) {
+     @todo = $localtlpdb->list_packages;
+   } else {
+@@ -748,13 +834,16 @@
+     printf "tlmgr backup takes either a list of packages or --all\n";
+   }
+   foreach my $pkg (@todo) {
+-    $opt_backupdir = abs_path($opt_backupdir);
+-    if (! -d $opt_backupdir) {
+-      printf STDERR "backupdir argument must be an existing directory!\n";
++    if ($clean_mode) {
++      clear_old_backups ($pkg, $opt_backupdir, $opt_clean, $opt_dry);
+     } else {
+       my $tlp = $localtlpdb->get_package($pkg);
+-      $tlp->make_container("lzma", $localtlpdb->root, 
+-                           $opt_backupdir, "${pkg}.r" . $tlp->revision);
++      info("saving current status of $pkg to $opt_backupdir${pkg}.r" . 
++        $tlp->revision . ".\n");
++      if (!$opt_dry) {
++        $tlp->make_container("lzma", $localtlpdb->root, 
++                             $opt_backupdir, "${pkg}.r" . $tlp->revision);
++      }
+     }
+   }
+   return(\%ret);
+@@ -928,6 +1017,7 @@
    my $opt_list = 0;
    my $opt_noremove = 0;
    my $opt_backupdir;
@@ -72,7 +201,7 @@ Index: Master/texmf/scripts/texlive/tlmgr.pl
    Getopt::Long::Configure(@getopt_configure_subopts);
    GetOptions("no-depends"        => \$opt_nodepends,
               "no-depends-at-all" => \$opt_reallynodepends,
-@@ -935,6 +946,7 @@
+@@ -935,6 +1025,7 @@
               "list"              => \$opt_list,
               "no-remove"         => \$opt_noremove,
               "backupdir=s"       => \$opt_backupdir,
@@ -80,7 +209,7 @@ Index: Master/texmf/scripts/texlive/tlmgr.pl
               "n|dry-run"         => \$opt_dry) or pod2usage(2);
    $opt_nodepends = 1 if $opt_reallynodepends;
    my $nrupdated = 0;
-@@ -944,6 +956,70 @@
+@@ -944,6 +1035,70 @@
    my $mediatlpdb = $tlmediasrc->tlpdb;
    info("update: dry run, no changes will be made\n") if $opt_dry;
  
@@ -151,7 +280,7 @@ Index: Master/texmf/scripts/texlive/tlmgr.pl
    # these two variables are used throughout this function
    my $root = $localtlpdb->root;
    my $temp = "$root/temp";
-@@ -1122,19 +1198,18 @@
+@@ -1122,19 +1277,18 @@
        if ($opt_list) {
          info("$pkg: local: $rev, source: $mediarev\n");
        } else {
@@ -181,7 +310,7 @@ Index: Master/texmf/scripts/texlive/tlmgr.pl
          if (win32() && ($pkg =~ m/$WinSpecialUpdatePackagesRegexp/)) {
            add_w32_updater($mediatlp, $opt_dry);
          } else {
-@@ -1161,6 +1236,10 @@
+@@ -1161,6 +1315,10 @@
              $remove_unwind_container = 1;
              $unwind_package = "$fullname";
            }
@@ -192,7 +321,7 @@ Index: Master/texmf/scripts/texlive/tlmgr.pl
            # the remove_package should also remove empty dirs in case
            # a dir is changed into a file
            merge_into(\%ret, &remove_package($pkg, $localtlpdb, 1));
-@@ -1176,7 +1255,7 @@
+@@ -1176,7 +1334,7 @@
              # dirs from the new package before re-installing the old one.
              # TODO
              logpackage("failed update: $pkg ($rev -> $mediarev)");
@@ -201,7 +330,7 @@ Index: Master/texmf/scripts/texlive/tlmgr.pl
              if (win32()) {
                # w32 is notorious for not releasing a file immediately
                # we experienced permission denied errors 
-@@ -1402,7 +1481,15 @@
+@@ -1402,7 +1560,15 @@
      print "Install documentation files:    ", ($localtlpdb->option_install_docfiles ? "yes": "no"), "\n";
      print "Install source files:           ", ($localtlpdb->option_install_srcfiles ? "yes": "no"), "\n";
    } else {
@@ -218,14 +347,18 @@ Index: Master/texmf/scripts/texlive/tlmgr.pl
    }
    return;
  }
-@@ -1961,6 +2048,32 @@
+@@ -1961,6 +2127,37 @@
  }
  
  
 +# clear the backup dir for $pkg and keep only $autobackup packages
++# mind that with $autobackup == 0 all packages are cleared
 +sub clear_old_backups
 +{
-+  my ($pkg, $opt_backupdir, $autobackup) = @_;
++  my ($pkg, $opt_backupdir, $autobackup, $opt_dry) = @_;
++
++  my $dryrun = 0;
++  $dryrun = 1 if ($opt_dry);
 +  # keep arbitrary many backups
 +  return if ($autobackup == -1);
 + 
@@ -241,7 +374,8 @@ Index: Master/texmf/scripts/texlive/tlmgr.pl
 +  my $i = 1;
 +  for my $e (reverse sort {$a <=> $b} @backups) {
 +    if ($i > $autobackup) {
-+      unlink("$opt_backupdir/$pkg.r$e.tar.lzma");
++      info ("Removing backup $opt_backupdir/$pkg.r$e.tar.lzma\n");
++      unlink("$opt_backupdir/$pkg.r$e.tar.lzma") unless $dryrun;
 +    }
 +    $i++;
 +  }
@@ -251,10 +385,10 @@ Index: Master/texmf/scripts/texlive/tlmgr.pl
  #
  # return all the directories from which all content will be removed
  #
-Index: Master/tlpkg/TeXLive/TLPDB.pm
+Index: tlpkg/TeXLive/TLPDB.pm
 ===================================================================
---- Master.orig/tlpkg/TeXLive/TLPDB.pm	2008-10-27 23:58:53.000000000 +0100
-+++ Master/tlpkg/TeXLive/TLPDB.pm	2008-10-27 23:59:10.000000000 +0100
+--- tlpkg/TeXLive/TLPDB.pm	(revision 11087)
++++ tlpkg/TeXLive/TLPDB.pm	(working copy)
 @@ -49,6 +49,7 @@
    $tlpdb->config_container_format;
    $tlpdb->config_release;