diff --git a/dashboard/dashboard.cl b/dashboard/dashboard.cl index cf8a56802..157fd2cdc 100644 --- a/dashboard/dashboard.cl +++ b/dashboard/dashboard.cl @@ -20,30 +20,41 @@ (defpackage :dashboard (:use :cl :cl-user :json :mysql-connect) (:export :destroy-connection :create-connection :create-local-connection -:dummy-process-api-request :process-api-request - )) + :dummy-process-api-request :process-api-request + )) (defun start-dashboard (&key (port 8080) host db user password) - (dashboard:create-connection :user user :password password :db db :host host)) + (webserver:start-json-rpc-services '(("/dashboard" :json-rpc t)) + :port 8080 + :server-log-path + (merge-pathnames "dashboard-server.log" *andes-path*)) + + (dashboard:create-connection :user user :password password :db db :host host) + nil) + +(defun stop-dashboard () + (webserver:stop-json-rpc-services) + ;; Stop database. + (dashboard:destroy-connection)) (in-package :dashboard) -(webserver:defun-method "/dashboard" dashboard (&key version (model () model-p) -section (student () student-p) -(assignment () assignment-p)) - (apply #'process-api-request (append (list :version version :section section) -(if model-p (list :model model)) -(if assignment-p (list :assignment assignment)) -(if student-p (list :student student))))) + (webserver:defun-method "/dashboard" dashboard (&key version (model () model-p) + section (student () student-p) + (assignment () assignment-p)) + (apply #'process-api-request (append (list :version version :section section) + (if model-p (list :model model)) + (if assignment-p (list :assignment assignment)) + (if student-p (list :student student))))) (defvar *connection* nil "connection to db") (defmacro with-db (&body body) "Excecute body with db mutex." `(if *connection* - (sb-thread:with-mutex (*db-lock*) ,@body) - (error "No common database defined, can't continue."))) + (sb-thread:with-mutex (*db-lock*) ,@body) + (error "No common database defined, can't continue."))) (defun read-login-file (&optional path) "Read the database login file; file contains user name, password & (optional) database name." @@ -82,56 +93,56 @@ section (student () student-p) (defun formatted-time () (multiple-value-bind -(second minute hour date month year day-of-week dst-p tz) + (second minute hour date month year day-of-week dst-p tz) (get-decoded-time) (format nil "~A-~A-~AT~A:~A" year month date hour minute))) (defun dummy-process-api-request (&key -(version 1) -(model "capstone") -(section "andesTutor") -(student () supply-student-p) -(assignment () supply-assignment-p)) + (version 1) + (model "capstone") + (section "andesTutor") + (student () supply-student-p) + (assignment () supply-assignment-p)) '(((:this . is) (:a . test)))) (defun process-api-request (&key -(version 1) -(model "capstone") -(section "andesTutor") -(student () supply-student-p) -(assignment () supply-assignment-p)) -;the student id matches and the kcs of the assignment match -;when one is missing we just pull all of the records -;because the assignment data is not anywhere in the table, -;separate assignments are best run as separate queries -;in the case of a different model we might need to return -;different kcs, different data about those kcs. + (version 1) + (model "capstone") + (section "andesTutor") + (student () supply-student-p) + (assignment () supply-assignment-p)) + ;the student id matches and the kcs of the assignment match + ;when one is missing we just pull all of the records + ;because the assignment data is not anywhere in the table, + ;separate assignments are best run as separate queries + ;in the case of a different model we might need to return + ;different kcs, different data about those kcs. (let ( -(assignment-list-data -(get-kcs-for-assignments section -(if supply-assignment-p -(list assignment) -(get-assignments-for-section section)) -model)) -(student-ids -(if supply-student-p -(list (list student)) -(run-query (concatenate 'string -"SELECT DISTINCT userName FROM student_state WHERE userSection = \"" -section -"\""))))) + (assignment-list-data + (get-kcs-for-assignments section + (if supply-assignment-p + (list assignment) + (get-assignments-for-section section)) + model)) + (student-ids + (if supply-student-p + (list (list student)) + (run-query (concatenate 'string + "SELECT DISTINCT userName FROM student_state WHERE userSection = \"" + section + "\""))))) (list (cons :api-version version) -(cons :timestamp (formatted-time)) -(cons :sectionid section) -(build-student-list section student-ids assignment-list-data model)))) + (cons :timestamp (formatted-time)) + (cons :sectionid section) + (build-student-list section student-ids assignment-list-data model)))) (defun get-assignments-for-section (section) (if (equal section "andesTutor") (mapcar #'car cl-user::*sets*))) (defun build-student-list (section-id student-ids assignment-list-data model) (cons :*student-list -(loop for student-record in student-ids collect -(build-student-data section-id (car student-record) assignment-list-data model)))) + (loop for student-record in student-ids collect + (build-student-data section-id (car student-record) assignment-list-data model)))) (defun build-student-data (section-id student-id assignment-list-data model) (list @@ -140,8 +151,8 @@ section (defun build-assignment-list (section-id student-id assignment-list-data model) (cons :*assignment-list -(loop for assignment-data in assignment-list-data collect -(build-assignment section-id student-id (first assignment-data) (second assignment-data) model)))) + (loop for assignment-data in assignment-list-data collect + (build-assignment section-id student-id (first assignment-data) (second assignment-data) model)))) (defun build-assignment (section-id student-id assignment-id assignment-kcs model) (list @@ -150,44 +161,44 @@ section (defun build-kc-list (kc-list-data) (cons :+kcl+ist -(loop for kc-data in kc-list-data collect -(apply #'build-kc kc-data)))) + (loop for kc-data in kc-list-data collect + (apply #'build-kc kc-data)))) (defun build-kc (name state) (let (kc-info (decode state)) (append (list (cons :*name name) -(cons :*short-desc (get-operator-short-name (intern (string-upcase name)))); if the kc is not in the andes model -(cons :*long-desc (get-operator-description (intern (string-upcase name))))); these lines could cause problems + (cons :*short-desc (get-operator-short-name (intern (string-upcase name)))); if the kc is not in the andes model + (cons :*long-desc (get-operator-description (intern (string-upcase name))))); these lines could cause problems (decode state)))) (defun kc-query-string (section-id student-id assignment-kcs model) (format nil "SELECT property,value FROM student_state WHERE userSection = \"~A\" ~A ~A ~A" ;need to incorporate model checking -section-id -(concatenate 'string "AND userName = \"" student-id "\"") -;think about sanitizing inputs -(concatenate 'string "AND model = \"" model "\"") -(concatenate 'string -"AND (property = \"junk-kc\"" -(format nil "~{ OR property = \"~a\"~}" -assignment-kcs) -")"))) + section-id + (concatenate 'string "AND userName = \"" student-id "\"") + ;think about sanitizing inputs + (concatenate 'string "AND model = \"" model "\"") + (concatenate 'string + "AND (property = \"junk-kc\"" + (format nil "~{ OR property = \"~a\"~}" + assignment-kcs) + ")"))) (defun get-dummy-kcs-for-assignments (section assignments model) (list '("assignment 1" ("kc1" "kc2" "kc3")))) (defun get-kcs-for-assignments (section assignments model) -;this function will need to pull the kcs for an assignment, -;which will probably only be derivable from the problems in -;the assignment. we should have a section value (nil?) that -;pulls the data from the andes defined problem sets. what -;happens when the assignments don't exist? do we return anything? + ;this function will need to pull the kcs for an assignment, + ;which will probably only be derivable from the problems in + ;the assignment. we should have a section value (nil?) that + ;pulls the data from the andes defined problem sets. what + ;happens when the assignments don't exist? do we return anything? (if (equal section "andesTutor"); we need to pull the kcs correctly depending on the section name (loop for kc-set in -cl-user::*set-kcs* append -(if (member (car kc-set) assignments :test #'equal) -(list -(list (car kc-set) (apply #'append (cdr kc-set))))));combines common and uncommon kcs + cl-user::*set-kcs* append + (if (member (car kc-set) assignments :test #'equal) + (list + (list (car kc-set) (apply #'append (cdr kc-set))))));combines common and uncommon kcs ())); right now only one section works (defun get-kc-names (kc)