-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathimage-ops-hash-dir-tree.lisp
340 lines (319 loc) · 17.1 KB
/
image-ops-hash-dir-tree.lisp
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
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
;;; :FILE-CREATED <Timestamp: #{2011-08-26T16:44:51-04:00Z}#{11345} - by MON>
;;; :FILE image-ops/image-ops-hash-dir-tree.lisp
;;; ==============================
(in-package #:image-ops)
;; *package*
(declaim (inline %ensure-simple-string
%walk-directory-filter-ignorables
%absolute-existent-file-or-directory
image-hash-reset-all
image-hash-counts-report))
(defun %ensure-simple-namestring (namething)
(declare ((or pathname string) namething)
(optimize (speed 3)))
(when (simple-string-p namething)
(return-from %ensure-simple-namestring (the simple-string namething)))
(let ((string-thing (if (pathnamep namething)
(namestring namething)
namething)))
(declare (string string-thing))
(the simple-string
(make-array (length string-thing)
:element-type 'character
:initial-contents string-thing))))
(defun %walk-directory-filter-ignorables (path-or-namestring)
;; (%walk-directory-filter-ignorables "lost+found/")
;; (%walk-directory-filter-ignorables "lost+found")
(declare (inline %ensure-simple-namestring)
(optimize (speed 3)))
(let ((ensured-simple (%ensure-simple-namestring path-or-namestring)))
(declare (simple-string ensured-simple))
(flet ((chk-ignore (maybe-ignore)
(declare (simple-string maybe-ignore))
(string= maybe-ignore ensured-simple)))
(declare (list *walk-directory-ignorables*))
(notany #'chk-ignore *walk-directory-ignorables*))))
;; :NOTE Should this explicitly pass value of osicat:current-directory to
;; osicat:absolute-pathname? When invoked within the body of
;; osicat:walk-directory *default-pathname-defaults* is already dynamically
;; bound to osicat:current-directory and the extra overhead is likely costly.
(defun %absolute-existent-file-or-directory (maybe-file-or-directory)
(declare (inline %ensure-simple-namestring
%walk-directory-filter-ignorables))
(let* ((abs (osicat:absolute-pathname maybe-file-or-directory)) ;; (osicat:current-directory)
(abs-kind (osicat::get-file-kind abs nil)))
(and abs-kind
(or (eql abs-kind :regular-file)
(eql abs-kind :directory))
(%walk-directory-filter-ignorables maybe-file-or-directory)
t)))
(defun %partition-walked-files (rel-file-or-directory-pathname)
(declare (special *jpg-hash* *jpg-gz-hash*
*nef-hash* *tiff-hash*
*bmp-hash* *bmp-gz-hash*
*psd-hash* *other-hash*
;;
*jpg-scanner* *jpg-gz-scanner*
*bmp-scanner* *bmp-gz-scanner*
*nef-scanner* *tiff-scanner*
*psd-scanner*)
(pathname rel-file-or-directory-pathname)
(pathname rel-file-or-directory-pathname)
(inline %ensure-simple-namestring)
(optimize (speed 3)))
(let* ((regular-p (osicat:regular-file-exists-p
(osicat:absolute-pathname rel-file-or-directory-pathname))) ;*default-pathname-defaults*)))
(regular-namestring (if regular-p
(%ensure-simple-namestring regular-p)
(return-from %partition-walked-files nil))))
(declare (simple-string regular-namestring))
;; (print regular-p *standard-output*) (print regular-namestring *standard-output*)
(labels ((cache-if-image (scanner hash)
;; (declare (function scanner) (hash-table hash))
(declare (hash-table hash))
(multiple-value-bind (match-string extension) (cl-ppcre:scan-to-strings scanner regular-namestring :sharedp t)
;; (print scanner *standard-output*)
(when match-string
;; (print match-string *standard-output*)
;;
;; Check if were looking at a match from *bmp-gz-scanner*,
;; *jpg-gz-scanner* if so, its exension is bmp.gz, jpg.gz, or
;; jpeg.gz and we need to take the pathname-name of its
;; pathname-name
;; (if gz (cl-ppcre:register-groups-bind (ext dot gz) (*extension-gz-scanner* (aref extension 0))
(let ((extension0 (aref extension 0)))
;; (sb-ext:with-locked-hash-table (hash)
(with-hash-table-op (scnr-hash hash)
(if (string= "gz" extension0 :start2 (- (length extension0) 2))
(setf (gethash match-string scnr-hash) ;; hash)
(list (directory-namestring match-string)
(pathname-name (pathname-name match-string))
extension0))
(setf (gethash match-string scnr-hash) ;; hash)
(list (directory-namestring match-string)
(pathname-name match-string)
extension0)))))
t)))
(push-other ()
;; (sb-ext:with-locked-hash-table (*other-hash*)
(with-hash-table-op (ht-oh *other-hash*)
(and ;; (setf (gethash regular-namestring *other-hash*)
(setf (gethash regular-namestring ht-oh)
(list (directory-namestring regular-namestring)
(pathname-name regular-namestring)
(pathname-type regular-namestring)))
t)))
(map-pairs ()
(loop
for (fun . cache) in ;; `((,*psd-scanner* . ,*psd-hash*)
;; (,*jpg-gz-scanner* . ,*jpg-gz-hash*)
;; (,*jpg-scanner* . ,*jpg-hash*)
;; (,*bmp-scanner* . ,*bmp-hash*)
;; (,*bmp-gz-scanner* . ,*bmp-gz-hash*)
;; (,*nef-scanner* . ,*nef-hash*)
;; (,*tiff-scanner* . ,*tiff-hash*))
(list (cons *jpg-scanner* *jpg-hash*)
(cons *jpg-gz-scanner* *jpg-gz-hash*)
(cons *nef-scanner* *nef-hash*)
(cons *tiff-scanner* *tiff-hash*)
(cons *bmp-scanner* *bmp-hash*)
(cons *bmp-gz-scanner* *bmp-gz-hash*)
(cons *psd-scanner* *psd-hash*))
;; for chk = (cache-if-image (symbol-value fun) (symbol-value cache))
for chk = (cache-if-image fun cache)
;do (print chk *standard-output*)
when chk do (loop-finish) ;; (return-from map-pairs chk) ;;do
finally (return
(if chk
chk
(push-other))))))
(map-pairs))))
(defun image-hash-reset-all ()
;; (image-hash-reset-all)
(declare (special *jpg-hash* *jpg-gz-hash*
*nef-hash* *tiff-hash*
*bmp-hash* *bmp-gz-hash*
*psd-hash* *other-hash*)
(optimize (speed 3)))
(flet ((clear-it (hash-to-clear))
(with-hash-table-op (ht hash-to-clear)
(clrhash ht)))
;; (mapc #'(lambda (hash) (sb-ext:with-locked-hash-table (hash) (clrhash hash)))
(mapc #'clear-it (list *jpg-hash* *jpg-gz-hash*
*nef-hash* *tiff-hash*
*bmp-hash* *bmp-gz-hash*
*psd-hash* *other-hash*))))
(defun image-hash-counts-report ()
;; (image-hash-counts-report)
(declare (special *jpg-hash* *jpg-gz-hash*
*nef-hash* *tiff-hash*
*bmp-hash* *bmp-gz-hash*
*psd-hash* *other-hash*)
(optimize (speed 3)))
(flet ((ht-and-count (counting-hash)
;; (sb-ext:with-locked-hash-table (counting-hash)
;; (hash-table-count counting-hash))
(with-hash-table-op (ht counting-hash)
(hash-table-count ht))))
(pairlis (list '*jpg-hash* '*jpg-gz-hash*
'*nef-hash* '*tiff-hash*
'*bmp-hash* '*bmp-gz-hash*
'*psd-hash* '*other-hash*)
(mapcar #'ht-and-count (list *jpg-hash* *jpg-gz-hash*
*nef-hash* *tiff-hash*
*bmp-hash* *bmp-gz-hash*
*psd-hash* *other-hash*)))))
(defun %walk-directory-images-to-hash (directory-pathname &key (clear-count t))
(declare ((or pathname string) directory-pathname)
(boolean clear-count)
(inline %absolute-existent-file-or-directory
%ensure-simple-namestring
image-hash-counts-report
image-hash-reset-all)
(optimize (speed 3)))
(when clear-count (image-hash-reset-all))
(osicat:walk-directory (%ensure-simple-namestring directory-pathname)
#'%partition-walked-files
:directories :breadth-first ;; :depth-first
:test #'%absolute-existent-file-or-directory)
(image-hash-counts-report))
(defun walk-directory-images-to-hash (directory-pathname &key (clear-count t))
(sb-thread:make-thread
#'(lambda ()
(%walk-directory-images-to-hash directory-pathname :clear-count clear-count))
:name (format nil "WALK-DIRECTORY-IMAGES-TO-HASH-~D" (random most-positive-fixnum))))
(defun image-hash-write-to-file (hash-table directory-pathname hash-table-name &key (external-format :default))
(declare (mon:pathname-or-namestring directory-pathname))
(let* ((dir-ensure (ensure-directories-exist (pathname directory-pathname)))
(hash-file-name (and dir-ensure
(make-pathname :directory (pathname-directory dir-ensure)
:name (concatenate 'string hash-table-name '(#\-) (mon:time-string-yyyy-mm-dd)))))
(delim (make-string 68 :initial-element #\;)))
(with-open-file (f hash-file-name
:direction :output
:if-exists :supersede
:if-does-not-exist :create
:element-type 'character
:external-format external-format)
(flet ((hash-file-writer (key val)
(format f "~%~A~%(:FILE ~S~% :DIRECTORY ~S~% :NAME ~S~% :TYPE ~S)~%"
delim key (elt val 0) (elt val 1) (elt val 2))))
(with-hash-table-op (ht hash-table)
(maphash #'hash-file-writer ht)))
hash-file-name)))
(defun image-hash-write-all-to-file (directory-pathname)
(flet ((writer (hash-table)
(image-hash-write-to-file (symbol-value hash-table)
directory-pathname
(string-trim '(#\*) (string-downcase hash-table)))))
(mapcar #'writer (list '*jpg-hash* '*jpg-gz-hash*
'*nef-hash* '*tiff-hash*
'*bmp-hash* '*bmp-gz-hash*
'*psd-hash* '*other-hash*))))
(defun image-hash-map-conversion-extension (source-hash conversion-hash conversion-extension
&key (clear-conversion nil))
(declare (string conversion-extension)
(boolean clear-conversion))
(unless (member conversion-extension *valid-image-types* :test #'string=)
(error ":FUNCTION `image-hash-map-conversion-extension' ~
-- Arg CONVERSION-EXTENSION not member of `*valid-image-types*', got: ~S"
conversion-extension))
(when clear-conversion (clrhash conversion-hash))
(maphash #'(lambda (key val)
;; our file to convert
(setf (gethash key conversion-hash)
(namestring
(make-pathname :directory (pathname-directory (elt val 0))
:name (elt val 1)
:type conversion-extension))))
source-hash)
conversion-hash)
(defun image-hash-write-conversion-hash-to-file (conversion-hash-table
directory-pathname
conversion-hash-table-name
&key (external-format :default)
(w-comment-delimit nil))
(declare (mon:pathname-or-namestring directory-pathname)
(boolean w-comment-delimit))
(let* ((dir-ensure (ensure-directories-exist (pathname directory-pathname)))
(hash-file-name (and dir-ensure
(make-pathname :directory (pathname-directory dir-ensure)
:name (concatenate 'string conversion-hash-table-name '(#\-) (mon:time-string-yyyy-mm-dd)))))
(delim (make-string 68 :initial-element #\;)))
(with-open-file (f hash-file-name
:direction :output
:if-exists :supersede
:if-does-not-exist :create
:element-type 'character
:external-format external-format)
(format f "~&~A~%;;; :FILE-CREATED ~A~%;;; :FILE ~A ~%~A~%"
delim
#-IS-MON (mon:timestamp-for-file)
#+IS-MON (mon:timestamp)
(namestring hash-file-name)
delim)
(flet ((dump-from-to (key val)
(if w-comment-delimit
(format f "~%~A~%(:FROM ~S~% :TO ~S)~%" delim (pathname key) (pathname val))
(format f "~%(:FROM ~S~% :TO ~S)~%" (pathname key) (pathname val)))))
(with-hash-table-op (ht conversion-hash-table)
(maphash #'dump-from-to ht))
hash-file-name))))
(defun image-hash-conversion-perform (conversion-hash log-file &key (delete-on-success nil)
(external-format :default))
(declare (boolean delete-on-success))
(let ;; ((enure-log-file (probe-file log-file))
;; (log-ensured (if enure-log-file
;; enure-log-file
;; (error "Arg LOG-FILE does not exist")))
((delim (make-string 68 :initial-element #\;)))
(labels ((log-metadata (fname)
(let* ((jstream (make-string-output-stream))
(*standard-output* jstream))
(format jstream "~%;;~%;; exiftool results for ~A~%;;~%~%" fname)
(when (zerop (sb-ext:process-exit-code
(sb-ext:run-program "/usr/bin/exiftool"
(list "-j" fname)
:output *standard-output*)))
(get-output-stream-string jstream))))
(log-results (status from to)
(with-open-file (s log-file
:direction :output
:if-exists :append
:if-does-not-exist :create
:external-format external-format
:element-type 'character)
(if status
(progn
(format s "~&~A~%;; Successfull conversion ~%;; :FROM ~S~%;; :TO ~S~%" delim from to)
(format t "~&~A~%;; Successfull conversion ~%;; :FROM ~S~%;; :TO ~S~%" delim from to)
(princ (log-metadata from) s)
(princ (log-metadata to) s)
(terpri s))
(progn
(format s "~&~A~%;; Failed conversion ~%;; :FROM ~S~%;; :TO ~S~%" delim from to)
(format t "~&~A~%;; Failed conversion ~%;; :FROM ~S~%;; :TO ~S~%" delim from to)))))
(hash-pair-to-args (key val)
(if (zerop (sb-ext:process-exit-code
(sb-ext:run-program *image-magick-convert-path* (list key "-compress" "zip" val))))
(progn
(log-results t key val)
(when delete-on-success
(delete-file key))
t)
(log-results nil key val)))
(map-with-lock ()
;; (sb-ext:with-locked-hash-table (conversion-hash)
;; (maphash #'hash-pair-to-args conversion-hash))
(with-hash-table-op (ht conversion-hash)
(maphash #'hash-pair-to-args ht))))
(sb-thread:make-thread #'map-with-lock
:name (format nil "image-hash-conversion-perform-~D" (random most-positive-fixnum))))))
;;; ==============================
;; Local Variables:
;; indent-tabs-mode: nil
;; show-trailing-whitespace: t
;; mode: lisp-interaction
;; End:
;;; ==============================
;;; EOF