blob: df709cd1acb988205f0618df5ec31f86d42f0df6 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
|
;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
(declaim (optimize (speed 0) (safety 3) (debug 3)))
(in-package :woodriverlessons)
(defclass gallery-service (auth-service)
((admin-p :initarg :admin-p
:initform nil
:accessor admin-p))
(:documentation ""))
(defun gallery-json ()
(with-noauth (instance gallery-service)
(with-valid-user (user "gallery-modify")
(setf (admin-p instance) nil)
(setf (admin-p instance) t))))
(defclass gallery/view-service (gallery-service)
((results :initarg :results
:initform nil
:accessor results)
(location-p :initform nil))
(:documentation ""))
(defun gallery-view-json ()
(with-noauth (instance gallery/view-service)
(with-valid-user (user "gallery-modify")
(setf (admin-p instance) nil)
(setf (admin-p instance) t))
(with-woodriverlessons-database
(let ((general-pkg (make-instance 'general-pkg)))
(setf (results instance) (get-galleries general-pkg))))
(setf (message instance) (session-value :message))
(sanitize-rest-json instance)
(loop for gallery in (results instance)
do (sanitize-json gallery))))
(defclass gallery/add-modify-delete-service (gallery/view-service)
((form :initarg :form
:initform nil
:accessor form))
(:documentation ""))
(defun gallery-add-json ()
(with-auth (instance gallery/add-modify-delete-service "gallery-modify")
(setf (form instance) (make-form "gallery-add-form"
nil
t
`((:name "description" :label "Description" :field-type "textarea")
(:name "upload" :label "Image/Video" :field-type "file" :required "required")
(:label "Add Gallery" :field-type "button" :onclick "on_gallery_add_submit_clicked()"))))))
(defun gallery-add-submit-json (description upload)
(declare (special description))
(with-auth (instance gallery/add-modify-delete-service "gallery-modify")
(with-woodriverlessons-database
(let ((general-pkg (make-instance 'general-pkg))
(gallery (make-instance 'gallery))
(tmp-filepath (first upload))
(orig-filename (second upload))
new-filepath)
(loop for param in (remove-if (lambda (x)
(intersection `(,x) `(upload)))
(sb-introspect:function-lambda-list #'gallery-add-submit-json))
do (setf (slot-value gallery param) (symbol-value param)))
(let ((tmpdir (tmpdir:mkdtemp :prefix "woodriverlessons-gallery-")))
(setf new-filepath (format nil "~a~a" tmpdir (file-namestring tmp-filepath)))
(fad:copy-file tmp-filepath new-filepath)
(setf (filename gallery) orig-filename)
(setf (mime_type gallery) (org-ckons-file::get-mime-type new-filepath))
(setf (content gallery) (org-ckons-file::file-as-hex new-filepath)))
(insert-gallery general-pkg gallery)
(setf (session-value :message) "Gallery added successfully.")))))
(defun gallery-modify-json (id)
(with-auth (instance gallery/add-modify-delete-service "gallery-modify")
(with-woodriverlessons-database
(let* ((general-pkg (make-instance 'general-pkg))
(gallery (get-gallery general-pkg id)))
(if gallery
(setf (form instance) (make-form "gallery-modify-form"
nil
t
`((:name "id" :field-type "hidden" :value ,(id gallery) :required "required")
(:name "description" :label "Description" :value ,(description gallery) :field-type "textarea")
(:name "upload" :label "Image/Video" :field-type "file")
(:label "Modify Gallery" :field-type "button" :onclick "on_gallery_modify_submit_clicked()"))))
(setf (session-value :errormsg) "Error: could not modify gallery. Not found."))))))
(defun gallery-modify-submit-json (id description upload)
(declare (special description))
(with-auth (instance gallery/add-modify-delete-service "gallery-modify")
(with-woodriverlessons-database
(let* ((general-pkg (make-instance 'general-pkg))
(gallery (get-gallery general-pkg id)))
(if gallery
(let ((tmp-filepath (first upload))
(orig-filename (second upload))
new-filepath)
(loop for param in (remove-if (lambda (x)
(intersection `(,x) `(upload)))
(sb-introspect:function-lambda-list #'gallery-add-submit-json))
do (setf (slot-value gallery param) (symbol-value param)))
(when upload
(let ((tmpdir (tmpdir:mkdtemp :prefix "woodriverlessons-gallery-")))
(setf new-filepath (format nil "~a~a" tmpdir (file-namestring tmp-filepath)))
(fad:copy-file tmp-filepath new-filepath)
(setf (filename gallery) orig-filename)
(setf (mime_type gallery) (org-ckons-file::get-mime-type new-filepath))
(setf (content gallery) (org-ckons-file::file-as-hex new-filepath))))
(update-gallery general-pkg gallery)
(setf (session-value :message) "Gallery saved successfully."))
(setf (session-value :errormsg) "An error occurred."))))))
(defun gallery-delete-json (id)
(with-auth (instance gallery/add-modify-delete-service "gallery-modify")
(with-woodriverlessons-database
(let* ((general-pkg (make-instance 'general-pkg))
(gallery (get-gallery general-pkg id)))
(if gallery
(progn
(delete-record general-pkg gallery)
(setf (session-value :message) "Gallery deleted successfully."))
(setf (session-value :errormsg) "Error: could not delete gallery. Not found."))))))
(defun gallery-file-view (id)
(with-noauth-raw (instance gallery/view-service)
(with-woodriverlessons-database
(let* ((general-pkg (make-instance 'general-pkg))
(gallery (get-gallery general-pkg id)))
(when gallery
(setf (org-ckons-session::content-type *header-register*) (mime_type gallery))
(ironclad:hex-string-to-byte-array (content gallery)))))))
|
