79 lines
2.6 KiB
Scheme
79 lines
2.6 KiB
Scheme
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; pkt-map.scm
|
|
;; Copyright (C) 2025, 2026 Cor Legemaat <cor@cor.za.net>
|
|
;;
|
|
;; This file is part of ebuild-autogen: you can redistribute it and/or modify it
|
|
;; under the terms of the GNU Affero General Public License as published by the
|
|
;; Free Software Foundation, version 3 of the License.
|
|
;;
|
|
;; ebuild-autogen is distributed in the hope that it will be useful, but WITHOUT
|
|
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
|
;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
|
|
;; more details.
|
|
;;
|
|
;; You should have received a copy of the GNU General Public License along with
|
|
;; ebuild-autogen. If not, see <https://www.gnu.org/licenses/>.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
(define-module (ebuild pkt-map)
|
|
#:use-module (ebuild defs)
|
|
#:use-module (ebuild utils)
|
|
#:use-module (ice-9 pretty-print)
|
|
#:use-module (oop goops)
|
|
#:use-module (srfi srfi-1)
|
|
#:use-module (srfi srfi-43)
|
|
#:use-module (rx irregex)
|
|
#:use-module (dql dql))
|
|
|
|
(define-public pkt-map-load
|
|
(lambda (repo type)
|
|
""
|
|
(let ((path (string-join (list repo
|
|
"repo-local"
|
|
(string-append "pkg-map-"
|
|
type
|
|
".aldb"))
|
|
file-name-separator-string)))
|
|
(if (file-exists? path)
|
|
(dql-read path)
|
|
'()))))
|
|
|
|
(define-public pkt-map-set
|
|
(lambda (db name category pkg)
|
|
""
|
|
(if (not (null? (pkt-map-get db name)))
|
|
((dql (alter (where (lambda (pkg-name)
|
|
(and (string? pkg-name)
|
|
(string= pkg-name name)))
|
|
'name)
|
|
(update 'name name)
|
|
(update 'category category)
|
|
(update 'pkg pkg)))
|
|
db)
|
|
(append db (list (list (cons 'name name)
|
|
(cons 'category category)
|
|
(cons 'pkg pkg)))))))
|
|
|
|
(define-public pkt-map-get
|
|
(lambda (db name)
|
|
""
|
|
(let ((answ ((dql (select (filter (where (lambda (pkg-name)
|
|
(and (string? pkg-name)
|
|
(string= pkg-name name)))
|
|
'name))
|
|
(parm 'category)
|
|
(parm 'pkg)))
|
|
db)))
|
|
;; (display "answ:") (newline)
|
|
;; (pretty-print answ)
|
|
answ)))
|
|
|
|
(define-public pkt-map-write
|
|
(lambda (db repo type)
|
|
""
|
|
(dql-write db
|
|
(string-join (list repo
|
|
"repo-local"
|
|
(string-append "pkg-map-"
|
|
type
|
|
".aldb"))
|
|
file-name-separator-string))))
|