From d7ddb257c9d22c794d6b26af64a57901ccee71e0 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Fri, 27 Sep 2013 01:17:01 +0200
Subject: guix package: '--delete-generations' deletes generations older than
 specified.

* guix/scripts/package.scm (matching-generations): Add
  'duration-relation' keyword parameter.
  (guix-package)[process-action](delete-generations): Pass
  #:duration-relation >.
* tests/guix-package.sh: Add test.
* doc/guix.texi (Invoking guix package): Clarify the meaning of
  durations for '--list-durations' and '--delete-durations'.
---
 doc/guix.texi            | 18 ++++++++++++------
 guix/scripts/package.scm | 15 +++++++++++----
 tests/guix-package.sh    |  7 +++++++
 3 files changed, 30 insertions(+), 10 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 2e6bdc595e..29928c5af4 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -711,18 +711,24 @@ second one.
 
 @item @emph{Durations}.  You can also get the last @emph{N}@tie{}days, weeks,
 or months by passing an integer along with the first letter of the
-duration, e.g., @code{--list-generations=20d}.
+duration.  For example, @code{--list-generations=20d} lists generations
+that are up to 20 days old.
 @end itemize
 
 @item --delete-generations[=@var{pattern}]
 @itemx -d [@var{pattern}]
-Delete all generations except the current one.  Note that the zeroth
-generation is never deleted.
+When @var{pattern} is omitted, delete all generations except the current
+one.
 
 This command accepts the same patterns as @option{--list-generations}.
-When @var{pattern} is specified, delete the matching generations.  If
-the current generation matches, it is deleted atomically, i.e., by
-switching to the previous available generation.
+When @var{pattern} is specified, delete the matching generations.  When
+@var{pattern} specifies a duration, generations @emph{older} than the
+specified duration match.  For instance, @code{--delete-generations=1m}
+deletes generations that are more than one month old.
+
+If the current generation matches, it is deleted atomically---i.e., by
+switching to the previous available generation.  Note that the zeroth
+generation is never deleted.
 
 @end table
 
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 35a5129d25..5c7c165cbb 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -258,9 +258,12 @@ (define (generation-time profile number)
   (make-time time-utc 0
              (stat:ctime (stat (format #f "~a-~a-link" profile number)))))
 
-(define* (matching-generations str #:optional (profile %current-profile))
+(define* (matching-generations str #:optional (profile %current-profile)
+                               #:key (duration-relation <=))
   "Return the list of available generations matching a pattern in STR.  See
-'string->generations' and 'string->duration' for the list of valid patterns."
+'string->generations' and 'string->duration' for the list of valid patterns.
+When STR is a duration pattern, return all the generations whose ctime has
+DURATION-RELATION with the current time."
   (define (valid-generations lst)
     (define (valid-generation? n)
       (any (cut = n <>) (generation-numbers profile)))
@@ -309,7 +312,7 @@ (define generation-ctime-alist
                  (subtract-duration (time-at-midnight (current-time))
                                     duration))))
          (delete #f (map (lambda (x)
-                           (and (<= s (cdr x))
+                           (and (duration-relation s (cdr x))
                                 (first x)))
                          generation-ctime-alist))))))
 
@@ -887,7 +890,11 @@ (define (delete-generation number)
                     ;; Do not delete the zeroth generation.
                     ((equal? 0 (string->number pattern))
                      (exit 0))
-                    ((matching-generations pattern profile)
+
+                    ;; If PATTERN is a duration, match generations that are
+                    ;; older than the specified duration.
+                    ((matching-generations pattern profile
+                                           #:duration-relation >)
                      =>
                      (lambda (numbers)
                        (if (null-list? numbers)
diff --git a/tests/guix-package.sh b/tests/guix-package.sh
index 80301f63cc..9116f352c9 100644
--- a/tests/guix-package.sh
+++ b/tests/guix-package.sh
@@ -168,6 +168,13 @@ then false; else true; fi
 # Check whether `--list-available' returns something sensible.
 guix package -p "$profile" -A 'gui.*e' | grep guile
 
+# There's no generation older than 12 months, so the following command should
+# have no effect.
+generation="`readlink_base "$profile"`"
+if guix package -p "$profile" --delete-generations=12m;
+then false; else true; fi
+test "`readlink_base "$profile"`" = "$generation"
+
 #
 # Try with the default profile.
 #
-- 
cgit v1.2.3