1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
|
;;; -*- 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 file-as-bytes (filename)
(let ((contents ()))
(with-open-file (stream filename :direction :input :element-type '(unsigned-byte 8))
(loop for byte = (read-byte stream nil)
while byte
do (push byte contents)))
(reverse contents)))
(defun file-as-hex (filename)
(let ((hex (make-array '(0) :element-type 'character :fill-pointer 0 :adjustable t)))
(with-output-to-string (stream hex)
(loop for byte in (file-as-bytes filename)
do (let ((pattern (if (< byte 16) "0~x" "~x")))
(format stream pattern byte))))
(string-downcase hex)))
(defun file-as-base64 (filename)
(let ((bytes (make-array '(0) :element-type '(unsigned-byte 8) :fill-pointer 0 :adjustable t)))
(loop for byte in (file-as-bytes filename)
do (vector-push-extend byte bytes))
(cl-base64:usb8-array-to-base64-string bytes)))
(defun get-mime-type (filename)
(car (org-ckons-core::shell-wrapper (format nil "file --mime-type ~a | awk -F': ' '{print $2}'" filename))))
(defun mkdir (path)
(org-ckons-core::shell-wrapper (format nil "mkdir -p ~a" path)))
(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 'org-ckons-condition::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)))
|
