(sleep (* 5 60))
(lame-db:save-known-dbs data-dir))))
:name "Save Thread")
+ (format t "Starting processor in ~(~A~) mode~%" *job-system*)
+ (start-processor-thread)
(communication:start-listener port background)))
(defun add-project (name src)
((project (make-project :name name :src src)))
(ensure-directories-exist (project-dir project))
(git project "clone" src ".")
- (refresh-project project))
+ (refresh-project name))
t)
-(defun refresh-project (project)
- (multiple-value-bind (success code out err) (git project "branch" "-r" "--format" "%(refname) %(objectname)" "--list" "origin/*")
- (declare (ignore code err))
- (when (not success) (error "Failed to get branches"))
- (let
- ((branches (find-branch-by-project project)))
+(defun refresh-project (name)
+ (let*
+ ((project (find name *all-project* :test #'string= :key #'project-name))
+ (branches (find-branch-by-project project)))
+ (git project "fetch" "origin" "--prune")
+ (multiple-value-bind (success code out err) (git project "branch" "-r" "--format" "%(refname) %(objectname)" "--list" "origin/*")
+ (declare (ignore code err))
+ (when (not success) (error "Failed to get branches"))
(mapcar (lambda (branch) (set-branch-in-git branch nil)) branches)
(mapcar
(lambda (line)
(make-branch :name branch-name :project project))))
(set-branch-in-git branch t)
(set-branch-job branch job))))
- (cl-ppcre:split "\\n" out)))))
+ (cl-ppcre:split "\\n" out))))
+ (awaken-processor-thread))
(defun delete-project (name)
(let
((project (find name *all-project* :test #'string= :key #'project-name)))
- (when (not project)
- (error "Project does not exists"))
+ (when (not project) (error "Project does not exists"))
(sb-ext:delete-directory (project-dir project) :recursive t)
(mapcar #'nremove-job (find-job-by-project project))
(mapcar #'nremove-branch (find-branch-by-project project))
(nremove-project project)))
+
+(defun project-branch-information (name)
+ (let
+ ((project (find name *all-project* :test #'string= :key #'project-name)))
+ (when (not project) (error "Project does not exists"))
+ (mapcar
+ (lambda (branch)
+ (list
+ (branch-name branch)
+ (job-status (branch-job branch))
+ (job-create-date (branch-job branch))
+ (job-sha (branch-job branch))))
+ (remove-if-not #'branch-in-git (find-branch-by-project project)))))
+
+(defun project-job-information (name)
+ (let
+ ((project (find name *all-project* :test #'string= :key #'project-name)))
+ (when (not project) (error "Project does not exists"))
+ (mapcar
+ (lambda (job)
+ (list
+ (job-sha job)
+ (job-status job)
+ (job-create-date job)))
+ (find-job-by-project project))))