ebuild-autogen/ebuild/utils.scm
2026-03-30 07:00:06 +02:00

162 lines
6.1 KiB
Scheme

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; utils.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 utils)
#:use-module (ice-9 ftw)
#:use-module (ice-9 pretty-print)
#:use-module (ice-9 regex)
#:use-module (rx irregex)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-19))
(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)) (print-delta #f))
""
(let ((a-list (if (string? data-a)
(string-split data-a #\newline)
(append-map (lambda (line)
(string-split line #\newline))
data-a)))
(b-list (if (string? data-b)
(string-split data-b #\newline)
(append-map (lambda (line)
(string-split line #\newline))
data-b))))
(any (lambda (t) t)
(map (lambda (a b)
(if (string=? a b)
#false
(if (and print-delta
(not (allow a b)))
(begin (display "Diff between lines:")
(newline)
(display "\"") (display a) (display "\"")
(newline)
(display "\"") (display b) (display "\"")
newline)
(allow a b))))
(if (< (length a-list) (length b-list))
(append a-list
(make-list (- (length b-list)
(length a-list))
""))
a-list)
(if (< (length b-list) (length a-list))
(append b-list
(make-list (- (length a-list)
(length b-list))
""))
b-list))))))
(define-public last-ebuild-rel
(lambda (folder pkg version)
""
(let* ((files (if (file-exists? folder)
(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)))
(define-public (string->duration str)
"Parses a string like '10m', '2h', or '30s' into seconds."
(let ((match (string-match "^([0-9]+)([smhdSMHD]?)$" str)))
(if match
(let ((val (string->number (match:substring match 1)))
(unit (match:substring match 2)))
(make-time 'time-duration
0
(cond
((string-ci=? unit "s") val)
((string-ci=? unit "m") (* val 60))
((string-ci=? unit "h") (* val 3600))
((string-ci=? unit "d") (* val 86400))
(else val)))) ; Default to seconds if no unit
(error "Invalid duration format" str))))