From 7f7f364f0a3cf3da7dd50c7f134169530752bf51 Mon Sep 17 00:00:00 2001 From: ckonstanski Date: Sat, 26 Dec 2020 21:32:37 -0700 Subject: initial import --- org-ckons-file.asd | 35 +++++++++++++++++ src/file.lisp | 113 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 148 insertions(+) create mode 100644 org-ckons-file.asd create mode 100644 src/file.lisp diff --git a/org-ckons-file.asd b/org-ckons-file.asd new file mode 100644 index 0000000..203cb6f --- /dev/null +++ b/org-ckons-file.asd @@ -0,0 +1,35 @@ +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +(declaim (optimize (speed 0) (safety 3) (debug 3))) + +(in-package #:cl) + +(defpackage #:org-ckons-file-system (:use #:cl #:asdf)) +(in-package #:org-ckons-file-system) + +(defmacro do-defsystem (&key name version maintainer author description long-description depends-on components) + `(defsystem ,name + :name ,name + :version ,version + :maintainer ,maintainer + :author ,author + :description ,description + :long-description ,long-description + :depends-on ,(eval depends-on) + :components ,components)) + +(defparameter *quicklisp-packages* '()) +(defparameter *asdf-packages* '(org-ckons-core)) +(defparameter *all-packages* (append *quicklisp-packages* *asdf-packages*)) + +(loop for pkg in *quicklisp-packages* do + (ql:quickload (symbol-name pkg))) + +(do-defsystem :name "org-ckons-file" + :version "1" + :maintainer "Carlos Konstanski " + :author "Carlos Konstanski " + :description "org-ckons-file" + :long-description "org-ckons-file is a library which provides HTML rendering functionality and a drakma HTTP client wrapper." + :depends-on *all-packages* + :components ((:module src + :components ((:file "file"))))) diff --git a/src/file.lisp b/src/file.lisp new file mode 100644 index 0000000..ab8c76a --- /dev/null +++ b/src/file.lisp @@ -0,0 +1,113 @@ +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +(declaim (optimize (speed 0) (safety 3) (debug 3))) + +(defpackage :org-ckons-file + (:use :cl)) + +(in-package #:org-ckons-file) + +(defun compile-and-load (filename) + "Compiles and then loads a file. `filename' should not have an +extension, such as .fasl or .lisp." + (compile-file filename) + (load filename)) + +(defun write-pid-file () + (org-ckons-core::shell-wrapper (format nil "echo ~a >~a/~a.pid" (sb-posix:getpid) (sb-posix:getenv "HOME") (string-downcase (package-name *package*))))) + +(defun file-to-list (infile) + "Reads `infile' and returns a list, where each atom is a single +line of the file. `infile' can be a string or a pathname +object." + (let ((infile-list ())) + (with-open-file (filehandle infile :if-does-not-exist nil) + (if (streamp filehandle) + (progn + (loop for line = (read-line filehandle nil) + while line do + (push line infile-list)) + (nreverse infile-list)) + nil)))) + +(defun parse-csv-line (line) + "Parses a single line of CSV input into a list of string fields." + (let ((quoted-string-mode nil) + (line-list ()) + (field-collector "")) + (loop for this-char across (ppcre:regex-replace-all #\Return line "") do + (cond ((equal this-char #\") + (setf quoted-string-mode (not quoted-string-mode))) + ((and (equal this-char #\,) (not quoted-string-mode)) + (push field-collector line-list) + (setf field-collector "")) + (t + (setf field-collector (format nil "~a~a" field-collector this-char))))) + ;; get the field after the last comma + (push field-collector line-list) + (nreverse line-list))) + +(defmacro dofile ((line filename) &body body) + "Wrapper for the common task of opening a file and reading it one +line at a time." + (let ((stream (gensym))) + `(with-open-file (,stream ,filename) + (loop for ,line = (read-line ,stream nil nil) + while ,line do ,@body)))) + +(defun mkdir (path) + (org-ckons-core::shell-wrapper (format nil "mkdir -p ~a" path))) + +(defun copy-file (source destination) + "Copies file from `source' to `destination'. If the destination +directory does not exist, it will be created." + (when (and (file-exists-p source) + (file-p source) + (not (org-ckons-core::null-or-empty-p destination))) + (let ((destination-parts (nreverse (remove-if #'org-ckons-core::null-or-empty-p (ppcre:split "/" destination)))) + (destination-file "") + (destination-directory "")) + (setf destination-file (pop destination-parts)) + (loop for part in (nreverse destination-parts) do + (setf destination-directory (format nil "~a/~a" destination-directory part))) + (mkdir destination-directory) + (org-ckons-core::shell-wrapper (format nil "cp '~a' '~a'" source destination))))) + +(defun purge-old-files (directory-path) + "Deletes everything out of a directory that is older than 8 hours +old." + (org-ckons-core::shell-wrapper (format nil "find ~a/* -mmin 480 |xargs rm -rf" directory-path))) + +(defun purge-files-regex (directory-path regex) + "Deletes everything out of a directory whose name matches the +`regex'." + (org-ckons-core::shell-wrapper (format nil "find ~a/* -regex '~a' |xargs rm -rf" directory-path regex))) + +(defun file-exists-p (file-path) + (equal (car (org-ckons-core::shell-wrapper (format nil "if test -f '~a'; then echo 0; else echo 1; fi" file-path))) "0")) + +(defun file-mtime (file-path) + (let ((output (car (org-ckons-core::shell-wrapper (format nil "ls --full-time '~a' |awk '{ print $6,$7 }' |awk -F. '{ print $1; }'" file-path))))) + (if (not (org-ckons-core::match-it "^\\d\\d\\d\\d-\\d\\d-\\d\\d \\d\\d:\\d\\d:\\d\\d$" output)) + (error 'handled-error :text (format nil "Error in `file-mtime': ~a" output)) + output))) + +(defun directory-p (absolute-path) + (if (car (org-ckons-core::shell-wrapper (format nil "file '~a' |grep 'directory'" absolute-path))) t nil)) + +(defun symlink-p (absolute-path) + (if (car (org-ckons-core::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 path-contained-p (root-path path-to-check) + "Returns `(,root-path) if `path-to-check' is contained within `root-path', +`nil' otherwise." + (org-ckons-core::match-it root-path path-to-check)) + +(defun find-files (working-dir base-dir pattern) + (org-ckons-core::shell-wrapper (format nil + "pushd ~a >/dev/null 2>&1 ; find ~a -iname '~a' ; popd >/dev/null 2>&1" + working-dir + base-dir + pattern))) -- cgit v1.3