From 497231b3bede9c08461f6718c6e030db5f4e1e79 Mon Sep 17 00:00:00 2001
From: Norbert Preining <preining@logic.at>
Date: Mon, 18 Oct 2010 04:12:18 +0000
Subject: show creating time of backups in tlmgr restore

git-svn-id: svn://tug.org/texlive/trunk@20136 c570f23f-e606-0410-a88d-b1316a301751
---
 Master/texmf/scripts/texlive/tlmgr.pl | 76 +++++++++++++++++++++++++++++++----
 1 file changed, 68 insertions(+), 8 deletions(-)

(limited to 'Master/texmf/scripts')

diff --git a/Master/texmf/scripts/texlive/tlmgr.pl b/Master/texmf/scripts/texlive/tlmgr.pl
index 3b1995940c1..7a8411dced5 100755
--- a/Master/texmf/scripts/texlive/tlmgr.pl
+++ b/Master/texmf/scripts/texlive/tlmgr.pl
@@ -1181,16 +1181,48 @@ sub action_search {
 # for restore
 sub get_available_backups {
   my $bd = shift;
+  my $do_stat = shift;
   # initialize the hash(packages) of hash(revisions)
   my %backups;
   opendir (DIR, $bd) || die "opendir($bd) failed: $!";
   my @dirents = readdir (DIR);
   closedir (DIR) || warn "closedir($bd) failed: $!";
+  #
+  # see below for explanation, this has effects only on W32
+  my $oldwsloppy = ${^WIN32_SLOPPY_STAT};
+  ${^WIN32_SLOPPY_STAT} = 1;
+  #
   for my $dirent (@dirents) {
     next if (-d $dirent);
     next if ($dirent !~ m/^(.*)\.r([0-9]+)\.tar\.xz$/);
-    $backups{$1}->{$2} = 1;
+    if (!$do_stat) {
+      print "not doing stats!\n";
+      $backups{$1}->{$2} = 1;
+      next;
+    }
+    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
+      $atime,$mtime,$ctime,$blksize,$blocks) = stat("$bd/$dirent");
+    # times: as we want to be portable we try the following times:
+    # - first choice is ctime which hopefully works nicely
+    # - on UFS (OSX) ctime is not supported, so use mtime
+    # furthermore, if we are on W32 we want to be fast and make only
+    # a sloppy stat
+    # for more on that please see man perlport
+    my $usedt = $ctime;
+    if (!$usedt) {
+      # can happen on 
+      $usedt = $mtime;
+    }
+    if (!$usedt) {
+      # stat failed, set key to -1 as a sign that there is a backup
+      # but we cannot stat it
+      $backups{$1}->{$2} = -1;
+    } else {
+      $backups{$1}->{$2} = $usedt;
+    }
   }
+  # reset the original value of the win32 sloppy mode for stating files
+  ${^WIN32_SLOPPY_STAT} = $oldwsloppy;
   return %backups;
 }
 
@@ -1268,8 +1300,8 @@ sub action_restore {
   }
   info("restore: dry run, no changes will be made\n") if $opts{"dry"};
 
-  # initialize the hash(packages) of hash(revisions)
-  my %backups = get_available_backups($opts{"backupdir"});
+  # initialize the hash(packages) of hash(revisions), do stat files! (the 1)
+  my %backups = get_available_backups($opts{"backupdir"}, 1);
   my ($pkg, $rev) = @ARGV;
   if (defined($pkg) && $opts{"all"}) {
     tlwarn("Do you want to restore all packages or only $pkg?\n");
@@ -1300,13 +1332,37 @@ sub action_restore {
     # localtlpdb already saved, so we are finished
     return;
   }
+  #
+  # intermediate sub
+  sub report_backup_revdate {
+    my $p = shift;
+    my %revs = @_;
+    my @rs = sort {$b <=> $a} (keys %revs);
+    for my $rs (@rs) {
+      my @rs = sort {$b <=> $a} (keys %revs);
+      for my $rs (@rs) {
+        my $dstr;
+        if ($revs{$rs} == -1) {
+          $dstr = "unknown";
+        } else {
+          my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
+            localtime($revs{$rs});
+          # localtime returns dates starting from 1900, and the month is 0..11
+          $dstr = sprintf "%04d-%02d-%02d, %02d:%02d", 
+            $year+1900, $mon+1, $mday, $hour, $min;
+        }
+        print "$rs ($dstr) ";
+      }
+    }
+  }
+  # end sub
   if (!defined($pkg)) {
     if (keys %backups) {
       print "Available backups:\n";
       foreach my $p (sort keys %backups) {
         print "$p: ";
-        my @rs = sort {$b <=> $a} (keys %{$backups{$p}});
-        print "@rs\n";
+        report_backup_revdate($p, %{$backups{$p}});
+        print "\n";
       }
     } else {
       print "No backups available in $opts{'backupdir'}\n";
@@ -1315,8 +1371,8 @@ sub action_restore {
   }
   if (!defined($rev)) {
     print "Available backups for $pkg: ";
-    my @rs = sort (keys %{$backups{$pkg}});
-    print "@rs\n";
+    report_backup_revdate($pkg, %{$backups{$pkg}});
+    print "\n";
     finish(0);
   }
   # we did arrive here, so we try to restore ...
@@ -1398,7 +1454,8 @@ sub action_backup {
   # to determine backups
   if ($opts{"all"} && $clean_mode) {
     # initialize the hash(packages) of hash(revisions)
-    my %backups = get_available_backups($opts{"backupdir"});
+    # no need to stat the files
+    my %backups = get_available_backups($opts{"backupdir"}, 0);
     init_local_db(1);
     for my $p (sort keys %backups) {
       clear_old_backups ($p, $opts{"backupdir"}, $opts{"clean"}, $opts{"dry-run"});
@@ -5075,6 +5132,9 @@ revisions for all packages.
 With I<pkg> given but no I<rev>, list all available backup revisions of
 I<pkg>.
 
+When listing available packages tlmgr shows the revision and in 
+parenthesis the creation time if available (in format yyyy-mm-dd, hh:mm).
+
 With both I<pkg> and I<rev>, tries to restore the package from the
 specified backup.
 
-- 
cgit v1.2.3