cage/tinmop
1
0
Fork 0
mirror of https://codeberg.org/cage/tinmop/ synced 2025-02-17 08:10:36 +01:00
Code Issues

- added download of lisp libraries.

Browse Source
This commit is contained in:
cage 2021-12-07 10:48:37 +01:00
parent 6b67933351
commit 026784e8c5
3 changed files with 65 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/command-line.lisp
View File

@ -80,7 +80,7 @@
:arg-parser #'identity :arg-parser #'identity
:long "load-module") :long "load-module")
(:name :print-lisp-dependencies (:name :print-lisp-dependencies
:description "Print lisp's libraries locations" :description "Download lisp libraries (useful for packaging only)."
:short #\X :short #\X
:long "lisp-dependencies-uris"))) :long "lisp-dependencies-uris")))

2
src/main.lisp
View File

@ -209,7 +209,7 @@ etc.) happened"
(command-line:manage-opts) (command-line:manage-opts)
(cond (cond
(command-line:*print-lisp-dependencies* (command-line:*print-lisp-dependencies*
(misc:all-program-dependencies)) (misc:all-program-dependencies t))
(command-line:*script-file* (command-line:*script-file*
(load-script-file)) (load-script-file))
(t (t

109
src/misc-utils.lisp
View File

@ -940,6 +940,12 @@ to the array"
:external-format-out :utf8) :external-format-out :utf8)
(values stream response-code))) (values stream response-code)))
(defun get-url-content-body (url)
(drakma:http-request url
:want-stream nil
:verify :required
:external-format-out :utf8))
;; profiling ;; profiling
(defmacro with-profile-time (&body body) (defmacro with-profile-time (&body body)
@ -956,20 +962,9 @@ to the array"
(string= (ql::short-description a) (string= (ql::short-description a)
(ql::short-description b))) (ql::short-description b)))
(defun remove-system-duplicates-test (ql-systems) (defun remove-system-duplicates-test (systems)
(remove-duplicates (alexandria:flatten ql-systems) (remove-duplicates systems
:test #'ql-system-equals)) :test #'string=))
(defun all-dependencies (system-name)
(flet ((get-direct-dependencies (system-name)
(remove-system-duplicates-test (ql::dependency-tree system-name))))
(let* ((direct (get-direct-dependencies system-name))
(results (copy-list direct)))
(loop for i in direct do
(let ((dependencies (get-direct-dependencies i)))
(loop for j in dependencies do
(pushnew j results :test #'ql-system-equals))))
results)))
(alexandria:define-constant +github-quicklisp-source-url-template+ (alexandria:define-constant +github-quicklisp-source-url-template+
"https://raw.githubusercontent.com/quicklisp/quicklisp-projects/master/projects/~a/source.txt" "https://raw.githubusercontent.com/quicklisp/quicklisp-projects/master/projects/~a/source.txt"
@ -986,37 +981,59 @@ to the array"
(fields (text-utils:split-words line))) (fields (text-utils:split-words line)))
fields)))) fields))))
(defun asdf-depends-on () (defun asdf-depends-on (&optional (system-name config:+program-name+))
(let ((symbol-system (alexandria:symbolicate (string-upcase config:+program-name+)))) (let ((symbol-system (alexandria:symbolicate (string-upcase system-name))))
(asdf:system-depends-on (asdf:find-system symbol-system)))) (asdf:system-depends-on (asdf:find-system symbol-system))))
(defun all-program-dependencies () (defun all-dependencies (system-name)
(let* ((starting-system-names (asdf-depends-on)) (flet ((get-direct-dependencies (system-name)
(dependencies (alexandria:flatten (mapcar #'all-dependencies (remove-system-duplicates-test (asdf-depends-on system-name))))
starting-system-names))) (let* ((direct (get-direct-dependencies system-name))
(clean-dependencies (mapcar #'ql::short-description (results (copy-list direct)))
(remove-system-duplicates-test dependencies)))) (loop for i in direct do
(setf clean-dependencies (let ((dependencies (get-direct-dependencies i)))
(mapcar (lambda (a) (loop for j in dependencies do
(cond (pushnew j results :test #'string=)
((string= a "sqlite") (all-dependencies i))))
"cl-sqlite") (sort results #'string<))))
((string= a "marshal")
"cl-marshal") (defun all-program-dependencies (&optional download)
(t (let* ((dependencies (all-dependencies config:+program-name+))
a))) (clean-dependencies (mapcar (lambda (a)
clean-dependencies)) (cond
(loop for system-name in (sort clean-dependencies #'string<) do ((string= a "sqlite")
(let ((fields (get-quicklisp-original-file system-name))) "cl-sqlite")
(sleep 1) ((string= a "marshal")
(if fields "cl-marshal")
(cond (t
((string= (first fields) "ediware-http") a)))
(format t "~a ~a ~a~%" system-name "git" dependencies)))
(format nil "https://github.com/edicl/~a.git" system-name))) (flet ((download-package (fields)
((string= (first fields) "kmr-git") (if (cl-ppcre:scan "git" (first fields))
(format t "~a ~a ~a~%" system-name "git" (os-utils:run-external-program "git"
(format nil "http://git.kpe.io/~a.git" system-name))) (list "clone" (second fields))
(t :search t)
(format t "~a ~a ~a~%" system-name (first fields) (second fields)))) (let ((data (get-url-content-body (second fields))))
(format t "!error: ~a~%" system-name)))))) (with-open-file (out-stream (fs:path-last-element (second fields))
:direction :output
:element-type '(unsigned-byte 8))
(write-sequence data out-stream))))))
(loop for system-name in (sort clean-dependencies #'string<) do
(let ((fields (get-quicklisp-original-file system-name)))
(if fields
(cond
((string= (first fields) "ediware-http")
(let ((url (format nil "https://github.com/edicl/~a.git" system-name)))
(format t "~a ~a ~a~%" system-name "git" url)
(when download
(download-package (list "git" url)))))
((string= (first fields) "kmr-git")
(let ((url (format nil "http://git.kpe.io/~a.git" system-name)))
(format t "~a ~a ~a~%" system-name "git" url)
(when download
(download-package (list (first fields) url)))))
(t
(format t "~a ~a ~a~%" system-name (first fields) (second fields))
(when download
(download-package fields))))
(format t "!error: ~a~%" system-name)))))))