guix-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

01/06: squash! Move things around.


From: guix-commits
Subject: 01/06: squash! Move things around.
Date: Wed, 7 Jun 2023 17:46:13 -0400 (EDT)

civodul pushed a commit to branch wip-guix-index
in repository guix.

commit 4202400d70d40f5c14efb40033bd0c3ce4fe69a8
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Wed Jun 7 12:54:15 2023 +0200

    squash! Move things around.
---
 guix/scripts/locate.scm | 114 +++++++++++++++++++++++++-----------------------
 1 file changed, 60 insertions(+), 54 deletions(-)

diff --git a/guix/scripts/locate.scm b/guix/scripts/locate.scm
index 548bd507e0..85c3c5e24b 100644
--- a/guix/scripts/locate.scm
+++ b/guix/scripts/locate.scm
@@ -184,6 +184,38 @@ SELECT version FROM SchemaVersion ORDER BY version DESC 
LIMIT 1;"
     ((#(version))
      version)))
 
+(define user-database-file
+  ;; Default user database file name.
+  (string-append (cache-directory #:ensure? #f)
+                 "/index/db.sqlite"))
+
+(define system-database-file
+  ;; System-wide database file name.
+  (string-append %localstatedir "/cache/guix/index/db.sqlite"))
+
+(define (suitable-database create?)
+  "Return a suitable database file.  When CREATE? is true, the returned
+database will be opened for writing; otherwise, return the most recent one,
+user or system."
+  (if (zero? (getuid))
+      system-database-file
+      (if create?
+          user-database-file
+          (let ((system (stat system-database-file #f))
+                (user   (stat user-database-file #f)))
+            (if user
+                (if (and system (> (stat:mtime system) (stat:mtime user)))
+                    system-database-file
+                    user-database-file)
+                (if system
+                    system-database-file
+                    user-database-file))))))
+
+
+;;;
+;;; Indexing from local packages.
+;;;
+
 (define (insert-files db package version outputs directories)
   "Insert DIRECTORIES files belonging to VERSION PACKAGE (with OUTPUTS)."
   (define stmt-select-package
@@ -266,11 +298,6 @@ VALUES (:name, :basename, :directory);"
                directories)))
   (sqlite-exec db "commit;"))
 
-
-;;;
-;;; Indexing from local packages.
-;;;
-
 (define (insert-package db package)
   "Insert all the files of PACKAGE into DB."
   (define stmt-select-package-output
@@ -315,6 +342,24 @@ for each package to insert."
                     (report))
                   packages)))))
 
+(define (index-packages-from-store-with-db file)
+  "Index local store packages using db at location FILE."
+  (call-with-database file
+    (lambda (db)
+      (with-store store
+        (parameterize ((%graft? #f))
+          (define (insert-package-from-store db package)
+            (run-with-store store (insert-package db package)))
+          (let ((packages (fold-packages
+                           cons
+                           '()
+                           #:select? (lambda (package)
+                                       (and (not (hidden-package? package))
+                                            (not (package-superseded package))
+                                            (supported-package? package))))))
+            (insert-packages-with-progress
+             db packages insert-package-from-store)))))))
+
 
 ;;;
 ;;; Indexing from local profiles.
@@ -369,6 +414,7 @@ for each package to insert."
       (let ((entries (profiles->manifest-entries (all-profiles))))
         (insert-packages-with-progress db entries insert-manifest-entry)))))
 
+
 
 ;;;
 ;;; Search.
@@ -409,29 +455,6 @@ ON f.basename = :file
                           lst))))
                '() lookup-stmt))
 
-
-;;;
-;;; Entry point.
-;;;
-
-(define (index-packages-from-store-with-db file)
-  "Index local store packages using db at location FILE."
-  (call-with-database file
-    (lambda (db)
-      (with-store store
-        (parameterize ((%graft? #f))
-          (define (insert-package-from-store db package)
-            (run-with-store store (insert-package db package)))
-          (let ((packages (fold-packages
-                           cons
-                           '()
-                           #:select? (lambda (package)
-                                       (and (not (hidden-package? package))
-                                            (not (package-superseded package))
-                                            (supported-package? package))))))
-            (insert-packages-with-progress
-             db packages insert-package-from-store)))))))
-
 (define (matching-packages-with-db db-file file)
   "Compute list of packages referencing FILE using the database at DB-FILE."
   (call-with-database db-file
@@ -452,32 +475,10 @@ ON f.basename = :file
                         file)))
             matches))
 
-(define user-database-file
-  ;; Default user database file name.
-  (string-append (cache-directory #:ensure? #f)
-                 "/index/db.sqlite"))
-
-(define system-database-file
-  ;; System-wide database file name.
-  (string-append %localstatedir "/cache/guix/index/db.sqlite"))
-
-(define (suitable-database create?)
-  "Return a suitable database file.  When CREATE? is true, the returned
-database will be opened for writing; otherwise, return the most recent one,
-user or system."
-  (if (zero? (getuid))
-      system-database-file
-      (if create?
-          user-database-file
-          (let ((system (stat system-database-file #f))
-                (user   (stat user-database-file #f)))
-            (if user
-                (if (and system (> (stat:mtime system) (stat:mtime user)))
-                    system-database-file
-                    user-database-file)
-                (if system
-                    system-database-file
-                    user-database-file))))))
+
+;;;
+;;; Options.
+;;;
 
 (define (show-help)
   (display (G_ "Usage: guix locate [OPTIONS...] FILE...
@@ -525,6 +526,11 @@ Locate FILE and return the package(s) that contain it.\n"))
   `((database . ,suitable-database)
     (method . manifests)))
 
+
+;;;
+;;; Entry point.
+;;;
+
 (define-command (guix-locate . args)
   (category packaging)
   (synopsis "search for packages providing a given file")



reply via email to

[Prev in Thread] Current Thread [Next in Thread]