Move cli code into main source directory
authorFrank Duncan <frank@kank.net>
Wed, 23 Dec 2020 23:05:46 +0000 (17:05 -0600)
committerFrank Duncan <frank@kank.net>
Wed, 23 Dec 2020 23:05:46 +0000 (17:05 -0600)
bin/candle
candle.asd
src/main/cli.lisp [new file with mode: 0644]
src/main/package.lisp
src/main/server.lisp

index 4272f7f310022ebb01773c9c71bacb8648818e72..2fc54e1a41cf2640442a936474b88abdb52323e3 100755 (executable)
@@ -5,72 +5,4 @@
 (asdf:initialize-source-registry
  `(:source-registry (:tree ,(car (directory "."))) :INHERIT-CONFIGURATION))
 (asdf:load-system :candle)
 (asdf:initialize-source-registry
  `(:source-registry (:tree ,(car (directory "."))) :INHERIT-CONFIGURATION))
 (asdf:load-system :candle)
-(asdf:load-system :opera)
-
-(in-package #:candle)
-
-(defun main-options ()
- '((:name :help :short "h" :long "help" :description "Print this usage.")
-   (:name :port :short "p" :long "port" :takes-argument t :variable-name "PORT"
-    :description "Port on which to listen for commands.  Defaults to 25004")
-   (:positional "<command>" :required t :description "Command to send to candle server")))
-
-(defun project-options()
- '((:name :help :short "h" :long "help" :description "Print this usage.")
-   (:name :add :long "add" :takes-argument t :description
-    "Add a project.  <name> is the name of the project, which must not include colons, while <src> is the location of the repository for cloning.  This location must be accessible by the machine running candle."
-    :variable-name "<name>:<src>")))
-
-(defun main-usage ()
- (format t "~A"
-  (opera:usage
-   "candle"
-   (main-options)
-   "Interacts with candle server.  The available commands are:
-  project   List, show or add projects
-  job       List or show jobs")))
-
-(defgeneric execute-command (command args))
-
-(defmethod execute-command (command args)
- (format *error-output* "Unknown command '~(~A~)'.  See 'candle --help'.~%" command))
-
-(defun add-project (project-definition)
- (let
-  ((pos (position #\: project-definition)))
-  (cond
-   ((not pos) (format *error-output* "Project definition ~A is not valid.  See 'candle project --help'.~%" project-definition))
-   (t
-    (let
-     ((response (communication:query `(add-project ,(subseq project-definition 0 pos) ,(subseq project-definition (1+ pos))))))
-     (format t "Add project ~A at src definition ~A~%" (project-name response) (project-src response)))))))
-
-(defmethod execute-command ((command (eql :project)) args)
- (multiple-value-bind (options remaining-args error) (opera:process-arguments (project-options) args)
-  (cond
-   ((eql error :unknown-option) (format *error-output* "Unknown option: ~A.  See 'candle project --help'.~%" (car remaining-args)))
-   ((eql error :required-argument-missing) (format *error-output* "Missing argument for ~A.  See 'candle project --help'.~%" (car remaining-args)))
-   ((opera:option-present :help options) (format t "~A" (opera:usage "candle project" (project-options))))
-   ((opera:option-present :add options) (add-project (opera:option-argument :add options))))))
-
-(defmethod execute-command ((command (eql :job)) args)
- (format t "~A~%" (communication:query '(+ 2 2))))
-
-(multiple-value-bind (options remaining-args error) (opera:process-arguments (main-options) (cdr sb-ext:*posix-argv*))
- (cond
-  ((opera:option-present :help options) (main-usage))
-  ((eql error :unknown-option) (format *error-output* "Unknown option: ~A.  See 'candle --help'.~%" (car remaining-args)))
-  ((and (opera:option-present :port options) (not (parse-integer (opera:option-argument :port options) :junk-allowed t)))
-   (format *error-output* "--port requires a number.  See 'candle-server -h'~%"))
-  ((not remaining-args) (format *error-output* "Command required.  See 'candle --help'.~%"))
-  (t
-   (let
-    ((communication:*query-port*
-      (or
-       (and
-        (opera:option-present :port options)
-        (parse-integer (opera:option-argument :port options) :junk-allowed t))
-       25004)))
-    (execute-command (intern (string-upcase (car remaining-args)) :keyword) (cdr remaining-args))))))
-
-; vim:ft=lisp
+(candle-cli:run)
index 7ffb165ff7cc21eaa7fadb3a635550cb330afcf1..0eaba1cd4b2f0f8f58c7a5266256ecce1bccc3e8 100644 (file)
@@ -5,5 +5,5 @@
  :author "Frank Duncan (frank@consxy.com)"
  :serial t
  :pathname "src/main"
  :author "Frank Duncan (frank@consxy.com)"
  :serial t
  :pathname "src/main"
- :components ((:file "package") (:file "base") (:file "server"))
- :depends-on (:herbie-utility))
+ :components ((:file "package") (:file "base") (:file "server") (:file "cli"))
+ :depends-on (:herbie-utility :opera))
diff --git a/src/main/cli.lisp b/src/main/cli.lisp
new file mode 100644 (file)
index 0000000..0dd036a
--- /dev/null
@@ -0,0 +1,92 @@
+(in-package #:candle-cli)
+
+(defun main-options ()
+ '((:name :help :short "h" :long "help" :description "Print this usage.")
+   (:name :port :short "p" :long "port" :takes-argument t :variable-name "PORT"
+    :description "Port on which to listen for commands.  Defaults to 25004")
+   (:positional "<command>" :required t :description "Command to send to candle server")))
+
+(defun project-options()
+ '((:name :help :short "h" :long "help" :description "Print this usage.")
+   (:name :add :long "add" :takes-argument t :description
+    "Add a project.  <name> is the name of the project, which must not include colons, while <src> is the location of the repository for cloning.  This location must be accessible by the machine running candle."
+    :variable-name "<name>:<src>")))
+
+(defun job-options()
+ '((:name :help :short "h" :long "help" :description "Print this usage.")
+   (:name :project-name :short "p" :long "project" :takes-argument t :description "The project name for the jobs under consideration.")
+   (:name :add :long "add" :takes-argument t :description
+    "Add a job to a project.  <sha> is the commit for that project to run the job.  Requires --project to be specified."
+    :variable-name "<sha>")))
+
+(defun main-usage ()
+ (format t "~A"
+  (opera:usage
+   "candle"
+   (main-options)
+   "Interacts with candle server.  The available commands are:
+  project   List, show or add projects
+  job       List or show jobs")))
+
+(defgeneric execute-command (command args))
+
+(defmethod execute-command (command args)
+ (format *error-output* "Unknown command '~(~A~)'.  See 'candle --help'.~%" command))
+
+(defun add-project (project-definition)
+ (let
+  ((pos (position #\: project-definition)))
+  (cond
+   ((not pos) (format *error-output* "Project definition ~A is not valid.  See 'candle project --help'.~%" project-definition))
+   (t
+    (let*
+     ((name (subseq project-definition 0 pos))
+      (src (subseq project-definition (1+ pos)))
+      (response (communication:query `(candle:add-project ,name ,src))))
+     (format t "Added project ~A at src definition ~A~%" name src))))))
+
+(defmethod execute-command ((command (eql :project)) args)
+ (multiple-value-bind (options remaining-args error) (opera:process-arguments (project-options) args)
+  (cond
+   ((eql error :unknown-option) (format *error-output* "Unknown option: ~A.  See 'candle project --help'.~%" (car remaining-args)))
+   ((eql error :required-argument-missing) (format *error-output* "Missing argument for ~A.  See 'candle project --help'.~%" (car remaining-args)))
+   ((opera:option-present :help options) (format t "~A" (opera:usage "candle project" (project-options))))
+   ((opera:option-present :add options) (add-project (opera:option-argument :add options))))))
+
+(defun add-job (project-name sha)
+ (let
+  ((response (communication:query `(candle:add-job ,project-name ,sha))))
+  (format t "Added job with sha ~A to project ~A~%" sha project-name)))
+
+(defmethod execute-command ((command (eql :job)) args)
+ (multiple-value-bind (options remaining-args error) (opera:process-arguments (job-options) args)
+  (cond
+   ((eql error :unknown-option) (format *error-output* "Unknown option: ~A.  See 'candle job --help'.~%" (car remaining-args)))
+   ((eql error :required-argument-missing) (format *error-output* "Missing argument for ~A.  See 'candle job --help'.~%" (car remaining-args)))
+   ((opera:option-present :help options) (format t "~A" (opera:usage "candle job" (job-options))))
+   ((and (opera:option-present :add options) (not (opera:option-present :project-name options)))
+    (format *error-output* "Cannot --add without --project.  See 'candle job --help'.~%"))
+   ((opera:option-present :add options)
+    (add-job
+     (opera:option-argument :project-name options)
+     (opera:option-argument :add options))))))
+
+(defun run ()
+ (multiple-value-bind (options remaining-args error) (opera:process-arguments (main-options) (cdr sb-ext:*posix-argv*))
+  (cond
+   ((opera:option-present :help options) (main-usage))
+   ((eql error :unknown-option) (format *error-output* "Unknown option: ~A.  See 'candle --help'.~%" (car remaining-args)))
+   ((and (opera:option-present :port options) (not (parse-integer (opera:option-argument :port options) :junk-allowed t)))
+    (format *error-output* "--port requires a number.  See 'candle-server -h'~%"))
+   ((not remaining-args) (format *error-output* "Command required.  See 'candle --help'.~%"))
+   (t
+    (let
+     ((communication:*query-port*
+       (or
+        (and
+         (opera:option-present :port options)
+         (parse-integer (opera:option-argument :port options) :junk-allowed t))
+        25004)))
+     (execute-command (intern (string-upcase (car remaining-args)) :keyword) (cdr remaining-args)))))))
+
+; vim:ft=lisp
index 490a5bcba68227dfd2c503c79f04591f83ed7a8a..d7d001b3077fd9a5b518318af8cf6795ffd99b06 100644 (file)
@@ -1,4 +1,4 @@
 (defpackage #:candle (:use :cl)
 (defpackage #:candle (:use :cl)
- (:export #:server
-  #:add-project
-  ))
+ (:export #:server #:add-project #:add-job))
+
+(defpackage #:candle-cli (:use :cl) (:export :run))
index 87d245eb43451379f35800fc7a754f5f202ff211..afa5aa005520080139567eceacffa83c6e20f948 100644 (file)
@@ -12,4 +12,9 @@
   :name "Save Thread"))
 
 (defun add-project (name src)
   :name "Save Thread"))
 
 (defun add-project (name src)
- (make-project :name name :src src))
+ (make-project :name name :src src)
+ t)
+
+(defun add-job (project-name sha)
+ (make-job :project (find project-name *all-project* :key #'project-name :test #'string=) :sha sha)
+ t)