File: ini.tcl

package info (click to toggle)
tcllib 1.10-dfsg-3
  • links: PTS
  • area: main
  • in suites: lenny
  • size: 17,708 kB
  • ctags: 6,122
  • sloc: tcl: 106,354; ansic: 9,205; sh: 8,707; xml: 1,766; yacc: 753; makefile: 115; perl: 84; f90: 84; python: 33; ruby: 13; php: 11
file content (308 lines) | stat: -rw-r--r-- 8,736 bytes parent folder | download
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
# ini.tcl --
#
#       Querying and modifying old-style windows configuration files (.ini)
#
# Copyright (c) 2003-2007    Aaron Faupell <afaupell@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: ini.tcl,v 1.13 2007/08/20 21:03:17 andreas_kupries Exp $

package provide inifile 0.2.1

namespace eval ini {
    variable nexthandle; if {![info exists nexthandle]} {set nexthandle 0}
    variable commentchar; if {![info exists commentchar]} {set commentchar \;}
}

proc ::ini::open {ini {mode r+}} {
    variable nexthandle

    if { ![regexp {^(w|r)\+?$} $mode] } {
        error "$mode is not a valid access mode"
    }

    ::set fh ini$nexthandle
    ::set tmp [::open $ini $mode]
    fconfigure $tmp -translation crlf

    namespace eval ::ini::$fh {
        variable data;     array set data     {}
        variable comments; array set comments {}
        variable sections; array set sections {}
    }
    ::set ::ini::${fh}::channel $tmp
    ::set ::ini::${fh}::file    [_normalize $ini]
    ::set ::ini::${fh}::mode    $mode

    incr nexthandle
    if { [string match "r*" $mode] } {
        _loadfile $fh
    }
    return $fh
}

# close the file and delete all stored info about it
# this does not save any changes. see ::ini::commit

proc ::ini::close {fh} {
    _valid_ns $fh
    ::close [::set ::ini::${fh}::channel]
    namespace delete ::ini::$fh
}

# write all changes to disk

proc ::ini::commit {fh} {
    _valid_ns $fh
    namespace eval ::ini::$fh {
        if { $mode == "r" } {
            error "cannot write to read-only file"
        }
        ::close $channel
        ::set channel [::open $file w]
        ::set char $::ini::commentchar
        #seek $channel 0 start
        foreach sec [array names sections] {
            if { [info exists comments($sec)] } {
                puts $channel "$char [join $comments($sec) "\n$char "]\n"
            }
            puts $channel "\[$sec\]"
            foreach key [lsort -dictionary [array names data [::ini::_globescape $sec]\000*]] {
                ::set key [lindex [split $key \000] 1]
                if {[info exists comments($sec\000$key)]} {
                    puts $channel "$char [join $comments($sec\000$key) "\n$char "]"
                }
                puts $channel "$key=$data($sec\000$key)"
            }
            puts $channel ""
        }
        catch { unset char sec key }
        close $channel
        ::set channel [::open $file r+]
    }
    return
}

# internal command to read in a file
# see open and revert for public commands

proc ::ini::_loadfile {fh} {
    namespace eval ::ini::$fh {
        ::set cur {}
        ::set com {}
        set char $::ini::commentchar
        seek $channel 0 start

        foreach line [split [read $channel] "\n"] {
            if { [string match "$char*" $line] } {
                lappend com [string trim [string range $line [string length $char] end]]
            } elseif { [string match {\[*\]} $line] } {
                ::set cur [string range $line 1 end-1]
                if { $cur == "" } { continue }
                ::set sections($cur) 1
                if { $com != "" } {
                    ::set comments($cur) $com
                    ::set com {}
                }
            } elseif { [string match {*=*} $line] } {
                ::set line [split $line =]
                ::set key [string trim [lindex $line 0]]
                if { $key == "" || $cur == "" } { continue }
                ::set value [string trim [join [lrange $line 1 end] =]]
                if { [regexp "^(\".*\")\s+${char}(.*)$" $value -> 1 2] } {
                    set value $1
                    lappend com $2
                }
                ::set data($cur\000$key) $value
                if { $com != "" } {
                    ::set comments($cur\000$key) $com
                    ::set com {}
                }
            }
        }
        unset char cur com
        catch { unset line key value 1 2 }
    }
}

# internal command to escape glob special characters

proc ::ini::_globescape {string} {
    return [string map {* \\* ? \\? \\ \\\\ \[ \\\[ \] \\\]} $string]
}

# internal command to check if a section or key is nonexistant

proc ::ini::_exists {fh sec args} {
    if { ![info exists ::ini::${fh}::sections($sec)] } {
        error "no such section \"$sec\""
    }
    if { [llength $args] > 0 } {
        ::set key [lindex $args 0]
        if { ![info exists ::ini::${fh}::data($sec\000$key)] } {
            error "can't read key \"$key\""
        }
    }
}

# internal command to check validity of a handle

if { [package vcompare [package provide Tcl] 8.4] < 0 } {
    proc ::ini::_normalize {path} {
	return $path
    }
    proc ::ini::_valid_ns {name} {
	variable ::ini::${name}::data
	if { ![info exists data] } {
	    error "$name is not an open INI file"
	}
    }
} else {
    proc ::ini::_normalize {path} {
	file normalize $path
    }
    proc ::ini::_valid_ns {name} {
	if { ![namespace exists ::ini::$name] } {
	    error "$name is not an open INI file"
	}
    }
}

# get and set the ini comment character

proc commentchar { {new {}} } {
    if {$new != ""} {
        if {[string length $new] > 1} { error "comment char must be a single character" }
        ::set ::ini::commentchar $new
    }
    return $::ini::commentchar
}

# return all section names

proc ::ini::sections {fh} {
    _valid_ns $fh
    return [array names ::ini::${fh}::sections]
}

# return boolean indicating existance of section or key in section

proc ::ini::exists {fh sec {key {}}} {
    _valid_ns $fh
    if { $key == "" } {
        return [info exists ::ini::${fh}::sections($sec)]
    }
    return [info exists ::ini::${fh}::data($sec\000$key)]
}

# return all key names of section
# error if section is nonexistant

proc ::ini::keys {fh sec} {
    _valid_ns $fh
    _exists $fh $sec
    ::set keys {}
    foreach x [array names ::ini::${fh}::data [_globescape $sec]\000*] {
        lappend keys [lindex [split $x \000] 1]
    }
    return $keys
}

# return all key value pairs of section
# error if section is nonexistant

proc ::ini::get {fh sec} {
    _valid_ns $fh
    _exists $fh $sec
    upvar 0 ::ini::${fh}::data data
    ::set r {}
    foreach x [array names data [_globescape $sec]\000*] {
        lappend r [lindex [split $x \000] 1] $data($x)
    }
    return $r
}

# return the value of a key
# return default value if key or section is nonexistant otherwise error

proc ::ini::value {fh sec key {default {}}} {
    _valid_ns $fh
    if {$default != "" && ![info exists ::ini::${fh}::data($sec\000$key)]} {
        return $default
    }
    _exists $fh $sec $key
    return [::set ::ini::${fh}::data($sec\000$key)]
}

# set the value of a key
# new section or key names are created

proc ::ini::set {fh sec key value} {
    _valid_ns $fh
    ::set sec [string trim $sec]
    ::set key [string trim $key]
    if { $sec == "" || $key == "" } {
        error "section or key may not be empty"
    }
    ::set ::ini::${fh}::data($sec\000$key) $value
    ::set ::ini::${fh}::sections($sec) 1
    return $value
}

# delete a key or an entire section
# may delete nonexistant keys and sections

proc ::ini::delete {fh sec {key {}}} {
    _valid_ns $fh
    if { $key == "" } {
        array unset ::ini::${fh}::data [_globescape $sec]\000*
        array unset ::ini::${fh}::sections [_globescape $sec]
    }
    catch {unset ::ini::${fh}::data($sec\000$key)}
}

# read and set comments for sections and keys
# may comment nonexistant sections and keys

proc ::ini::comment {fh sec key args} {
    _valid_ns $fh
    upvar 0 ::ini::${fh}::comments comments
    ::set r $sec
    if { $key != "" } { append r \000$key }
    if { [llength $args] == 0 } {
        if { ![info exists comments($r)] } { return {} }
        return $comments($r)
    }
    if { [llength $args] == 1 && [lindex $args 0] == "" } {
        unset -nocomplain comments($r)
        return {}
    }
    # take care of any embedded newlines
    for {::set i 0} {$i < [llength $args]} {incr i} {
        ::set args [eval [list lreplace $args $i $i] [split [lindex $args $i] \n]]
    }
    eval [list lappend comments($r)] $args
}

# return the physical filename for the handle

proc ::ini::filename {fh} {
    _valid_ns $fh
    return [::set ::ini::${fh}::file]
}

# reload the file from disk losing all changes since the last commit

proc ::ini::revert {fh} {
    _valid_ns $fh
    namespace eval ::ini::$fh {
        array set data     {}
        array set comments {}
        array set sections {}
    }
    if { ![string match "w*" $mode] } {
        _loadfile $fh
    }
}