├── tests ├── package.lisp ├── tests-app-updates.lisp └── tests.lisp ├── package.lisp ├── weblocks-ajax-file-upload-presentation.asd ├── weblocks-ajax-file-upload-presentation-tests.asd ├── README.txt ├── weblocks-ajax-file-upload-presentation.lisp └── license.txt /tests/package.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:weblocks-ajax-file-upload-presentation-tests 2 | (:use #:cl #:weblocks #:weblocks-selenium-tests #:weblocks-ajax-file-upload-presentation #:selenium)) 3 | -------------------------------------------------------------------------------- /package.lisp: -------------------------------------------------------------------------------- 1 | ;;;; package.lisp 2 | 3 | (defpackage #:weblocks-ajax-file-upload-presentation 4 | (:use #:cl #:weblocks) 5 | (:export #:ajax-file-upload-presentation #:ajax-file-upload #:ajax-file-upload-parser)) 6 | 7 | -------------------------------------------------------------------------------- /weblocks-ajax-file-upload-presentation.asd: -------------------------------------------------------------------------------- 1 | (asdf:defsystem #:weblocks-ajax-file-upload-presentation 2 | :serial t 3 | :description "Weblocks presentation for ajax file uploads" 4 | :author "Olexiy Zamkoviy " 5 | :license "LLGPL" 6 | :version "0.0.8" 7 | :depends-on (#:weblocks #:yaclml #:weblocks-utils) 8 | :components ((:file "package") 9 | (:file "weblocks-ajax-file-upload-presentation"))) 10 | -------------------------------------------------------------------------------- /weblocks-ajax-file-upload-presentation-tests.asd: -------------------------------------------------------------------------------- 1 | ; Needed to load yaclml without warnings 2 | (when (find-package :xml) 3 | (delete-package :xml)) 4 | 5 | (asdf:defsystem #:weblocks-ajax-file-upload-presentation-tests 6 | :serial t 7 | :description "Tests for weblocks-ajax-file-upload-presentation" 8 | :author "Olexiy Zamkoviy " 9 | :license "LLGPL" 10 | :version "0.0.1" 11 | :depends-on (#:weblocks #:weblocks-ajax-file-upload-presentation #:weblocks-selenium-tests #:yaclml) 12 | :components 13 | ((:module tests 14 | :components 15 | ((:file "package") 16 | (:file "tests" :depends-on ("package")) 17 | (:file "tests-app-updates" :depends-on ("package")))))) 18 | 19 | -------------------------------------------------------------------------------- /tests/tests-app-updates.lisp: -------------------------------------------------------------------------------- 1 | (in-package :weblocks-ajax-file-upload-presentation-tests) 2 | 3 | (defun ajax-file-field-demonstration-action (&rest args) 4 | (do-page 5 | (make-quickform 6 | (defview 7 | nil 8 | (:caption "Ajax file form field demo" :type form :persistp nil :enctype "multipart/form-data" :use-ajax-p t) 9 | (file 10 | :present-as ajax-file-upload 11 | :parse-as (ajax-file-upload 12 | :upload-directory (weblocks-selenium-tests-app::get-upload-directory) 13 | :file-name :unique) 14 | :writer (lambda (value item))))))) 15 | 16 | (weblocks-selenium-tests-app::define-demo-action "Ajax file upload" #'ajax-file-field-demonstration-action :prototype-engine-p nil) 17 | -------------------------------------------------------------------------------- /tests/tests.lisp: -------------------------------------------------------------------------------- 1 | (in-package :weblocks-ajax-file-upload-presentation-tests) 2 | 3 | (def-test-suite weblocks-ajax-file-upload-presentation-tests) 4 | 5 | (deftest uploads-file-with-ajax () 6 | (weblocks-selenium-tests:require-firefox 7 | (let ((old-files-list (cl-fad:list-directory (weblocks-selenium-tests-app::get-upload-directory))) 8 | (new-files-list)) 9 | (with-new-or-existing-selenium-session-on-jquery-site 10 | (do-click-and-wait "link=Ajax file upload") 11 | (selenium:do-attach-file "name=file" (format nil "~A/pub/test-data/test-file" (string-right-trim "/" *site-root-url*))) 12 | (do-click-and-wait "name=submit") 13 | (setf new-files-list (cl-fad:list-directory (weblocks-selenium-tests-app::get-upload-directory))) 14 | (is (= (length new-files-list) 15 | (1+ (length old-files-list)))) 16 | (mapcar #'delete-file new-files-list))))) 17 | -------------------------------------------------------------------------------- /README.txt: -------------------------------------------------------------------------------- 1 | This is weblocks ajax file upload presentation. It just uploads file before actual submitting form using ajax. 2 | It was tested only with single file at a form and and single upload form. 3 | Here is example of using. 4 | 5 | (defun get-upload-directory () 6 | (merge-pathnames 7 | (make-pathname :directory '(:relative "upload")) 8 | (compute-webapp-public-files-path (weblocks:get-webapp 'my-webapp)))) 9 | 10 | (defview 'upload-form-view 11 | (:type form 12 | :caption "" 13 | :buttons '((:submit . "Upload file") (:cancel . "Close")) 14 | :persistp nil 15 | :enctype "multipart/form-data" 16 | :use-ajax-p t) 17 | (upload-image :present-as (ajax-file-upload) 18 | :parse-as (ajax-file-upload 19 | :upload-directory (get-upload-directory) 20 | :file-name :unique) 21 | :reader (lambda (item) 22 | nil) 23 | :writer (lambda (value object) 24 | (when value 25 | (push value (slot-value item 'files)))))) 26 | 27 | It works with jquery-iframe-transport (http://cmlenz.github.com/jquery-iframe-transport/), for me it worked after google-chrome fix (https://github.com/html/jquery-iframe-transport/tree/google-chrome-fix) 28 | 29 | Package uses weblocks assets so all dependencies should be installed automatically. 30 | -------------------------------------------------------------------------------- /weblocks-ajax-file-upload-presentation.lisp: -------------------------------------------------------------------------------- 1 | ;;;; weblocks-ajax-file-upload-presentation.lisp 2 | 3 | (in-package #:weblocks-ajax-file-upload-presentation) 4 | 5 | (defclass ajax-file-upload-presentation (file-upload-presentation) 6 | ()) 7 | 8 | (defclass ajax-file-upload-parser (file-upload-parser) 9 | ()) 10 | 11 | (defmethod parse-view-field-value :around ((parser ajax-file-upload-parser) value obj 12 | (view form-view) (field form-view-field) &rest args) 13 | (let* ((original-filename (third (webapp-session-value 'upload-file-post-information))) 14 | (return (multiple-value-list 15 | (apply #'call-next-method 16 | (list* parser (list 17 | (and (webapp-session-value 'upload-file-pathname) original-filename 18 | (list (webapp-session-value 'upload-file-pathname) original-filename)) obj view field args)))))) 19 | (delete-webapp-session-value 'upload-file-post-information) 20 | (delete-webapp-session-value 'upload-file-pathname) 21 | (apply #'values return))) 22 | 23 | (defun weblocks-supports-jquery-p () 24 | t) 25 | 26 | (defmacro with-yaclml (&body body) 27 | "A wrapper around cl-yaclml with-yaclml-stream macro." 28 | `(yaclml:with-yaclml-stream *weblocks-output-stream* 29 | ,@body)) 30 | 31 | (defun first-uploaded-file-data () 32 | (loop for i in (hunchentoot:post-parameters*) if (listp (cdr i)) do 33 | (return-from first-uploaded-file-data i))) 34 | 35 | (defun file-upload-endpoint (&rest args) 36 | (declare (special hunchentoot::*tmp-files*)) 37 | (setf hunchentoot::*tmp-files* (remove (webapp-session-value 'upload-file-pathname) hunchentoot::*tmp-files*)) 38 | (let ((file-size (with-open-file (file (webapp-session-value 'upload-file-pathname)) (file-length file)))) 39 | ; It didn't show correct content-length, setting it right to fix bug 40 | (setf (webapp-session-value 'upload-file-post-information) (first-uploaded-file-data)) 41 | (setf (webapp-session-value 'upload-file-content-length) file-size)) 42 | nil) 43 | 44 | (defun upload-ajax-progress-endpoint (&rest args) 45 | (setf (hunchentoot:header-out :content-type) "text/plain") 46 | (when (not (webapp-session-value 'upload-file-pathname)) 47 | (hunchentoot:abort-request-handler "{\"state\": \"error\", \"reason\":\"Upload not started\"}")) 48 | (let ((file-name (webapp-session-value 'upload-file-pathname)) 49 | (file-size)) 50 | (if (not (probe-file file-name)) 51 | (hunchentoot:abort-request-handler "{\"state\": \"error\"}") 52 | (progn 53 | (setf file-size (with-open-file (file file-name) (file-length file))) 54 | (if (= file-size (webapp-session-value 'upload-file-content-length)) 55 | (hunchentoot:abort-request-handler 56 | (format nil "{\"state\": \"done\"}")) 57 | (hunchentoot:abort-request-handler 58 | (format nil "{\"state\": \"uploading\", \"received\": ~A, \"size\": ~A}" file-size (webapp-session-value 'upload-file-content-length)))))))) 59 | 60 | (defmethod render-view-field-value :around (value (presentation ajax-file-upload-presentation) 61 | (field form-view-field) (view form-view) widget obj 62 | &rest args &key intermediate-values &allow-other-keys) 63 | (if (weblocks-supports-jquery-p) 64 | (progn 65 | 66 | (weblocks-utils:require-assets 67 | "https://raw.github.com/html/weblocks-assets/master/jquery-iframe-transport/74e9e/") 68 | 69 | (send-script 70 | (ps:ps 71 | (with-scripts 72 | (ps:LISP 73 | (weblocks-utils:prepend-webapp-path 74 | "/pub/scripts/jquery.iframe-transport.js")) 75 | (lambda () 76 | (let* ((form (ps:chain (j-query "#ajax-upload-field") (parents "form"))) 77 | (on-submit-code (ps:chain form (attr "onsubmit"))) 78 | (form-action (ps:chain form (attr "action")))) 79 | ;"progressUrl" (ps:LISP (make-action-url (make-action #'upload-ajax-progress-endpoint "upload-endpoint"))) 80 | 81 | (flet ((execute-standard-form-action () 82 | (ps:chain form 83 | (attr "target" "_self") 84 | (attr "onsubmit" on-submit-code) 85 | (attr "action" form-action)) 86 | (set-timeout (lambda () 87 | (ps:chain form (submit))) 100))) 88 | (ps:chain 89 | form 90 | (attr "onsubmit" "") 91 | (attr "method" "POST") 92 | (attr "action" (ps:LISP 93 | (add-get-param-to-url 94 | (make-action-url 95 | (make-action #'file-upload-endpoint "upload-target")) 96 | "pure" "true"))) 97 | (bind "submit" (lambda () 98 | (if (not (string= (ps:chain (j-query "input:submit[clicked=true]") (attr "name")) "submit")) 99 | (execute-standard-form-action) 100 | (ps:chain 101 | j-query 102 | (ajax 103 | (ps:chain form (attr "action")) 104 | (ps:create 105 | :files (ps:chain form (find ":file")) 106 | :iframe t 107 | "dataType" "json")) 108 | (done (lambda () 109 | (execute-standard-form-action))))) 110 | nil))))))))) 111 | (with-yaclml 112 | (<:div :style "display:inline-block;" :id "ajax-upload-field" 113 | (<:input :type "file" :name (attributize-name (view-field-slot-name field)))))) 114 | (call-next-method))) 115 | 116 | ; Situation where upload-hook is already set not supported yet. 117 | (assert (not hunchentoot:*file-upload-hook*)) 118 | 119 | (setf hunchentoot:*file-upload-hook* 120 | (lambda (upload-pathname) 121 | (setf (webapp-session-value 'upload-file-pathname) upload-pathname) 122 | (setf (webapp-session-value 'upload-file-content-length) (parse-integer (hunchentoot:header-in* :content-length))) 123 | upload-pathname)) 124 | -------------------------------------------------------------------------------- /license.txt: -------------------------------------------------------------------------------- 1 | Preamble to the Gnu Lesser General Public License 2 | 3 | Copyright (c) 2000 Franz Incorporated, Berkeley, CA 94704 4 | 5 | The concept of the GNU Lesser General Public License version 2.1 6 | ("LGPL") has been adopted to govern the use and distribution of 7 | above-mentioned application. However, the LGPL uses terminology that 8 | is more appropriate for a program written in C than one written in 9 | Lisp. Nevertheless, the LGPL can still be applied to a Lisp program if 10 | certain clarifications are made. This document details those 11 | clarifications. Accordingly, the license for the open-source Lisp 12 | applications consists of this document plus the LGPL. Wherever there 13 | is a conflict between this document and the LGPL, this document takes 14 | precedence over the LGPL. 15 | 16 | A "Library" in Lisp is a collection of Lisp functions, data and 17 | foreign modules. The form of the Library can be Lisp source code (for 18 | processing by an interpreter) or object code (usually the result of 19 | compilation of source code or built with some other 20 | mechanisms). Foreign modules are object code in a form that can be 21 | linked into a Lisp executable. When we speak of functions we do so in 22 | the most general way to include, in addition, methods and unnamed 23 | functions. Lisp "data" is also a general term that includes the data 24 | structures resulting from defining Lisp classes. A Lisp application 25 | may include the same set of Lisp objects as does a Library, but this 26 | does not mean that the application is necessarily a "work based on the 27 | Library" it contains. 28 | 29 | The Library consists of everything in the distribution file set before 30 | any modifications are made to the files. If any of the functions or 31 | classes in the Library are redefined in other files, then those 32 | redefinitions ARE considered a work based on the Library. If 33 | additional methods are added to generic functions in the Library, 34 | those additional methods are NOT considered a work based on the 35 | Library. If Library classes are subclassed, these subclasses are NOT 36 | considered a work based on the Library. If the Library is modified to 37 | explicitly call other functions that are neither part of Lisp itself 38 | nor an available add-on module to Lisp, then the functions called by 39 | the modified Library ARE considered a work based on the Library. The 40 | goal is to ensure that the Library will compile and run without 41 | getting undefined function errors. 42 | 43 | It is permitted to add proprietary source code to the Library, but it 44 | must be done in a way such that the Library will still run without 45 | that proprietary code present. Section 5 of the LGPL distinguishes 46 | between the case of a library being dynamically linked at runtime and 47 | one being statically linked at build time. Section 5 of the LGPL 48 | states that the former results in an executable that is a "work that 49 | uses the Library." Section 5 of the LGPL states that the latter 50 | results in one that is a "derivative of the Library", which is 51 | therefore covered by the LGPL. Since Lisp only offers one choice, 52 | which is to link the Library into an executable at build time, we 53 | declare that, for the purpose applying the LGPL to the Library, an 54 | executable that results from linking a "work that uses the Library" 55 | with the Library is considered a "work that uses the Library" and is 56 | therefore NOT covered by the LGPL. 57 | 58 | Because of this declaration, section 6 of LGPL is not applicable to 59 | the Library. However, in connection with each distribution of this 60 | executable, you must also deliver, in accordance with the terms and 61 | conditions of the LGPL, the source code of Library (or your derivative 62 | thereof) that is incorporated into this executable. 63 | 64 | GNU LESSER GENERAL PUBLIC LICENSE 65 | Version 3, 29 June 2007 66 | 67 | Copyright (C) 2007 Free Software Foundation, Inc. 68 | Everyone is permitted to copy and distribute verbatim copies 69 | of this license document, but changing it is not allowed. 70 | 71 | 72 | This version of the GNU Lesser General Public License incorporates 73 | the terms and conditions of version 3 of the GNU General Public 74 | License, supplemented by the additional permissions listed below. 75 | 76 | 0. Additional Definitions. 77 | 78 | As used herein, "this License" refers to version 3 of the GNU Lesser 79 | General Public License, and the "GNU GPL" refers to version 3 of the GNU 80 | General Public License. 81 | 82 | "The Library" refers to a covered work governed by this License, 83 | other than an Application or a Combined Work as defined below. 84 | 85 | An "Application" is any work that makes use of an interface provided 86 | by the Library, but which is not otherwise based on the Library. 87 | Defining a subclass of a class defined by the Library is deemed a mode 88 | of using an interface provided by the Library. 89 | 90 | A "Combined Work" is a work produced by combining or linking an 91 | Application with the Library. The particular version of the Library 92 | with which the Combined Work was made is also called the "Linked 93 | Version". 94 | 95 | The "Minimal Corresponding Source" for a Combined Work means the 96 | Corresponding Source for the Combined Work, excluding any source code 97 | for portions of the Combined Work that, considered in isolation, are 98 | based on the Application, and not on the Linked Version. 99 | 100 | The "Corresponding Application Code" for a Combined Work means the 101 | object code and/or source code for the Application, including any data 102 | and utility programs needed for reproducing the Combined Work from the 103 | Application, but excluding the System Libraries of the Combined Work. 104 | 105 | 1. Exception to Section 3 of the GNU GPL. 106 | 107 | You may convey a covered work under sections 3 and 4 of this License 108 | without being bound by section 3 of the GNU GPL. 109 | 110 | 2. Conveying Modified Versions. 111 | 112 | If you modify a copy of the Library, and, in your modifications, a 113 | facility refers to a function or data to be supplied by an Application 114 | that uses the facility (other than as an argument passed when the 115 | facility is invoked), then you may convey a copy of the modified 116 | version: 117 | 118 | a) under this License, provided that you make a good faith effort to 119 | ensure that, in the event an Application does not supply the 120 | function or data, the facility still operates, and performs 121 | whatever part of its purpose remains meaningful, or 122 | 123 | b) under the GNU GPL, with none of the additional permissions of 124 | this License applicable to that copy. 125 | 126 | 3. Object Code Incorporating Material from Library Header Files. 127 | 128 | The object code form of an Application may incorporate material from 129 | a header file that is part of the Library. You may convey such object 130 | code under terms of your choice, provided that, if the incorporated 131 | material is not limited to numerical parameters, data structure 132 | layouts and accessors, or small macros, inline functions and templates 133 | (ten or fewer lines in length), you do both of the following: 134 | 135 | a) Give prominent notice with each copy of the object code that the 136 | Library is used in it and that the Library and its use are 137 | covered by this License. 138 | 139 | b) Accompany the object code with a copy of the GNU GPL and this license 140 | document. 141 | 142 | 4. Combined Works. 143 | 144 | You may convey a Combined Work under terms of your choice that, 145 | taken together, effectively do not restrict modification of the 146 | portions of the Library contained in the Combined Work and reverse 147 | engineering for debugging such modifications, if you also do each of 148 | the following: 149 | 150 | a) Give prominent notice with each copy of the Combined Work that 151 | the Library is used in it and that the Library and its use are 152 | covered by this License. 153 | 154 | b) Accompany the Combined Work with a copy of the GNU GPL and this license 155 | document. 156 | 157 | c) For a Combined Work that displays copyright notices during 158 | execution, include the copyright notice for the Library among 159 | these notices, as well as a reference directing the user to the 160 | copies of the GNU GPL and this license document. 161 | 162 | d) Do one of the following: 163 | 164 | 0) Convey the Minimal Corresponding Source under the terms of this 165 | License, and the Corresponding Application Code in a form 166 | suitable for, and under terms that permit, the user to 167 | recombine or relink the Application with a modified version of 168 | the Linked Version to produce a modified Combined Work, in the 169 | manner specified by section 6 of the GNU GPL for conveying 170 | Corresponding Source. 171 | 172 | 1) Use a suitable shared library mechanism for linking with the 173 | Library. A suitable mechanism is one that (a) uses at run time 174 | a copy of the Library already present on the user's computer 175 | system, and (b) will operate properly with a modified version 176 | of the Library that is interface-compatible with the Linked 177 | Version. 178 | 179 | e) Provide Installation Information, but only if you would otherwise 180 | be required to provide such information under section 6 of the 181 | GNU GPL, and only to the extent that such information is 182 | necessary to install and execute a modified version of the 183 | Combined Work produced by recombining or relinking the 184 | Application with a modified version of the Linked Version. (If 185 | you use option 4d0, the Installation Information must accompany 186 | the Minimal Corresponding Source and Corresponding Application 187 | Code. If you use option 4d1, you must provide the Installation 188 | Information in the manner specified by section 6 of the GNU GPL 189 | for conveying Corresponding Source.) 190 | 191 | 5. Combined Libraries. 192 | 193 | You may place library facilities that are a work based on the 194 | Library side by side in a single library together with other library 195 | facilities that are not Applications and are not covered by this 196 | License, and convey such a combined library under terms of your 197 | choice, if you do both of the following: 198 | 199 | a) Accompany the combined library with a copy of the same work based 200 | on the Library, uncombined with any other library facilities, 201 | conveyed under the terms of this License. 202 | 203 | b) Give prominent notice with the combined library that part of it 204 | is a work based on the Library, and explaining where to find the 205 | accompanying uncombined form of the same work. 206 | 207 | 6. Revised Versions of the GNU Lesser General Public License. 208 | 209 | The Free Software Foundation may publish revised and/or new versions 210 | of the GNU Lesser General Public License from time to time. Such new 211 | versions will be similar in spirit to the present version, but may 212 | differ in detail to address new problems or concerns. 213 | 214 | Each version is given a distinguishing version number. If the 215 | Library as you received it specifies that a certain numbered version 216 | of the GNU Lesser General Public License "or any later version" 217 | applies to it, you have the option of following the terms and 218 | conditions either of that published version or of any later version 219 | published by the Free Software Foundation. If the Library as you 220 | received it does not specify a version number of the GNU Lesser 221 | General Public License, you may choose any version of the GNU Lesser 222 | General Public License ever published by the Free Software Foundation. 223 | 224 | If the Library as you received it specifies that a proxy can decide 225 | whether future versions of the GNU Lesser General Public License shall 226 | apply, that proxy's public statement of acceptance of any version is 227 | permanent authorization for you to choose that version for the 228 | Library. 229 | --------------------------------------------------------------------------------