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
|
;;; -*- 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 ()
(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)
(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 (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)
(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 (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)))
|
