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
|
#!/bin/sh
# -*-tcl-*-
# the next line restarts using tclsh \
exec tclsh "${0}" "${@}"
####################################
# Parse a ChangeLog files into a tcl structure.
proc main {} {
global argv
set in [lindex $argv 0]
set out [cl:parse [read [set fh [open $in r]]][close $fh]]
#puts [join $out \n] -- Test code
#exit
puts $out
}
proc cl:parse {data} {
set state unknown
set chunk(date) {}
set chunk(person) {}
set chunk(items) {}
set idata {}
foreach line [split $data \n] {
if {[cl:parse:chunk_intro $line date person]} {
cl:parse:close_last_item
cl:parse:close_last_chunk
cl:parse:init_chunk $date $person
continue
}
if {[cl:parse:item_line $line data]} {
cl:parse:close_last_item
cl:parse:init_item $data
continue
}
if {[cl:parse:item_followup $line data]} {
cl:parse:add2item $data
continue
}
# ignore all other lines.
}
cl:parse:close_last_item
cl:parse:close_last_chunk
return $result
}
proc cl:parse:chunk_intro {line datevar personvar} {
if {![regexp "^\[^\t \]" $line]} {
return 0
}
upvar $datevar d $personvar p
if {[regexp -indices -- {^([0-9]+-[0-9-]+)} $line -> di]} {
foreach {da de} $di break ; # lassign
regsub -all "\[ \t\]+" [string trim [string range $line $da $de]] { } d
regsub -all "\[ \t\]+" [string trim [string range $line [incr de] end]] { } p
#puts stderr "$line +--> ($d | $p)"
return 1
}
regsub -all "\[\t \]+" $line { } line
set line [split $line]
set d [join [lrange $line 0 4]]
set p [join [lrange $line 5 end]]
#puts stderr "$line |--> ($d | $p)"
return 1
}
proc cl:parse:close_last_chunk {} {
upvar result r chunk c
if {$c(date) != {}} {
lappend r [list $c(date) $c(person) $c(items)]
set c(date) {}
set c(person) {}
set c(items) {}
}
return
}
proc cl:parse:init_chunk {date person} {
upvar chunk c
set c(date) $date
set c(person) $person
set c(items) {}
return
}
proc cl:parse:item_line {line itemvar} {
if {![regexp "^\[\t \]+\\*" $line]} {
return 0
}
upvar $itemvar i
set line [string trimleft [string trimright $line] "\t *"]
set i $line
return 1
}
if {0} {
return 1
}
proc cl:parse:close_last_item {} {
upvar chunk c idata i
if {$i != {}} {
set ke [string first : $i]
if {$ke < 0} {
set ke -1 ; # No key at all, pure comment
}
set k [string trim [string range $i 0 [incr ke -1]]]
set co [string trim [string range $i [incr ke 2] end]]
lappend c(items) [list $k $co]
set i {}
}
return
}
proc cl:parse:init_item {comment} {
upvar idata i
set i $comment
return
}
proc cl:parse:item_followup {line commentvar} {
upvar $commentvar c
set line [string trim $line]
if {$line == {}} {
return 0
}
set c $line
return 1
}
proc cl:parse:add2item {comment} {
upvar idata i
append i " $comment"
}
##########################################################
main
exit 0
|
