(uiop:define-package #:ambrevar/file (:documentation "File class.") (:use #:common-lisp) (:use #:trivia) (:import-from #:hu.dwim.defclass-star #:defclass*) (:import-from #:serapeum #:export-always)) (in-package #:ambrevar/file) (eval-when (:compile-toplevel :load-toplevel :execute) (trivial-package-local-nicknames:add-package-local-nickname :alex :alexandria) (trivial-package-local-nicknames:add-package-local-nickname :sera :serapeum)) (sera:eval-always (defun name-identity (name definition) (declare (ignore definition)) name)) (defclass* file () ((path (error "Path required") :type string) (inode 0) (link-count 0) (kind :regular-file ; "kind" because `type' is reserved by CL. :type (member :directory :character-device :block-device :regular-file :symbolic-link :socket :pipe)) (size 0) (user-id 0) (group-id 0) ;; TODO: Include blocks? (creation-date (local-time:unix-to-timestamp 0)) (modification-date (local-time:unix-to-timestamp 0)) (access-date (local-time:unix-to-timestamp 0)) (permissions '() :type (or null (cons #.(cons 'member (mapcar #'first osicat::+permissions+)))))) (:accessor-name-transformer #'name-identity)) (export-always 'extension) (defmethod extension ((file file)) "Return the file extension. If none, return the empty string unlike `pathname-type'." (or (pathname-type (path file)) "")) (defmethod directory? ((file file)) (eq (kind file) :directory)) (defmethod file? ((file file)) (eq (kind file) :regular-file)) (defun separator (&optional char?) (if char? (uiop:directory-separator-for-host) (string (uiop:directory-separator-for-host)))) (export-always 'basename) (defmethod basename ((file file)) "Return the file basename (including the extension). This returns the directory name for directories." (let* ((path (path file)) (path (if (str:ends-with? (separator) path) (subseq path 0 (1- (length path))) path)) (last-separator (position (separator :char) path :from-end t))) (subseq path (1+ last-separator)))) (defmethod print-object ((file file) stream) (print-unreadable-object (file stream :type t :identity t) (write-string (str:concat (basename file) (when (directory? file) "/")) stream))) (export-always 'file) (defun file (path) (let ((native-path (uiop:truename* (if (pathnamep path) path (uiop:parse-native-namestring path))))) (assert (or (uiop:file-exists-p native-path) (uiop:directory-exists-p native-path))) (let ((stat (osicat-posix:stat native-path))) ;; From Osicat's `file-permissions': (flet ((stat-permissions (stat) (let ((mode (osicat-posix:stat-mode stat))) (loop for (name . value) in osicat::+permissions+ when (plusp (logand mode value)) collect name)))) (make-instance 'file :path (uiop:unix-namestring native-path) :inode (osicat-posix:stat-ino stat) :link-count (osicat-posix:stat-nlink stat) :kind (osicat:file-kind native-path) ; TODO: Don't recall `stat'. :size (osicat-posix:stat-size stat) :user-id (osicat-posix:stat-uid stat) :group-id (osicat-posix:stat-gid stat) :creation-date (local-time:unix-to-timestamp (osicat-posix:stat-ctime stat)) :modification-date (local-time:unix-to-timestamp (osicat-posix:stat-mtime stat)) :access-date (local-time:unix-to-timestamp (osicat-posix:stat-atime stat)) :permissions (stat-permissions stat))))))