118 lines
4.4 KiB
Scheme
118 lines
4.4 KiB
Scheme
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
|
;; utils.scm
|
||
|
|
;; Copyright (C) 2025 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 utils)
|
||
|
|
#:use-module (ice-9 ftw)
|
||
|
|
#:use-module (rx irregex)
|
||
|
|
#:use-module (srfi srfi-1))
|
||
|
|
|
||
|
|
(define-public list->str-list
|
||
|
|
(lambda* (in-list glue #:key (pre "") (post ""))
|
||
|
|
""
|
||
|
|
;;(display "in-list=") (display in-list) (newline)
|
||
|
|
(if (null? in-list)
|
||
|
|
""
|
||
|
|
(string-concatenate
|
||
|
|
(append (list pre)
|
||
|
|
(cdr (append-map (lambda (item)
|
||
|
|
(append (list glue)
|
||
|
|
(list item)))
|
||
|
|
in-list))
|
||
|
|
(list post))))))
|
||
|
|
|
||
|
|
(define-public any-str-list
|
||
|
|
(lambda (test-list val)
|
||
|
|
""
|
||
|
|
(any (lambda (test-val)
|
||
|
|
(if (string=? test-val val)
|
||
|
|
#t #f))
|
||
|
|
test-list)))
|
||
|
|
|
||
|
|
(define-public diff?
|
||
|
|
(lambda* (data-a data-b #:key (allow (lambda (a b) #true)))
|
||
|
|
""
|
||
|
|
(any (lambda (t) t)
|
||
|
|
(map (lambda (a b)
|
||
|
|
(if (string=? a b)
|
||
|
|
#false
|
||
|
|
(allow a b)))
|
||
|
|
(if (string? data-a)
|
||
|
|
(string-split data-a #\newline)
|
||
|
|
data-a)
|
||
|
|
(if (string? data-b)
|
||
|
|
(string-split data-b #\newline)
|
||
|
|
data-b)))))
|
||
|
|
|
||
|
|
(define-public last-ebuild-rel
|
||
|
|
(lambda (folder pkg version)
|
||
|
|
""
|
||
|
|
(let* ((files (scandir folder))
|
||
|
|
(releases (filter-map
|
||
|
|
(lambda (file)
|
||
|
|
(if (string=? file (string-append pkg
|
||
|
|
"-"
|
||
|
|
version
|
||
|
|
".ebuild"))
|
||
|
|
0
|
||
|
|
(let ((my-match (irregex-search
|
||
|
|
`(seq (look-behind ,pkg
|
||
|
|
"-"
|
||
|
|
,version
|
||
|
|
"-r")
|
||
|
|
(+ numeric)
|
||
|
|
(look-ahead ".ebuild"))
|
||
|
|
file)))
|
||
|
|
(if my-match
|
||
|
|
(string->number
|
||
|
|
(irregex-match-substring my-match))
|
||
|
|
#false))))
|
||
|
|
files)))
|
||
|
|
(cond ((zero? (length releases)) 0)
|
||
|
|
((<= 2 (length releases)) (car (sort releases >)))
|
||
|
|
(else (car releases))))))
|
||
|
|
|
||
|
|
(define-public mkpath
|
||
|
|
(lambda (path)
|
||
|
|
""
|
||
|
|
(let* ((split-path (filter-map (lambda (str)
|
||
|
|
(if (string<> str "") str #f))
|
||
|
|
(string-split path
|
||
|
|
(car (string->list
|
||
|
|
file-name-separator-string)))))
|
||
|
|
(fixed-path (string-append (string-concatenate (map (lambda (folder)
|
||
|
|
(string-append "/" folder))
|
||
|
|
split-path))
|
||
|
|
"/"))
|
||
|
|
(path-1up (string-concatenate (map (lambda (folder)
|
||
|
|
(string-append "/" folder))
|
||
|
|
(reverse (cdr (reverse split-path)))))))
|
||
|
|
(if (not (access? fixed-path F_OK))
|
||
|
|
(if (access? path-1up F_OK)
|
||
|
|
(if (access? path-1up W_OK)
|
||
|
|
(mkdir fixed-path)
|
||
|
|
(error (string-append "Error no write permission in \""
|
||
|
|
path-1up
|
||
|
|
"\" to create \""
|
||
|
|
(car (reverse split-path))
|
||
|
|
"\" folder!")))
|
||
|
|
(begin (mkpath path-1up)
|
||
|
|
(mkdir path)))))))
|
||
|
|
|
||
|
|
(define-public cmp-str-lists
|
||
|
|
(lambda (list1 list2)
|
||
|
|
""
|
||
|
|
(every string=? list1 list2)))
|