From c2f77f4296c6b13eeb86067a772192b70577bca6 Mon Sep 17 00:00:00 2001 From: ckonstanski Date: Sat, 20 Jan 2018 22:07:54 -0700 Subject: initial commit --- file/file-utils.lisp | 112 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 112 insertions(+) create mode 100644 file/file-utils.lisp (limited to 'file') diff --git a/file/file-utils.lisp b/file/file-utils.lisp new file mode 100644 index 0000000..20a61ee --- /dev/null +++ b/file/file-utils.lisp @@ -0,0 +1,112 @@ +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +(declaim (optimize (speed 0) (safety 3) (debug 3))) + +(in-package #:ldapadmin) + +;; ========================================================================== ;; + +(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 () + (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) + (uffi:run-shell-command (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 (null-or-empty-p destination))) + (let ((destination-parts (nreverse (remove-if #'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) + (uffi:run-shell-command (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." + (uffi:run-shell-command (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'." + (uffi:run-shell-command (format nil "find ~a/* -regex '~a' |xargs rm -rf" directory-path regex))) + +(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 file-mtime (file-path) + (let ((output (car (shell-wrapper (format nil "ls --full-time '~a' |awk '{ print $6,$7 }' |awk -F. '{ print $1; }'" file-path))))) + (if (not (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 (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 path-contained-p (root-path path-to-check) + "Returns `(,root-path) if `path-to-check' is contained within `root-path', +`nil' otherwise." + (match-it root-path path-to-check)) + +(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))) -- cgit v1.3