Close the load revision inferior prior to inserting data
This means that the lock can be acquired after closing the inferior, freeing the large amount of memory that the inferior process is probably using.
This commit is contained in:
parent
df4e0a7a61
commit
097e22ab5e
4 changed files with 183 additions and 138 deletions
|
|
@ -814,36 +814,77 @@ WHERE job_id = $1")
|
|||
|
||||
deduplicated-packages))
|
||||
|
||||
(define* (insert-packages conn inf packages #:key (process-replacements? #t))
|
||||
(let* ((package-license-set-ids
|
||||
(define* (all-inferior-packages-data inf packages #:key (process-replacements? #t))
|
||||
(let* ((package-license-data
|
||||
(with-time-logging "fetching inferior package license metadata"
|
||||
(inferior-packages->license-set-ids
|
||||
conn
|
||||
(inferior-packages->license-id-lists
|
||||
conn
|
||||
(inferior-packages->license-data inf packages))))))
|
||||
(let*-values
|
||||
(((all-package-metadata-ids new-package-metadata-ids)
|
||||
(inferior-packages->license-data inf packages)))
|
||||
(package-metadata
|
||||
(with-time-logging "fetching inferior package metadata"
|
||||
(inferior-packages->package-metadata-ids
|
||||
conn inf packages package-license-set-ids)))
|
||||
((package-replacement-package-ids)
|
||||
(map
|
||||
(lambda (package)
|
||||
(let ((translated-package-descriptions-and-synopsis
|
||||
(inferior-packages->translated-package-descriptions-and-synopsis
|
||||
inf package)))
|
||||
(list (non-empty-string-or-false
|
||||
(inferior-package-home-page package))
|
||||
(inferior-package-location package)
|
||||
(car translated-package-descriptions-and-synopsis)
|
||||
(cdr translated-package-descriptions-and-synopsis))))
|
||||
packages)))
|
||||
(package-replacement-data
|
||||
(if process-replacements?
|
||||
(map (lambda (package)
|
||||
(let ((replacement (inferior-package-replacement package)))
|
||||
(if (and process-replacements? replacement)
|
||||
(if replacement
|
||||
;; I'm not sure if replacements can themselves be
|
||||
;; replaced, but I do know for sure that there are
|
||||
;; infinite chains of replacements (python(2)-urllib3
|
||||
;; in 7c4c781aa40c42d4cd10b8d9482199f3db345e1b for
|
||||
;; example).
|
||||
;;
|
||||
;; This code currently just capures the first level of
|
||||
;; replacements
|
||||
(car
|
||||
(insert-packages conn inf (list replacement)
|
||||
;; This code currently just capures the first level
|
||||
;; of replacements
|
||||
(first
|
||||
(all-inferior-packages-data
|
||||
inf
|
||||
(list replacement)
|
||||
#:process-replacements? #f))
|
||||
(cons "integer" NULL))))
|
||||
packages)))
|
||||
#f)))
|
||||
packages)
|
||||
#f)))
|
||||
|
||||
`((names . ,(map inferior-package-name packages))
|
||||
(versions . ,(map inferior-package-version packages))
|
||||
(license-data . ,package-license-data)
|
||||
(metadata . ,package-metadata)
|
||||
(replacemnets . ,package-replacement-data))))
|
||||
|
||||
(define (insert-packages conn inferior-packages-data)
|
||||
(let*-values
|
||||
(((package-license-set-ids)
|
||||
(inferior-packages->license-set-ids
|
||||
conn
|
||||
(inferior-packages->license-id-lists
|
||||
conn
|
||||
(assq-ref inferior-packages-data 'license-data))))
|
||||
((all-package-metadata-ids new-package-metadata-ids)
|
||||
(with-time-logging "inserting package metadata entries"
|
||||
(inferior-packages->package-metadata-ids
|
||||
conn
|
||||
(assq-ref inferior-packages-data 'metadata)
|
||||
package-license-set-ids)))
|
||||
((replacement-ids)
|
||||
(or (and=> (assq-ref inferior-packages-data 'replacements)
|
||||
(lambda (all-replacement-data)
|
||||
(with-time-logging "inserting package replacements"
|
||||
(map (lambda (replacement-data)
|
||||
(if replacement-data
|
||||
(first
|
||||
(insert-packages conn (list replacement-data)))
|
||||
(cons "integer" NULL)))
|
||||
all-replacement-data))))
|
||||
(make-list (length package-license-set-ids)
|
||||
(cons "integer" NULL)))))
|
||||
|
||||
(unless (null? new-package-metadata-ids)
|
||||
(with-time-logging "fetching package metadata tsvector entries"
|
||||
|
|
@ -853,10 +894,10 @@ WHERE job_id = $1")
|
|||
(with-time-logging "getting package-ids"
|
||||
(inferior-packages->package-ids
|
||||
conn
|
||||
(zip (map inferior-package-name packages)
|
||||
(map inferior-package-version packages)
|
||||
(zip (assq-ref inferior-packages-data 'names)
|
||||
(assq-ref inferior-packages-data 'versions)
|
||||
all-package-metadata-ids
|
||||
package-replacement-package-ids))))))
|
||||
replacement-ids)))))
|
||||
|
||||
(define (insert-lint-warnings conn inferior-package-id->package-database-id
|
||||
lint-checker-ids
|
||||
|
|
@ -1289,7 +1330,14 @@ WHERE job_id = $1")
|
|||
(all-inferior-package-derivations store inf packages)))
|
||||
(inferior-system-tests
|
||||
(with-time-logging "getting inferior system tests"
|
||||
(all-inferior-system-tests inf store))))
|
||||
(all-inferior-system-tests inf store)))
|
||||
(packages-data
|
||||
(with-time-logging "getting all inferior package data"
|
||||
(all-inferior-packages-data inf packages))))
|
||||
|
||||
(simple-format
|
||||
#t "debug: finished loading information from inferior\n")
|
||||
(close-inferior inf)
|
||||
|
||||
(with-time-logging
|
||||
"acquiring advisory transaction lock: load-new-guix-revision-inserts"
|
||||
|
|
@ -1298,7 +1346,7 @@ WHERE job_id = $1")
|
|||
(obtain-advisory-transaction-lock conn
|
||||
'load-new-guix-revision-inserts))
|
||||
(let* ((package-ids
|
||||
(insert-packages conn inf packages))
|
||||
(insert-packages conn packages-data))
|
||||
(inferior-package-id->package-database-id
|
||||
(let ((lookup-table
|
||||
(alist->hashq-table
|
||||
|
|
@ -1316,9 +1364,6 @@ WHERE job_id = $1")
|
|||
"error: inferior-package-id->package-database-id: ~A missing\n"
|
||||
inferior-id)))))))
|
||||
|
||||
(simple-format
|
||||
#t "debug: finished loading information from inferior\n")
|
||||
(close-inferior inf)
|
||||
|
||||
(when inferior-lint-warnings
|
||||
(let* ((lint-checker-ids
|
||||
|
|
|
|||
|
|
@ -389,43 +389,39 @@ WHERE packages.id IN (
|
|||
(insert-package-description-set conn package-description-ids))))))
|
||||
|
||||
(define (inferior-packages->package-metadata-ids conn
|
||||
inferior
|
||||
packages
|
||||
package-metadata
|
||||
license-set-ids)
|
||||
(define package-metadata
|
||||
(map (lambda (package license-set-id)
|
||||
(let ((translated-package-descriptions-and-synopsis
|
||||
(inferior-packages->translated-package-descriptions-and-synopsis
|
||||
inferior package)))
|
||||
(list (non-empty-string-or-false
|
||||
(inferior-package-home-page package))
|
||||
(location->location-id
|
||||
conn
|
||||
(inferior-package-location package))
|
||||
license-set-id
|
||||
(package-description-data->package-description-set-id
|
||||
conn
|
||||
(car translated-package-descriptions-and-synopsis))
|
||||
(package-synopsis-data->package-synopsis-set-id
|
||||
conn
|
||||
(cdr translated-package-descriptions-and-synopsis)))))
|
||||
packages
|
||||
license-set-ids))
|
||||
|
||||
(insert-missing-data-and-return-all-ids
|
||||
conn
|
||||
"package_metadata"
|
||||
'(home_page location_id license_set_id package_description_set_id package_synopsis_set_id)
|
||||
(map (match-lambda
|
||||
((home-page location-id license-set-id package_description_set_id package_synopsis_set_id)
|
||||
'(home_page
|
||||
location_id
|
||||
license_set_id
|
||||
package_description_set_id
|
||||
package_synopsis_set_id)
|
||||
|
||||
(map (match-lambda*
|
||||
(((home-page
|
||||
location
|
||||
package-description-data
|
||||
package-synopsis-data)
|
||||
license-set-id)
|
||||
|
||||
(list (if (string? home-page)
|
||||
home-page
|
||||
NULL)
|
||||
location-id
|
||||
(location->location-id
|
||||
conn
|
||||
location)
|
||||
license-set-id
|
||||
package_description_set_id
|
||||
package_synopsis_set_id)))
|
||||
package-metadata)
|
||||
(package-description-data->package-description-set-id
|
||||
conn
|
||||
package-description-data)
|
||||
(package-synopsis-data->package-synopsis-set-id
|
||||
conn
|
||||
package-synopsis-data))))
|
||||
package-metadata
|
||||
license-set-ids)
|
||||
;; There can be duplicated entires in package-metadata, for example where
|
||||
;; you have one package definition which interits from another, and just
|
||||
;; overrides the version and the source, the package_metadata entries for
|
||||
|
|
|
|||
|
|
@ -29,6 +29,19 @@
|
|||
(home-page #f)
|
||||
(location #f)))
|
||||
|
||||
(define mock-inferior-packages
|
||||
(list mock-inferior-package-foo
|
||||
mock-inferior-package-foo-2))
|
||||
|
||||
(define mock-package-metadata
|
||||
(map (lambda (mock-inf-pkg)
|
||||
(list
|
||||
(mock-inferior-package-home-page mock-inf-pkg)
|
||||
(mock-inferior-package-location mock-inf-pkg)
|
||||
`(("en_US.UTF-8" . "Fake synopsis"))
|
||||
`(("en_US.UTF-8" . "Fake description"))))
|
||||
mock-inferior-packages))
|
||||
|
||||
(define (test-license-set-ids conn)
|
||||
(let ((license-id-lists
|
||||
(inferior-packages->license-id-lists
|
||||
|
|
@ -39,12 +52,6 @@
|
|||
|
||||
(inferior-packages->license-set-ids conn license-id-lists)))
|
||||
|
||||
(mock
|
||||
((guix-data-service model package-metadata)
|
||||
inferior-packages->translated-package-descriptions-and-synopsis
|
||||
(lambda (inferior inferior-package)
|
||||
(cons `(("en_US.UTF-8" . "Fake synopsis"))
|
||||
`(("en_US.UTF-8" . "Fake description")))))
|
||||
(with-mock-inferior-packages
|
||||
(lambda ()
|
||||
(use-modules (guix-data-service model package)
|
||||
|
|
@ -64,9 +71,7 @@
|
|||
(match
|
||||
(inferior-packages->package-metadata-ids
|
||||
conn
|
||||
""
|
||||
(list mock-inferior-package-foo
|
||||
mock-inferior-package-foo-2)
|
||||
mock-package-metadata
|
||||
(test-license-set-ids conn))
|
||||
((x) (number? x))))
|
||||
#:always-rollback? #t))
|
||||
|
|
@ -77,16 +82,12 @@
|
|||
(test-equal "inferior-packages->package-metadata-ids"
|
||||
(inferior-packages->package-metadata-ids
|
||||
conn
|
||||
""
|
||||
(list mock-inferior-package-foo
|
||||
mock-inferior-package-foo-2)
|
||||
mock-package-metadata
|
||||
(test-license-set-ids conn))
|
||||
(inferior-packages->package-metadata-ids
|
||||
conn
|
||||
""
|
||||
(list mock-inferior-package-foo
|
||||
mock-inferior-package-foo-2)
|
||||
mock-package-metadata
|
||||
(test-license-set-ids conn)))
|
||||
#:always-rollback? #t)))))))
|
||||
#:always-rollback? #t))))))
|
||||
|
||||
(test-end)
|
||||
|
|
|
|||
|
|
@ -5,6 +5,7 @@
|
|||
#:use-module (guix utils)
|
||||
#:use-module (guix tests)
|
||||
#:use-module (tests mock-inferior)
|
||||
#:use-module (guix-data-service model utils)
|
||||
#:use-module (guix-data-service model license)
|
||||
#:use-module (guix-data-service model license-set)
|
||||
#:use-module (guix-data-service model package)
|
||||
|
|
@ -45,16 +46,18 @@
|
|||
(list mock-inferior-package-foo
|
||||
mock-inferior-package-foo-2))
|
||||
|
||||
(mock
|
||||
((guix-data-service model package-metadata)
|
||||
inferior-packages->translated-package-descriptions-and-synopsis
|
||||
(lambda (inferior inferior-package)
|
||||
(cons `(("en_US.UTF-8" . "Fake synopsis"))
|
||||
`(("en_US.UTF-8" . "Fake description")))))
|
||||
(define mock-package-metadata
|
||||
(map (lambda (mock-inf-pkg)
|
||||
(list
|
||||
(mock-inferior-package-home-page mock-inf-pkg)
|
||||
(mock-inferior-package-location mock-inf-pkg)
|
||||
`(("en_US.UTF-8" . "Fake synopsis"))
|
||||
`(("en_US.UTF-8" . "Fake description"))))
|
||||
mock-inferior-packages))
|
||||
|
||||
(with-mock-inferior-packages
|
||||
(lambda ()
|
||||
(use-modules (guix-data-service model utils)
|
||||
(guix-data-service model package)
|
||||
(use-modules (guix-data-service model package)
|
||||
(guix-data-service model git-repository)
|
||||
(guix-data-service model guix-revision)
|
||||
(guix-data-service model package-metadata))
|
||||
|
|
@ -68,10 +71,10 @@
|
|||
conn
|
||||
(lambda (conn)
|
||||
(test-assert "inferior-packages->package-ids works once"
|
||||
(let ((package-metadata-ids (inferior-packages->package-metadata-ids
|
||||
(let ((package-metadata-ids
|
||||
(inferior-packages->package-metadata-ids
|
||||
conn
|
||||
""
|
||||
mock-inferior-packages
|
||||
mock-package-metadata
|
||||
(test-license-set-ids conn)))
|
||||
(package-replacement-package-ids
|
||||
(make-list (length mock-inferior-packages)
|
||||
|
|
@ -88,10 +91,10 @@
|
|||
(with-postgresql-transaction
|
||||
conn
|
||||
(lambda (conn)
|
||||
(let ((package-metadata-ids (inferior-packages->package-metadata-ids
|
||||
(let ((package-metadata-ids
|
||||
(inferior-packages->package-metadata-ids
|
||||
conn
|
||||
""
|
||||
mock-inferior-packages
|
||||
mock-package-metadata
|
||||
(test-license-set-ids conn)))
|
||||
(package-replacement-package-ids
|
||||
(make-list (length mock-inferior-packages)
|
||||
|
|
@ -109,6 +112,6 @@
|
|||
(map mock-inferior-package-version mock-inferior-packages)
|
||||
package-metadata-ids
|
||||
package-replacement-package-ids)))))
|
||||
#:always-rollback? #t))))))
|
||||
#:always-rollback? #t)))))
|
||||
|
||||
(test-end)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue