| 1 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 2 | # FILE : iniparseBys.tcl |
|---|
| 3 | # PURPOSE : This file has functions to parse and create a .ini file, it |
|---|
| 4 | # doesn't make modifications directly on file, but on memory. |
|---|
| 5 | # It has been rewritten in Bayes because original was inefficient. |
|---|
| 6 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 7 | |
|---|
| 8 | package provide iniparse 1.4 |
|---|
| 9 | |
|---|
| 10 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 11 | # |
|---|
| 12 | # iniparse is a global array used to store information about ini file: |
|---|
| 13 | # |
|---|
| 14 | # freeid -> next free id for ini file |
|---|
| 15 | # idlist -> list of ids of ini files |
|---|
| 16 | # $id,fname -> filename |
|---|
| 17 | # $id,data -> each entry of the file are read into an item |
|---|
| 18 | # in this list as |
|---|
| 19 | # iniparse($id,data,keyname,itemname) |
|---|
| 20 | # $iniparse($id,sections) -> this is a list containing the different |
|---|
| 21 | # sections of the ini file |
|---|
| 22 | # $iniparse($id,flags) -> this is a list containing these flags: |
|---|
| 23 | # RDONLY : If this flag is set, iniparse:flush |
|---|
| 24 | # will not write anything over file, but |
|---|
| 25 | # still writeini will work (only in |
|---|
| 26 | # memory) |
|---|
| 27 | # |
|---|
| 28 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 29 | |
|---|
| 30 | set iniparse(freeid) 0 |
|---|
| 31 | set iniparse(idlist) {} |
|---|
| 32 | |
|---|
| 33 | |
|---|
| 34 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 35 | proc iniparse:openfile {file args} { |
|---|
| 36 | # |
|---|
| 37 | # PURPOSE: Reads an ini file into memory, for later access (such as read or |
|---|
| 38 | # write), and return an id which can be later used for |
|---|
| 39 | # writing/reading data, and flushing/closing file. |
|---|
| 40 | # Notes: |
|---|
| 41 | # - It doesn't leave the file open, just reads into memory, and |
|---|
| 42 | # returns an id. |
|---|
| 43 | # - If RDONLY is specified (case-sensetive), then calls to writeini |
|---|
| 44 | # will work only in memory, and changes won't be saved with |
|---|
| 45 | # iniparse:flush, nor iniparse:closefile. |
|---|
| 46 | # |
|---|
| 47 | # PARAMETERS: |
|---|
| 48 | # file: file's name |
|---|
| 49 | # args: RDONLY flag, optional |
|---|
| 50 | # |
|---|
| 51 | # RETURN: The file's id |
|---|
| 52 | # |
|---|
| 53 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 54 | global iniparse |
|---|
| 55 | set fileId [open $file {RDONLY CREAT}] |
|---|
| 56 | set sections {} |
|---|
| 57 | set keyName "" |
|---|
| 58 | |
|---|
| 59 | set id $iniparse(freeid) |
|---|
| 60 | incr iniparse(freeid) |
|---|
| 61 | |
|---|
| 62 | while {![eof $fileId]} { |
|---|
| 63 | set input [gets $fileId] |
|---|
| 64 | if {[regexp {\[(.*)\]} $input --> keyName]} { |
|---|
| 65 | if {[set idx [lsearch $sections $keyName]] == -1} { |
|---|
| 66 | lappend sections $keyName |
|---|
| 67 | } |
|---|
| 68 | } elseif {[regexp {(.*)=(.*)} $input --> itemName value] } { |
|---|
| 69 | set iniparse($id,data,$keyName,$itemName) $value |
|---|
| 70 | } |
|---|
| 71 | } |
|---|
| 72 | close $fileId |
|---|
| 73 | |
|---|
| 74 | set iniparse($id,fname) $file |
|---|
| 75 | set iniparse($id,sections) $sections |
|---|
| 76 | set iniparse($id,flags) $args |
|---|
| 77 | lappend iniparse(idlist) $id |
|---|
| 78 | return $id |
|---|
| 79 | } |
|---|
| 80 | |
|---|
| 81 | |
|---|
| 82 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 83 | proc iniparse:flushfile {id} { |
|---|
| 84 | # |
|---|
| 85 | # PURPOSE: Writes an ini file in memory into its file, without removing data |
|---|
| 86 | # from memory. |
|---|
| 87 | # |
|---|
| 88 | # PARAMETERS: |
|---|
| 89 | # id: file id |
|---|
| 90 | # |
|---|
| 91 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 92 | global iniparse |
|---|
| 93 | |
|---|
| 94 | if {[lsearch $iniparse(idlist) $id] == -1} return ;# No such Id |
|---|
| 95 | |
|---|
| 96 | if {[lsearch $iniparse($id,flags) RDONLY] != -1} return ;# ReadOnly-Flag |
|---|
| 97 | |
|---|
| 98 | set fileId [open $iniparse($id,fname) {WRONLY CREAT TRUNC}] |
|---|
| 99 | |
|---|
| 100 | foreach section $iniparse($id,sections) { |
|---|
| 101 | #puts $fileId "" |
|---|
| 102 | puts $fileId "\[$section\]" |
|---|
| 103 | regsub -all $id,data,$section, [array names iniparse $id,data,$section,*] "" itemNames |
|---|
| 104 | foreach it [lsort $itemNames] { |
|---|
| 105 | puts $fileId "$it=$iniparse($id,data,$section,$it)" |
|---|
| 106 | } |
|---|
| 107 | } |
|---|
| 108 | |
|---|
| 109 | close $fileId |
|---|
| 110 | |
|---|
| 111 | set iniparse($id,flags) [lreplace $iniparse($id,flags) [set idx [lsearch $iniparse($id,flags) CHANGED]] $idx] |
|---|
| 112 | } |
|---|
| 113 | |
|---|
| 114 | |
|---|
| 115 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 116 | proc iniparse:closefile {id} { |
|---|
| 117 | # |
|---|
| 118 | # PURPOSE: Flushes an ini file in memory into its file, and then removes data |
|---|
| 119 | # from memory. |
|---|
| 120 | # |
|---|
| 121 | # PARAMETERS: |
|---|
| 122 | # id: file id |
|---|
| 123 | # |
|---|
| 124 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 125 | global iniparse |
|---|
| 126 | if {[lsearch $iniparse(idlist) $id] == -1} return ;# No such Id |
|---|
| 127 | |
|---|
| 128 | iniparse:flushfile $id |
|---|
| 129 | unset iniparse($id,fname) |
|---|
| 130 | foreach section $iniparse($id,sections) { |
|---|
| 131 | regsub -all $id,data,$section, [array names iniparse $id,data,$section,*] "" itemNames |
|---|
| 132 | foreach it $itemNames { |
|---|
| 133 | unset iniparse($id,data,$section,$it) |
|---|
| 134 | } |
|---|
| 135 | } |
|---|
| 136 | unset iniparse($id,sections) |
|---|
| 137 | unset iniparse($id,flags) |
|---|
| 138 | set iniparse(idlist) [lreplace $iniparse(idlist) [set idx [lsearch $iniparse(idlist) $id]] $idx] |
|---|
| 139 | } |
|---|
| 140 | |
|---|
| 141 | |
|---|
| 142 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 143 | proc readini {id args} { |
|---|
| 144 | # |
|---|
| 145 | # PURPOSE: Usage: readini <fileId> [ [<keyname>] [<itemname>] ] |
|---|
| 146 | # Reads <itemname> under <keyname> from <fileId>. If it cannot find |
|---|
| 147 | # file, <itemname>, or <keyname>, returns an empty string. |
|---|
| 148 | # If itemname is absent, returns list of all items under keyname. |
|---|
| 149 | # Notes: |
|---|
| 150 | # - This procedure doesn't read directly from the file, but from the |
|---|
| 151 | # memory-version of the file. If directly the file (not memory |
|---|
| 152 | # version) is modified after the call to iniparse:openfile, this |
|---|
| 153 | # procedure will not see the changes in the file, but only changes |
|---|
| 154 | # in memory-version. |
|---|
| 155 | # See: writeini iniparse:openfile |
|---|
| 156 | # |
|---|
| 157 | # PARAMETERS: |
|---|
| 158 | # id: file id |
|---|
| 159 | # args: [[<keyname>] [<itemname>]] |
|---|
| 160 | # |
|---|
| 161 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 162 | global iniparse |
|---|
| 163 | set keyfound 0 ; set itemfound 0 |
|---|
| 164 | set key [lindex $args 0] |
|---|
| 165 | set item [lindex $args 1] |
|---|
| 166 | |
|---|
| 167 | if {[lsearch $iniparse(idlist) $id] == -1} {return ""} ;# No such Id |
|---|
| 168 | |
|---|
| 169 | if {[llength $args] != 2} { |
|---|
| 170 | regsub -all $id,data,$key, [array names iniparse $id,data,$key,*] "" itemNames |
|---|
| 171 | return $itemNames |
|---|
| 172 | } |
|---|
| 173 | if {![info exist iniparse($id,data,$key,$item)]} { |
|---|
| 174 | return "" |
|---|
| 175 | } |
|---|
| 176 | return $iniparse($id,data,$key,$item) |
|---|
| 177 | } |
|---|
| 178 | |
|---|
| 179 | |
|---|
| 180 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 181 | proc writeini {id key item value} { |
|---|
| 182 | # |
|---|
| 183 | # PURPOSE: Writes/modifies <item> under <key> in <id> with <value>. If cannot |
|---|
| 184 | # find <item>, or <key>, creates a new one. |
|---|
| 185 | # Notes: |
|---|
| 186 | # - This procedure doesn't write directly to the file, but to the |
|---|
| 187 | # memory-version of the file. If directly the file (not memory |
|---|
| 188 | # version) is modified after the call to iniparse:openfile, this |
|---|
| 189 | # procedure will not see the changes in the file, but only changes |
|---|
| 190 | # in memory-version. |
|---|
| 191 | # See: readini iniparse:openfile |
|---|
| 192 | # |
|---|
| 193 | # PARAMETERS: |
|---|
| 194 | # id: file id |
|---|
| 195 | # key: key name |
|---|
| 196 | # item: item name |
|---|
| 197 | # value: item value |
|---|
| 198 | # |
|---|
| 199 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 200 | global iniparse |
|---|
| 201 | |
|---|
| 202 | if {[lsearch $iniparse(idlist) $id] == -1} return ;# No such Id |
|---|
| 203 | |
|---|
| 204 | set iniparse($id,data,$key,$item) $value |
|---|
| 205 | |
|---|
| 206 | if {[set idx [lsearch $iniparse($id,sections) $key]] == -1} { |
|---|
| 207 | lappend iniparse($id,sections) $key |
|---|
| 208 | } |
|---|
| 209 | } |
|---|
| 210 | |
|---|