ambrevar: Move magic mime to a file+mime class and methods.
parent
7ae87c82d4
commit
e6e0d806d2
|
@ -77,10 +77,11 @@ This returns the directory name for directories."
|
||||||
stream)))
|
stream)))
|
||||||
|
|
||||||
(export-always 'file)
|
(export-always 'file)
|
||||||
(defun file (path)
|
(defmethod initialize-instance :after ((file file) &key)
|
||||||
(let ((native-path (uiop:truename* (if (pathnamep path)
|
(let* ((path (path file))
|
||||||
path
|
(native-path (uiop:truename* (if (pathnamep path)
|
||||||
(uiop:parse-native-namestring path)))))
|
path
|
||||||
|
(uiop:parse-native-namestring path)))))
|
||||||
(assert (or (uiop:file-exists-p native-path)
|
(assert (or (uiop:file-exists-p native-path)
|
||||||
(uiop:directory-exists-p native-path)))
|
(uiop:directory-exists-p native-path)))
|
||||||
;; TODO: What do we do with non-existent files (e.g. unsaved emacs buffers)? Just return nil?
|
;; TODO: What do we do with non-existent files (e.g. unsaved emacs buffers)? Just return nil?
|
||||||
|
@ -92,18 +93,21 @@ This returns the directory name for directories."
|
||||||
(loop for (name . value) in osicat::+permissions+
|
(loop for (name . value) in osicat::+permissions+
|
||||||
when (plusp (logand mode value))
|
when (plusp (logand mode value))
|
||||||
collect name))))
|
collect name))))
|
||||||
(make-instance 'file
|
(setf
|
||||||
:path (uiop:unix-namestring native-path)
|
(path file) (uiop:unix-namestring native-path)
|
||||||
:inode (osicat-posix:stat-ino stat)
|
(inode file) (osicat-posix:stat-ino stat)
|
||||||
:link-count (osicat-posix:stat-nlink stat)
|
(link-count file) (osicat-posix:stat-nlink stat)
|
||||||
:kind (osicat:file-kind native-path) ; TODO: Don't recall `stat'.
|
(kind file) (osicat:file-kind native-path) ; TODO: Don't recall `stat'.
|
||||||
:size (osicat-posix:stat-size stat)
|
(size file) (osicat-posix:stat-size stat)
|
||||||
:user-id (osicat-posix:stat-uid stat)
|
(user-id file) (osicat-posix:stat-uid stat)
|
||||||
:group-id (osicat-posix:stat-gid stat)
|
(group-id file) (osicat-posix:stat-gid stat)
|
||||||
:creation-date (local-time:unix-to-timestamp (osicat-posix:stat-ctime stat))
|
(creation-date file) (local-time:unix-to-timestamp (osicat-posix:stat-ctime stat))
|
||||||
:modification-date (local-time:unix-to-timestamp (osicat-posix:stat-mtime stat))
|
(modification-date file) (local-time:unix-to-timestamp (osicat-posix:stat-mtime stat))
|
||||||
:access-date (local-time:unix-to-timestamp (osicat-posix:stat-atime stat))
|
(access-date file) (local-time:unix-to-timestamp (osicat-posix:stat-atime stat))
|
||||||
:permissions (stat-permissions stat)))))))
|
(permissions file) (stat-permissions stat)))))))
|
||||||
|
|
||||||
|
(defun file (path)
|
||||||
|
(make-instance 'file :path path))
|
||||||
|
|
||||||
(export-always 'list-directory)
|
(export-always 'list-directory)
|
||||||
(defun list-directory (&optional (path *default-pathname-defaults*) sort)
|
(defun list-directory (&optional (path *default-pathname-defaults*) sort)
|
||||||
|
@ -162,3 +166,52 @@ Without PREDICATES, list all files."
|
||||||
"Return a file predicate that matches on modification time #'> than timestamp."
|
"Return a file predicate that matches on modification time #'> than timestamp."
|
||||||
(lambda (file)
|
(lambda (file)
|
||||||
(local-time:timestamp> (modification-date file) timestamp)))
|
(local-time:timestamp> (modification-date file) timestamp)))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
(defparameter %magic-cookie-mime nil
|
||||||
|
"Internal storage for `magic-cookie-mime'.")
|
||||||
|
(defun magic-cookie-mime ()
|
||||||
|
"Return internal, persistent MIME cookie for `magicffi' calls.
|
||||||
|
Benchmark on thousands of files shows that
|
||||||
|
keeping the same cookie saves about 15% of time. "
|
||||||
|
(when (or (not %magic-cookie-mime)
|
||||||
|
(not (magicffi:open-magic-p %magic-cookie-mime)))
|
||||||
|
(setf %magic-cookie-mime (magicffi:magic-open '(:symlink :mime)))
|
||||||
|
(magicffi:magic-load %magic-cookie-mime))
|
||||||
|
%magic-cookie-mime)
|
||||||
|
|
||||||
|
(defparameter %magic-cookie-description nil
|
||||||
|
"Internal storage for `magic-cookie-description'.")
|
||||||
|
(defun magic-cookie-description ()
|
||||||
|
"Same as `magic-cooke-mime' but for `file' descriptions.
|
||||||
|
See `%description'."
|
||||||
|
(when (or (not %magic-cookie-description)
|
||||||
|
(not (magicffi:open-magic-p %magic-cookie-description)))
|
||||||
|
(setf %magic-cookie-description (magicffi:magic-open '(:symlink)))
|
||||||
|
(magicffi:magic-load %magic-cookie-description))
|
||||||
|
%magic-cookie-description)
|
||||||
|
|
||||||
|
(defun %mime-type+encoding (path)
|
||||||
|
"Return a pair of MIME type and MIME encoding for PATH."
|
||||||
|
(str:split "; "
|
||||||
|
(magicffi:magic-file (magic-cookie-mime) path)))
|
||||||
|
|
||||||
|
(defun %description (path)
|
||||||
|
"Return the PATH description as per the `file' UNIX command."
|
||||||
|
(magicffi:magic-file (magic-cookie-description) path))
|
||||||
|
|
||||||
|
;; TODO: Include the description or do it in another class? Could be slower. Benchmark.
|
||||||
|
(defclass* file+mime (file)
|
||||||
|
((mime-type "")
|
||||||
|
(mime-encoding "")
|
||||||
|
(description ""))
|
||||||
|
(:accessor-name-transformer #'name-identity))
|
||||||
|
|
||||||
|
(defmethod initialize-instance :after ((file file+mime) &key)
|
||||||
|
(let ((mime-type+encoding (%mime-type+encoding (path file))))
|
||||||
|
(setf (mime-type file) (first mime-type+encoding)
|
||||||
|
(mime-encoding file) (second mime-type+encoding)
|
||||||
|
(description file) (%description (path file)))))
|
||||||
|
|
||||||
|
(defun file+mime (path)
|
||||||
|
(make-instance 'file+mime :path path))
|
||||||
|
|
|
@ -25,38 +25,6 @@
|
||||||
(delete-if #'sera:resolve-executable (cons program more-programs))))
|
(delete-if #'sera:resolve-executable (cons program more-programs))))
|
||||||
(error "Missing programs: ~{~a~,^, ~}" missing-programs)))
|
(error "Missing programs: ~{~a~,^, ~}" missing-programs)))
|
||||||
|
|
||||||
|
|
||||||
(defvar %magic-cookie-mime-type (magicffi:magic-open '(:symlink :mime-type))
|
|
||||||
"Internal, persistent cookie for `magicffi' calls.
|
|
||||||
|
|
||||||
Benchmark on thousands of files shows that
|
|
||||||
keeping the same cookie saves about 15% of time.")
|
|
||||||
(magicffi:magic-load %magic-cookie-mime-type)
|
|
||||||
|
|
||||||
(defvar %magic-cookie-mime (magicffi:magic-open '(:symlink :mime))
|
|
||||||
"See `%magic-cookie-mime-type'. ")
|
|
||||||
(magicffi:magic-load %magic-cookie-mime)
|
|
||||||
|
|
||||||
(defvar %magic-cookie-description (magicffi:magic-open '(:symlink))
|
|
||||||
"See `%magic-cookie-mime-type'. ")
|
|
||||||
(magicffi:magic-load %magic-cookie-description)
|
|
||||||
|
|
||||||
(export-always 'file-mime-type)
|
|
||||||
(defun file-mime-type (file)
|
|
||||||
"Return the FILE MIME type."
|
|
||||||
(magicffi:magic-file %magic-cookie-mime-type file))
|
|
||||||
|
|
||||||
(export-always 'file-mime)
|
|
||||||
(defun file-mime (file)
|
|
||||||
"Return a pair of MIME type and MIME encoding for FILE."
|
|
||||||
(str:split "; "
|
|
||||||
(magicffi:magic-file %magic-cookie-mime file)))
|
|
||||||
|
|
||||||
(export-always 'file-description)
|
|
||||||
(defun file-description (file)
|
|
||||||
"Return the FILE description as per the `file' UNIX command."
|
|
||||||
(magicffi:magic-file %magic-cookie-description file))
|
|
||||||
|
|
||||||
(export-always 'match-extensions)
|
(export-always 'match-extensions)
|
||||||
(defun match-extensions (extension &rest more-extensions)
|
(defun match-extensions (extension &rest more-extensions)
|
||||||
"Return a predicate for files that match on of the provided extensions.
|
"Return a predicate for files that match on of the provided extensions.
|
||||||
|
|
Loading…
Reference in New Issue