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
|
# tie_growfile.tcl --
#
# Data source: Files.
#
# Copyright (c) 2006 Andreas Kupries <andreas_kupries@users.sourceforge.net>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: tie_growfile.tcl,v 1.1 2006/03/08 04:55:58 andreas_kupries Exp $
# ### ### ### ######### ######### #########
## Requisites
package require snit
package require tie
# ### ### ### ######### ######### #########
## Implementation
snit::type ::tie::std::growfile {
# ### ### ### ######### ######### #########
## Notes
## This data source is geared towards the storage of arrays which
## will never shrink over time. Data is always appended to the
## files associated with this driver. Nothing is ever
## removed. Compaction does not happen either, so modification of
## array entries will keep the old information around in the history.
# ### ### ### ######### ######### #########
## Specials
pragma -hastypemethods no
pragma -hasinfo no
pragma -simpledispatch yes
# ### ### ### ######### ######### #########
## API : Construction & Destruction
constructor {thepath} {
# Locate and open the journal file.
set path [file normalize $thepath]
if {[file exists $path]} {
set chan [open $path {RDWR EXCL APPEND}]
} else {
set chan [open $path {RDWR EXCL CREAT APPEND}]
}
fconfigure $chan -buffering none -encoding utf-8
return
}
destructor {
# Release the channel to the journal file, should it be open.
if {$chan ne ""} {close $chan}
return
}
# ### ### ### ######### ######### #########
## API : Data source methods
method get {} {
if {![file size $path]} {return {}}
$self LoadJournal
return [array get cache]
}
method names {} {
if {![file size $path]} {return {}}
$self LoadJournal
return [array names cache]
}
method size {} {
if {![file size $path]} {return 0}
$self LoadJournal
return [array size cache]
}
method getv {index} {
if {![file size $path]} {
return -code error "can't read \"$index\": no such variable"
}
$self LoadJournal
return $cache($index)
}
method set {dict} {
puts -nonewline $chan $dict
puts -nonewline $chan { }
flush $chan
return
}
method setv {index value} {
puts -nonewline $chan [list $index $value]
puts -nonewline $chan { }
flush $chan
return
}
method unset {{pattern *}} {
return -code error \
"Deletion of entries is not allowed by this data source"
}
method unsetv {index} {
return -code error \
"Deletion of entries is not allowed by this data source"
}
# ### ### ### ######### ######### #########
## Internal : Instance data
variable chan {} ; # Channel to write the journal.
variable path {} ; # Path to journal file.
# Journal loading, and cache.
variable count 0 ; # #Operations in the journal.
variable cvalid 0 ; # Validity of the cache.
variable cache -array {} ; # Cache for journal
# Management of the cache: See notes at beginning.
# ### ### ### ######### ######### #########
## Internal: Loading from the journal.
method LoadJournal {} {
if {$cvalid} return
set cvalid 1
set in [open $path r]
array set cache [read $in]
close $in
return
}
# ### ### ### ######### ######### #########
}
# ### ### ### ######### ######### #########
## Ready to go
::tie::register ::tie::std::growfile as growfile
package provide tie::std::growfile 1.0
|
