diff options
Diffstat (limited to 'file')
| -rw-r--r-- | file/file-browser.lisp | 72 | ||||
| -rw-r--r-- | file/file-utils.lisp | 28 | ||||
| -rw-r--r-- | file/generics.lisp | 17 |
3 files changed, 117 insertions, 0 deletions
diff --git a/file/file-browser.lisp b/file/file-browser.lisp new file mode 100644 index 0000000..4694374 --- /dev/null +++ b/file/file-browser.lisp @@ -0,0 +1,72 @@ +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +(declaim (optimize (speed 0) (safety 3) (debug 3))) + +(in-package #:music-dispensary) + +;; ========================================================================== ;; + +(defclass file-browser () + ((document-root :initarg :document-root + :initform nil + :accessor document-root + :documentation "The highest level directory that the +user is allowed to navigate to. Ends in a slash.") + (relative-path :initarg :relative-path + :initform nil + :accessor relative-path + :documentation "Add this to `document-root' +to get to the current directory, whose contents are to be +displayed.") + (mime-extensions :initarg :mime-extensions + :initform nil + :accessor mime-extensions + :documentation "A list of MIME file extensions +that, if not `nil', will limit directory listings to show only those +files that contain these extensions.") + (nodes :initarg :nodes + :initform () + :accessor nodes + :documentation "The nodes of the current directory. A list +of dotted pairs in the form '(([:directory|:file|:symlink] . <node-name>)).")) + (:documentation "Used for directory-browsing. Keeps track of +directory-navigating state in the `user-session'.")) + +(defmethod absolute-path ((file-browser file-browser)) + (ppcre:regex-replace-all "//" + (format nil "~a/~a" (or (document-root file-browser) "") (or (relative-path file-browser) "")) + "/")) + +(defmethod update-relative-path ((file-browser file-browser) node) + (when (not (null-or-empty-p node)) + (if (equal node "..") + (if (null-or-empty-p (relative-path file-browser)) + (setf (relative-path file-browser) "") + (setf (relative-path file-browser) (let ((path-list (nreverse (remove-if 'null-or-empty-p (ppcre:split "/" (relative-path file-browser))))) + (new-path "")) + (pop path-list) + (loop for path-part in (nreverse path-list) do + (setf new-path (format nil "~a~a/" new-path path-part))) + (ppcre:regex-replace-all "/$" new-path "")))) + (if (null-or-empty-p (relative-path file-browser)) + (setf (relative-path file-browser) node) + (setf (relative-path file-browser) (format nil "~a/~a" (relative-path file-browser) node)))))) + +(defmethod directory-list ((file-browser file-browser)) + (labels ((finder (type) + (remove-if 'null (mapcar (lambda (line) + (when (not (or (equal line "."))) + (let ((item (ppcre:regex-replace-all "\\./" line ""))) + (when (or (null (mime-extensions file-browser)) + (equal type "d") + (remove-if-not (lambda (x) + (match-it (format nil "~a$" x) item)) + (mime-extensions file-browser))) + (cons (cond ((equal type "d") :directory) + ((equal type "f") :file) + ((equal type "l") :symlink)) + item))))) + (shell-wrapper (format nil + "pushd '~a' >/dev/null ; find -maxdepth 1 -type ~a | sort ; popd >/dev/null" + (absolute-path file-browser) + type)))))) + (setf (nodes file-browser) (remove-if 'null (append `((:directory . "..")) (finder "d") (finder "f") (finder "l")))))) diff --git a/file/file-utils.lisp b/file/file-utils.lisp new file mode 100644 index 0000000..604a20f --- /dev/null +++ b/file/file-utils.lisp @@ -0,0 +1,28 @@ +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +(declaim (optimize (speed 0) (safety 3) (debug 3))) + +(in-package #:music-dispensary) + +;; ========================================================================== ;; + +(defun mkdir (path) + (uffi:run-shell-command (format nil "mkdir -p ~a" path))) + +(defun file-exists-p (file-path) + (equal (car (shell-wrapper (format nil "if test -f '~a'; then echo 0; else echo 1; fi" file-path))) "0")) + +(defun directory-p (absolute-path) + (if (car (shell-wrapper (format nil "file '~a' |grep 'directory'" absolute-path))) t nil)) + +(defun symlink-p (absolute-path) + (if (car (shell-wrapper (format nil "file '~a' |grep 'symbolic link'" absolute-path))) t nil)) + +(defun file-p (absolute-path) + (if (or (directory-p absolute-path) (symlink-p absolute-path)) nil t)) + +(defun find-files (working-dir base-dir pattern) + (shell-wrapper (format nil + "pushd ~a >/dev/null 2>&1 ; find ~a -iname '~a' ; popd >/dev/null 2>&1" + working-dir + base-dir + pattern))) diff --git a/file/generics.lisp b/file/generics.lisp new file mode 100644 index 0000000..a4dea2f --- /dev/null +++ b/file/generics.lisp @@ -0,0 +1,17 @@ +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +(declaim (optimize (speed 0) (safety 3) (debug 3))) + +(in-package #:music-dispensary) + +;; ========================================================================== ;; + +(defgeneric absolute-path (file-browser) + (:documentation "Returns the absolute path of `file-browser'.")) + +(defgeneric update-relative-path (file-browser node) + (:documentation "Updates `relative-path' of `file-browser' by adding +a `node' to it. If `node' is '..', `relative-path' is reduced a +level.")) + +(defgeneric directory-list (file-browser) + (:documentation "")) |