1# ini.tcl --
2#
3#       Querying and modifying old-style windows configuration files (.ini)
4#
5# Copyright (c) 2003-2007    Aaron Faupell <afaupell@users.sourceforge.net>
6#
7# See the file "license.terms" for information on usage and redistribution
8# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
9#
10# RCS: @(#) $Id: ini.tcl,v 1.15 2008/05/11 00:53:58 andreas_kupries Exp $
11
12package provide inifile 0.2.3
13
14namespace eval ini {
15    variable nexthandle  0
16    variable commentchar \;
17}
18
19proc ::ini::open {ini {mode r+}} {
20    variable nexthandle
21
22    if { ![regexp {^(w|r)\+?$} $mode] } {
23        error "$mode is not a valid access mode"
24    }
25
26    ::set fh ini$nexthandle
27    ::set tmp [::open $ini $mode]
28    fconfigure $tmp -translation crlf
29
30    namespace eval ::ini::$fh {
31        variable data;     array set data     {}
32        variable comments; array set comments {}
33        variable sections; array set sections {}
34    }
35    ::set ::ini::${fh}::channel $tmp
36    ::set ::ini::${fh}::file    [_normalize $ini]
37    ::set ::ini::${fh}::mode    $mode
38
39    incr nexthandle
40    if { [string match "r*" $mode] } {
41        _loadfile $fh
42    }
43    return $fh
44}
45
46# close the file and delete all stored info about it
47# this does not save any changes. see ::ini::commit
48
49proc ::ini::close {fh} {
50    _valid_ns $fh
51    ::close [::set ::ini::${fh}::channel]
52    namespace delete ::ini::$fh
53}
54
55# write all changes to disk
56
57proc ::ini::commit {fh} {
58    _valid_ns $fh
59    namespace eval ::ini::$fh {
60        if { $mode == "r" } {
61            error "cannot write to read-only file"
62        }
63        ::close $channel
64        ::set channel [::open $file w]
65        ::set char $::ini::commentchar
66        #seek $channel 0 start
67        foreach sec [array names sections] {
68            if { [info exists comments($sec)] } {
69                puts $channel "$char [join $comments($sec) "\n$char "]\n"
70            }
71            puts $channel "\[$sec\]"
72            foreach key [lsort -dictionary [array names data [::ini::_globescape $sec]\000*]] {
73                ::set key [lindex [split $key \000] 1]
74                if {[info exists comments($sec\000$key)]} {
75                    puts $channel "$char [join $comments($sec\000$key) "\n$char "]"
76                }
77                puts $channel "$key=$data($sec\000$key)"
78            }
79            puts $channel ""
80        }
81        catch { unset char sec key }
82        close $channel
83        ::set channel [::open $file r+]
84    }
85    return
86}
87
88# internal command to read in a file
89# see open and revert for public commands
90
91proc ::ini::_loadfile {fh} {
92    namespace eval ::ini::$fh {
93        ::set cur {}
94        ::set com {}
95        set char $::ini::commentchar
96        seek $channel 0 start
97
98        foreach line [split [read $channel] "\n"] {
99            if { [string match "$char*" $line] } {
100                lappend com [string trim [string range $line [string length $char] end]]
101            } elseif { [string match {\[*\]} $line] } {
102                ::set cur [string range $line 1 end-1]
103                if { $cur == "" } { continue }
104                ::set sections($cur) 1
105                if { $com != "" } {
106                    ::set comments($cur) $com
107                    ::set com {}
108                }
109            } elseif { [string match {*=*} $line] } {
110                ::set line [split $line =]
111                ::set key [string trim [lindex $line 0]]
112                if { $key == "" || $cur == "" } { continue }
113                ::set value [string trim [join [lrange $line 1 end] =]]
114                if { [regexp "^(\".*\")\s+${char}(.*)$" $value -> 1 2] } {
115                    set value $1
116                    lappend com $2
117                }
118                ::set data($cur\000$key) $value
119                if { $com != "" } {
120                    ::set comments($cur\000$key) $com
121                    ::set com {}
122                }
123            }
124        }
125        unset char cur com
126        catch { unset line key value 1 2 }
127    }
128}
129
130# internal command to escape glob special characters
131
132proc ::ini::_globescape {string} {
133    return [string map {* \\* ? \\? \\ \\\\ \[ \\\[ \] \\\]} $string]
134}
135
136# internal command to check if a section or key is nonexistant
137
138proc ::ini::_exists {fh sec args} {
139    if { ![info exists ::ini::${fh}::sections($sec)] } {
140        error "no such section \"$sec\""
141    }
142    if { [llength $args] > 0 } {
143        ::set key [lindex $args 0]
144        if { ![info exists ::ini::${fh}::data($sec\000$key)] } {
145            error "can't read key \"$key\""
146        }
147    }
148}
149
150# internal command to check validity of a handle
151
152if { [package vcompare [package provide Tcl] 8.4] < 0 } {
153    proc ::ini::_normalize {path} {
154	return $path
155    }
156    proc ::ini::_valid_ns {name} {
157	variable ::ini::${name}::data
158	if { ![info exists data] } {
159	    error "$name is not an open INI file"
160	}
161    }
162} else {
163    proc ::ini::_normalize {path} {
164	file normalize $path
165    }
166    proc ::ini::_valid_ns {name} {
167	if { ![namespace exists ::ini::$name] } {
168	    error "$name is not an open INI file"
169	}
170    }
171}
172
173# get and set the ini comment character
174
175proc ::ini::commentchar { {new {}} } {
176    variable commentchar
177    if {$new != ""} {
178        if {[string length $new] > 1} {
179	    return -code error "comment char must be a single character"
180	}
181        ::set commentchar $new
182    }
183    return $commentchar
184}
185
186# return all section names
187
188proc ::ini::sections {fh} {
189    _valid_ns $fh
190    return [array names ::ini::${fh}::sections]
191}
192
193# return boolean indicating existance of section or key in section
194
195proc ::ini::exists {fh sec {key {}}} {
196    _valid_ns $fh
197    if { $key == "" } {
198        return [info exists ::ini::${fh}::sections($sec)]
199    }
200    return [info exists ::ini::${fh}::data($sec\000$key)]
201}
202
203# return all key names of section
204# error if section is nonexistant
205
206proc ::ini::keys {fh sec} {
207    _valid_ns $fh
208    _exists $fh $sec
209    ::set keys {}
210    foreach x [array names ::ini::${fh}::data [_globescape $sec]\000*] {
211        lappend keys [lindex [split $x \000] 1]
212    }
213    return $keys
214}
215
216# return all key value pairs of section
217# error if section is nonexistant
218
219proc ::ini::get {fh sec} {
220    _valid_ns $fh
221    _exists $fh $sec
222    upvar 0 ::ini::${fh}::data data
223    ::set r {}
224    foreach x [array names data [_globescape $sec]\000*] {
225        lappend r [lindex [split $x \000] 1] $data($x)
226    }
227    return $r
228}
229
230# return the value of a key
231# return default value if key or section is nonexistant otherwise error
232
233proc ::ini::value {fh sec key {default {}}} {
234    _valid_ns $fh
235    if {$default != "" && ![info exists ::ini::${fh}::data($sec\000$key)]} {
236        return $default
237    }
238    _exists $fh $sec $key
239    return [::set ::ini::${fh}::data($sec\000$key)]
240}
241
242# set the value of a key
243# new section or key names are created
244
245proc ::ini::set {fh sec key value} {
246    _valid_ns $fh
247    ::set sec [string trim $sec]
248    ::set key [string trim $key]
249    if { $sec == "" || $key == "" } {
250        error "section or key may not be empty"
251    }
252    ::set ::ini::${fh}::data($sec\000$key) $value
253    ::set ::ini::${fh}::sections($sec) 1
254    return $value
255}
256
257# delete a key or an entire section
258# may delete nonexistant keys and sections
259
260proc ::ini::delete {fh sec {key {}}} {
261    _valid_ns $fh
262    if { $key == "" } {
263        array unset ::ini::${fh}::data [_globescape $sec]\000*
264        array unset ::ini::${fh}::sections [_globescape $sec]
265    }
266    catch {unset ::ini::${fh}::data($sec\000$key)}
267}
268
269# read and set comments for sections and keys
270# may comment nonexistant sections and keys
271
272proc ::ini::comment {fh sec key args} {
273    _valid_ns $fh
274    upvar 0 ::ini::${fh}::comments comments
275    ::set r $sec
276    if { $key != "" } { append r \000$key }
277    if { [llength $args] == 0 } {
278        if { ![info exists comments($r)] } { return {} }
279        return $comments($r)
280    }
281    if { [llength $args] == 1 && [lindex $args 0] == "" } {
282        unset -nocomplain comments($r)
283        return {}
284    }
285    # take care of any embedded newlines
286    for {::set i 0} {$i < [llength $args]} {incr i} {
287        ::set args [eval [list lreplace $args $i $i] [split [lindex $args $i] \n]]
288    }
289    eval [list lappend comments($r)] $args
290}
291
292# return the physical filename for the handle
293
294proc ::ini::filename {fh} {
295    _valid_ns $fh
296    return [::set ::ini::${fh}::file]
297}
298
299# reload the file from disk losing all changes since the last commit
300
301proc ::ini::revert {fh} {
302    _valid_ns $fh
303    namespace eval ::ini::$fh {
304        array set data     {}
305        array set comments {}
306        array set sections {}
307    }
308    if { ![string match "w*" $mode] } {
309        _loadfile $fh
310    }
311}
312