Finish trashinfo.lisp
This commit is contained in:
18
package.lisp
18
package.lisp
@ -11,4 +11,20 @@
|
||||
(:documentation
|
||||
"Parser and utility functions for dealing with .trashinfo files.")
|
||||
(:use :cl)
|
||||
(:export))
|
||||
(:import-from #:cl-xdg-trash/url-encode
|
||||
#:url-encode
|
||||
#:url-decode)
|
||||
(:export #:trashinfo-format-error
|
||||
#:trashinfo-format-error-message
|
||||
#:trashinfo-format-error-line-numer
|
||||
#:trashinfo-format-error-context
|
||||
#:trashinfo-format-error-source-file
|
||||
#:trashinfo
|
||||
#:trashinfo-trash-directory
|
||||
#:trashinfo-name
|
||||
#:trashinfo-path
|
||||
#:trashinfo-deletion-date
|
||||
#:trashinfo-trashed-file
|
||||
#:parse-trashinfo-from-stream
|
||||
#:parse-trashinfo-file
|
||||
#:format-trashinfo))
|
||||
|
158
trashinfo.lisp
158
trashinfo.lisp
@ -1,6 +1,6 @@
|
||||
(in-package :cl-xdg-trash/trashinfo)
|
||||
|
||||
(define-condition trashinfo-format-error (error)
|
||||
(define-condition trashinfo-format-error (parse-error)
|
||||
((message :accessor trashinfo-format-error-message
|
||||
:initarg :message
|
||||
:type string
|
||||
@ -29,44 +29,150 @@ line 1.")
|
||||
:type pathname
|
||||
:documentation "The path to the trash directory that this
|
||||
trashinfo file belongs to.")
|
||||
(name :accessor trashinfo-name
|
||||
(name :reader trashinfo-name
|
||||
:initarg :name
|
||||
:type string
|
||||
:documentation "The name of this trashinfo file without the extension.")
|
||||
(path :accessor trashinfo-path
|
||||
(path :reader trashinfo-path
|
||||
:initarg :path
|
||||
:type pathname
|
||||
:documentation "Path to the original location of the file.")
|
||||
(deletion-date :accessor trashinfo-deletion-date
|
||||
(deletion-date :reader trashinfo-deletion-date
|
||||
:initarg :deletion-date
|
||||
:type local-time:timestamp
|
||||
:documentation "The time the corresponding file was
|
||||
trashed."))
|
||||
(:documentation "Represents a .trashinfo file."))
|
||||
|
||||
(declaim (ftype (function ((or pathname string) string) trashinfo)))
|
||||
(defun parse-trashinfo-from-string (trash-directory name)
|
||||
"Parse the trashinfo file NAME (which should not have an extension) in
|
||||
TRASH-DIRECTORY."
|
||||
(let ((source-file (merge-pathnames (make-pathname :name name
|
||||
:directory '(:relative "info"))
|
||||
trash-directory)))
|
||||
(with-open-file (in source-file :if-does-not-exist :error)
|
||||
(let ((first-line (read-line in :eof-error-p nil)))
|
||||
(unless first-line
|
||||
(error 'trashinfo-format-error
|
||||
:line-number 1 :source-file source-file
|
||||
:context "" :message "Unexpected end-of-file"))
|
||||
(unless (equal first-line "[Trash Info]")
|
||||
(error 'trashinfo-format-error
|
||||
:line-number 1 :source-file source-file
|
||||
:context first-line
|
||||
:message "First line should be \"[Trash Info]\"")))
|
||||
(loop for line = (read-line in :eof-error-p nil)
|
||||
while line)
|
||||
)))
|
||||
(defmethod trashinfo-trashed-file ((trashinfo trashinfo))
|
||||
(with-slots (name trash-directory) trashinfo
|
||||
(merge-pathnames (make-pathname :name name :directory '(:relative "files"))
|
||||
trash-directory)))
|
||||
|
||||
(defmethod trashinfo-trashed-file ())
|
||||
(declaim (ftype (function (string &key (:start integer) (:end integer))
|
||||
local-time:timestamp)))
|
||||
(defun parse-trashinfo-timestamp (line &key (start 0) (end (length line)))
|
||||
"Pase a timestamp in the trashinfo file timestamp format."
|
||||
(flet ((next-int (length)
|
||||
(declare (type (integer 0) length))
|
||||
(when (> 0 (- end start length))
|
||||
(error 'parse-error))
|
||||
(prog1 (parse-integer line :start start :end (+ start length))
|
||||
(incf start length)))
|
||||
(next-str (text)
|
||||
(declare (type string text))
|
||||
(when (> 0 (- end start (length text)))
|
||||
(error 'parse-error))
|
||||
(unless (string= line text :start1 start
|
||||
:end1 (+ start (length text)))
|
||||
(error 'parse-error))
|
||||
(incf start (length text))))
|
||||
(let (year month day hour minute second)
|
||||
(setq year (next-int 4))
|
||||
(next-str "-")
|
||||
(setq month (next-int 2))
|
||||
(next-str "-")
|
||||
(setq day (next-int 2))
|
||||
(next-str "T")
|
||||
(setq hour (next-int 2))
|
||||
(next-str ":")
|
||||
(setq minute (next-int 2))
|
||||
(next-str ":")
|
||||
(setq second (next-int 2))
|
||||
(local-time:encode-timestamp 0 second minute hour day month year))))
|
||||
|
||||
(declaim (ftype (function (pathname string) pathname) compute-trashinfo-source-file))
|
||||
(defun compute-trashinfo-source-file (trash-directory name)
|
||||
"Return the pathname object for the actual trashinfo file corresponding to the
|
||||
trashed file NAME in TRASH-DIRECTORY."
|
||||
(merge-pathnames (make-pathname :name name :type "trashinfo"
|
||||
:directory '(:relative "info"))
|
||||
trash-directory))
|
||||
|
||||
(declaim (ftype (function (pathname string stream &key (:source-file pathname))
|
||||
trashinfo)
|
||||
parse-trashinfo-from-stream))
|
||||
(defun parse-trashinfo-from-stream
|
||||
(trash-directory name in
|
||||
&key (source-file (compute-trashinfo-source-file trash-directory name)))
|
||||
"Parse the stream IN as a trashinfo file."
|
||||
(let ((first-line (read-line in :eof-error-p nil)))
|
||||
(unless first-line
|
||||
(error 'trashinfo-format-error
|
||||
:line-number 1 :source-file source-file
|
||||
:context "" :message "Unexpected end-of-file"))
|
||||
(unless (equal first-line "[Trash Info]")
|
||||
(error 'trashinfo-format-error
|
||||
:line-number 1 :source-file source-file
|
||||
:context first-line
|
||||
:message "First line should be \"[Trash Info]\"")))
|
||||
(loop with path = nil
|
||||
with deletion-date = nil
|
||||
for line-number upfrom 2
|
||||
for line = (read-line in nil)
|
||||
while (and line (not (and path deletion-date)))
|
||||
for delim = (position #\= line)
|
||||
when delim
|
||||
do (cond
|
||||
((and (not path)
|
||||
(string= line "Path" :end1 delim))
|
||||
(setq path (url-decode line :start (1+ delim))))
|
||||
((and (not deletion-date)
|
||||
(string= line "DeletionDate" :end1 delim))
|
||||
(handler-case
|
||||
(setq deletion-date
|
||||
(parse-trashinfo-timestamp line
|
||||
:start (1+ delim)))
|
||||
(parse-error ()
|
||||
(error 'trashinfo-format-error
|
||||
:line-number line-number :context line
|
||||
:source-file source-file
|
||||
:message "Invalid timestamp")))))
|
||||
finally
|
||||
(if (not (and path deletion-date))
|
||||
(error 'trashinfo-format-error
|
||||
:line-number line-number
|
||||
:context "" :source-file source-file
|
||||
:message
|
||||
"End-of-file without both \"Path\" and \"DeletionDate\"")
|
||||
(return (make-instance 'trashinfo
|
||||
:deletion-date deletion-date
|
||||
:path path :name name
|
||||
:trash-directory trash-directory)))))
|
||||
|
||||
(declaim (ftype (function ((or pathname string) string) trashinfo)))
|
||||
(defun parse-trashinfo-file
|
||||
(trash-directory name
|
||||
&key (source-file (compute-trashinfo-source-file trash-directory name)))
|
||||
"Parse the trashinfo file NAME (which should not have an extension) in
|
||||
TRASH-DIRECTORY. If SOURCE-FILE is not provided, it will be calculated."
|
||||
(with-open-file (in source-file :if-does-not-exist :error)
|
||||
(parse-trashinfo-from-stream trash-directory name in
|
||||
:source-file source-file)))
|
||||
|
||||
(declaim (ftype (function (local-time:timestamp &optional
|
||||
(or stream null (eql t)))
|
||||
(or string null))
|
||||
format-trashinfo-timestamp))
|
||||
(defun format-trashinfo-timestamp (stamp &optional stream)
|
||||
"Format STAMP for writing to a trashinfo file."
|
||||
(format stream "~4,'0D-~2,'0D-~2,'0DT~2,'0D:~2,'0D:~2,'0D"
|
||||
(local-time:timestamp-year stamp)
|
||||
(local-time:timestamp-month stamp)
|
||||
(local-time:timestamp-day stamp)
|
||||
(local-time:timestamp-hour stamp)
|
||||
(local-time:timestamp-minute stamp)
|
||||
(local-time:timestamp-second stamp)))
|
||||
|
||||
(declaim (ftype (function (trashinfo &optional (or stream null (eql t)))
|
||||
(or string null))
|
||||
format-trashinfo))
|
||||
(defun format-trashinfo (trashinfo &optional stream)
|
||||
"Write the trashinfo file out to STREAM."
|
||||
(with-slots (path deletion-date) trashinfo
|
||||
(format stream "[Trash Info]~%Path=~A~%DeletionDate=~A~%"
|
||||
(url-encode path :safe-chars '(#\/))
|
||||
(format-trashinfo-timestamp deletion-date))))
|
||||
|
||||
|
||||
;; Local Variables:
|
||||
|
@ -11,7 +11,9 @@
|
||||
(or (and (>= code (char-code #\a))
|
||||
(<= code (char-code #\z)))
|
||||
(and (>= code (char-code #\A))
|
||||
(<= code (char-code #\Z)))))))
|
||||
(<= code (char-code #\Z)))
|
||||
(and (>= code (char-code #\0))
|
||||
(<= code (char-code #\9)))))))
|
||||
|
||||
(deftype utf-8-code-point ()
|
||||
'(integer 0 #x10FFFF))
|
||||
@ -73,17 +75,26 @@ represent."
|
||||
;; 1 byte
|
||||
(t part1)))))
|
||||
|
||||
(declaim (ftype (function (character) string) escape-char-for-url))
|
||||
(defun escape-char-for-url (char)
|
||||
(declaim (ftype (function (character &key (:safe-chars list)) list)
|
||||
escape-char-for-url))
|
||||
(defun escape-char-for-url (char &key safe-chars)
|
||||
"Escape CHAR such that it is safe to include in a URL."
|
||||
(if (url-unreserved-character-p char)
|
||||
(string char)
|
||||
(format nil "~{%~X~}" (utf-8-encode-char char))))
|
||||
(if (or (url-unreserved-character-p char) (member char safe-chars
|
||||
:test #'eql))
|
||||
(list char)
|
||||
(coerce (format nil "~{%~X~}" (utf-8-encode-char char)) 'list)))
|
||||
|
||||
(declaim (ftype (function (string) string) url-encode))
|
||||
(defun url-encode (string)
|
||||
"URL encode (percent escape) STRING."
|
||||
(format nil "~{~A~}" (map 'list 'escape-char-for-url string)))
|
||||
(declaim (ftype (function (string &key (:start integer) (:end integer)
|
||||
(:safe-chars list))
|
||||
string)
|
||||
url-encode))
|
||||
(defun url-encode (string &key (start 0) (end (length string)) safe-chars)
|
||||
"URL encode (percent escape) STRING. SAFE-CHARS is a list of characters that
|
||||
should not be encoded."
|
||||
(coerce (loop for i upfrom start below end
|
||||
for char = (aref string i)
|
||||
append (escape-char-for-url char :safe-chars safe-chars))
|
||||
'string))
|
||||
|
||||
(define-condition url-decode-error (error)
|
||||
((string :accessor url-decode-error-string
|
||||
|
Reference in New Issue
Block a user