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
|
(in-package #:containers)
(defclass* file-backed-table-container (table-container)
((pathspec nil ir)
(size 0 a)
(require-write (make-container 'list-container) r)
)
(:documentation "This is a very half-assed class that pretends to store a
table on disk. It doesn't support updating.")
(:export-p t))
(defmethod save-row (column-names row out)
(format out "~&\(~{~S ~}\)"
(collect-elements
column-names
:transform (lambda (name)
(slot-value row name)))))
(defmethod save-table-header ((container file-backed-table-container)
stream)
(format stream "~&\(:prototype-name ~S :columns ~S\)"
(class-name (prototype container))
(column-names container)))
(defmethod load-table-header ((container file-backed-table-container)
line)
;;?? STUB
(values t))
(defmethod check-table-header ((container file-backed-table-container)
line)
;;?? STUB
(values t))
(defmethod save-changes ((container file-backed-table-container))
(let ((column-names (column-names container))
(write-header? nil))
(if (probe-file (pathspec container))
(check-table-header container (pathspec container))
(setf write-header? t))
(with-open-file (out (pathspec container)
:if-exists :append
:direction :output
:if-does-not-exist :create)
(let ((*print-right-margin* most-positive-fixnum))
(when write-header?
(save-table-header container out))
(iterate-elements
(require-write container)
(lambda (row)
(save-row column-names row out))))))
(empty! (require-write container)))
(defmethod insert-record ((table file-backed-table-container) object)
(insert-item (require-write table) object)
(incf (size table))
(maybe-save-changes table))
(defmethod maybe-save-changes ((table file-backed-table-container))
(when (> (size (require-write table)) 10)
(save-changes table)))
(defmethod iterate-container ((container file-backed-table-container) fn)
(save-changes container)
(let ((first? t)
(column-names (column-names container)))
(u:map-lines-in-file
(lambda (line)
(if first?
;; skip header row
(setf first? nil)
;; create element and call fn on it
(funcall fn (create-record container column-names line))))
(pathspec container))))
(defmethod create-record ((container file-backed-table-container)
(column-names list) (line string))
(let ((it (allocate-instance (prototype container))))
(loop for datum in (read-from-string line)
for column in column-names do
(setf (slot-value it column) datum))
it))
|
