Commit b9143b49 authored by Erick's avatar Erick

Addded option --build-sync-file to smcpkg to ease personal repository maintenance

parent f0314668
;;;;
;;;; add.stk -- Adding a file to local server
;;;;
;;;; Copyright 2007 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
;;;; Copyright 2007-2008 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
;;;;
;;;;
;;;; This program is free software; you can redistribute it and/or modify
......@@ -21,14 +21,14 @@
;;;;
;;;; Author: Erick Gallesio [eg@essi.fr]
;;;; Creation date: 18-Jan-2007 16:59 (eg)
;;;; Last file update: 8-Jun-2007 16:33 (eg)
;;;; Last file update: 9-May-2008 11:01 (eg)
;;;;
;; ----------------------------------------------------------------------
;; local-description-add! ...
;; ----------------------------------------------------------------------
(define (local-description-add! pkgball)
(define (local-description-add! pkgball :optional show-only)
(receive (package tuning version)
(parse-pkgball-name pkgball)
;; Control name validity
......@@ -44,15 +44,17 @@
;; Adding a package or a tuning?
(if tuning
(local-description-add-tuning! pkgball package version tuning dirname)
(local-description-add-package! pkgball package version dirname))
(local-description-add-tuning! pkgball package version tuning dirname
show-only)
(local-description-add-package! pkgball package version dirname
show-only))
;; Remove the temporary directory
(rm-rf dirname))))
;; ----------------------------------------------------------------------
;; local-description-add-package! ...
;; ----------------------------------------------------------------------
(define (local-description-add-package! pkgball package version directory)
(define (local-description-add-package! pkgball package version directory show-only)
(when (> (stklos-pkg-verbosity) 0)
(eprintf "Adding package ~S (~a) to local repository\n" package version))
......@@ -61,16 +63,19 @@
(infos (append (get-package-interface src)
(get-package-info inf))))
(let ((descr (build-package-description pkgball package version infos)))
(add-description-to-local-repository! descr))
(copy-file pkgball (make-path (stklos-pkg-cache-directory)
(basename pkgball)))))
(if show-only
(show-public-description descr)
(begin
(add-description-to-local-repository! descr)
(copy-file pkgball (make-path (stklos-pkg-cache-directory)
(basename pkgball))))))))
;; ----------------------------------------------------------------------
;; local-description-add-tuning! ...
;; ----------------------------------------------------------------------
(define (local-description-add-tuning! pkgball package version tuning directory)
(define (local-description-add-tuning! pkgball package version tuning directory
show-only)
(unless (equal? tuning "stklos")
(die "Cannot manage non STklos tunings"))
(when (> (stklos-pkg-verbosity) 0)
......@@ -84,8 +89,11 @@
:url #f
:path ,cache-name
:md5 ,(md5sum-file pkgball))))
(copy-file pkgball cache-name)
(add-description-to-local-repository! descr)))
(if show-only
(show-public-description descr)
(begin
(copy-file pkgball cache-name)
(add-description-to-local-repository! descr show-only)))))
;; ----------------------------------------------------------------------
......@@ -122,3 +130,28 @@
;;;; :failures ()
;;;; :provides ()
:dependencies ,(build-dependencies))))
;; ----------------------------------------------------------------------
;; build-user-sync-file ...
;; ----------------------------------------------------------------------
(define (build-user-sync-file dir)
(let ((pkgs (glob (make-path dir
(string-append "*" (pkgball-suffix))))))
(eprintf ";; -*- Scheme -*- file build automatically\n(\n")
(for-each (lambda (x)
(local-description-add! x #t))
pkgs)
(eprintf ")\n;; EOF\n")))
;; ----------------------------------------------------------------------
;; display-description ...
;; ----------------------------------------------------------------------
(define (show-public-description descr)
(let ((url (stklos-pkg-default-url))
(keylist (cddr descr)))
;; Desc is a local description (i.e. in a file located in the cache)
;; Transform it with an URL
(key-set! keylist :url (make-path url (basename (key-get keylist :path))))
(key-set! keylist :path #f))
(pp descr :port #t))
;;;;
;;;; main.stk -- Stklos-Pkg main program
;;;;
;;;; Copyright 2006-2007 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
;;;; Copyright 2006-2008 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
;;;;
;;;;
;;;; This program is free software; you can redistribute it and/or modify
......@@ -21,7 +21,7 @@
;;;;
;;;; Author: Erick Gallesio [eg@essi.fr]
;;;; Creation date: 22-Dec-2006 11:32 (eg)
;;;; Last file update: 13-Jul-2007 14:49 (eg)
;;;; Last file update: 9-May-2008 10:50 (eg)
;;;;
(include "../lib/http.stk")
......@@ -74,6 +74,8 @@
(set! actions (cons 'clear-cache actions)))
(("reset" :help "reset stklos-pkg repository. USE WITH CAUTION")
(set! actions (cons 'delete-repo actions)))
(("build-sync-file" :arg dir :help "Build a synchronization file from <dir>")
(set! actions (cons (list 'build-sync-file dir) actions)))
"Informations"
(("list" :alternate "l" :help "list available packages")
......@@ -186,7 +188,7 @@
(for-each (lambda (x) (printf "~a\n" x))
(package-deps* (cadar actions))))
((add)
(local-description-add!(cadar actions))
(local-description-add! (cadar actions))
(exit 0))
((cp)
......@@ -198,5 +200,9 @@
((uninstall)
(uninstall-package (cdar actions)))
((build-sync-file)
(build-user-sync-file (cadar actions))
(exit 0))
(else (error-pkg "bad command ~S" (car actions))))
(loop (cdr actions))))))
......@@ -21,7 +21,7 @@
;;;;
;;;; Author: Erick Gallesio [eg@essi.fr]
;;;; Creation date: 26-Dec-2006 16:23 (eg)
;;;; Last file update: 15-Apr-2008 23:14 (eg)
;;;; Last file update: 9-May-2008 10:08 (eg)
;;;;
......@@ -53,6 +53,10 @@
(define pkgball-suffix
(make-parameter ".tar.gz"))
(define stklos-pkg-default-url
(make-parameter (or (getenv "STKLOS_SCMPKG_URL")
"http://www.stklos.org/ScmPkg/Packages")))
(define stklos-pkg-sync-urls
(make-parameter '(
("main" "http://www.stklos.org/ScmPkg/main")
......
......@@ -336,3 +336,4 @@
(display ";; Generated -*- scheme -*- file. *DO NOT EDIT*\n\n")
(pp new :port #t)))))
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment