mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-15 03:15:09 -05:00
database: 'register-items' shows a progress bar.
* guix/store/database.scm (register-items): Add #:log-port. Use 'progress-reporter/bar' to show a progress report. (register-path): Pass #:log-port to 'register-items'.
This commit is contained in:
parent
a387b0bebb
commit
f0addd6461
1 changed files with 16 additions and 4 deletions
|
@ -23,6 +23,7 @@ (define-module (guix store database)
|
|||
#:use-module (guix serialization)
|
||||
#:use-module (guix store deduplication)
|
||||
#:use-module (guix base16)
|
||||
#:use-module (guix progress)
|
||||
#:use-module (guix build syscalls)
|
||||
#:use-module ((guix build utils)
|
||||
#:select (mkdir-p executable-file?))
|
||||
|
@ -234,7 +235,8 @@ (define* (register-path path
|
|||
#:prefix prefix #:state-directory state-directory
|
||||
#:deduplicate? deduplicate?
|
||||
#:reset-timestamps? reset-timestamps?
|
||||
#:schema schema))
|
||||
#:schema schema
|
||||
#:log-port (%make-void-port "w")))
|
||||
|
||||
(define %epoch
|
||||
;; When it all began.
|
||||
|
@ -245,12 +247,14 @@ (define* (register-items items
|
|||
(deduplicate? #t)
|
||||
(reset-timestamps? #t)
|
||||
registration-time
|
||||
(schema (sql-schema)))
|
||||
(schema (sql-schema))
|
||||
(log-port (current-error-port)))
|
||||
"Register all of ITEMS, a list of <store-info> records as returned by
|
||||
'read-reference-graph', in the database under PREFIX/STATE-DIRECTORY. ITEMS
|
||||
must be in topological order (with leaves first.) If the database is
|
||||
initially empty, apply SCHEMA to initialize it. REGISTRATION-TIME must be the
|
||||
registration time to be recorded in the database; #f means \"now\"."
|
||||
registration time to be recorded in the database; #f means \"now\".
|
||||
Write a progress report to LOG-PORT."
|
||||
|
||||
;; Priority for options: first what is given, then environment variables,
|
||||
;; then defaults. %state-directory, %store-directory, and
|
||||
|
@ -302,4 +306,12 @@ (define real-file-name
|
|||
(mkdir-p db-dir)
|
||||
(parameterize ((sql-schema schema))
|
||||
(with-database (string-append db-dir "/db.sqlite") db
|
||||
(for-each (cut register db <>) items))))
|
||||
(let* ((prefix (format #f "registering ~a items" (length items)))
|
||||
(progress (progress-reporter/bar (length items)
|
||||
prefix log-port)))
|
||||
(call-with-progress-reporter progress
|
||||
(lambda (report)
|
||||
(for-each (lambda (item)
|
||||
(register db item)
|
||||
(report))
|
||||
items)))))))
|
||||
|
|
Loading…
Reference in a new issue