1# -*- tcl -*-
2# (C) 2008 Andreas Kupries <andreas_kupries@users.sourceforge.net>
3##
4# ###
5
6package require  sak::animate
7package require  sak::feedback
8package require  sak::color
9
10getpackage textutil::repeat textutil/repeat.tcl
11getpackage interp           interp/interp.tcl
12getpackage struct::set      struct/sets.tcl
13getpackage struct::list     struct/list.tcl
14
15namespace eval ::sak::validate::versions {
16    namespace import ::textutil::repeat::blank
17    namespace import ::sak::color::*
18    namespace import ::sak::feedback::!
19    namespace import ::sak::feedback::>>
20    namespace import ::sak::feedback::+=
21    namespace import ::sak::feedback::=
22    namespace import ::sak::feedback::=|
23    namespace import ::sak::feedback::log
24    namespace import ::sak::feedback::summary
25    rename summary sum
26}
27
28# ###
29
30proc ::sak::validate::versions {modules mode stem} {
31    versions::run $modules $mode $stem
32    versions::summary
33    return
34}
35
36proc ::sak::validate::versions::run {modules mode stem} {
37    sak::feedback::init $mode $stem
38    sak::feedback::first log  "\[ Versions \] ===================================================="
39    sak::feedback::first warn "\[ Versions \] ===================================================="
40    sak::feedback::first fail "\[ Versions \] ===================================================="
41
42    # Preprocessing of module names to allow better formatting of the
43    # progress output, i.e. vertically aligned columns
44
45    # Per module
46    # - List modules without package index (error)
47    # - List packages provided missing from pkgIndex.tcl
48    # - List packages in the pkgIndex.tcl, but not provided.
49    # - List packages where provided and indexed versions differ.
50
51    Count $modules
52    MapPackages
53
54    InitCounters
55    foreach m $modules {
56	# Skip tcllibc shared library, not a module.
57	if {[string equal $m tcllibc]} continue
58
59	InitModuleCounters
60	!
61	log "@@ Module $m"
62	Head $m
63
64	if {![llength [glob -nocomplain [file join [At $m] pkgIndex.tcl]]]} {
65	    +e "No package index"
66	} else {
67	    # Compare package provided to ifneeded.
68
69	    struct::list assign \
70		[struct::set intersect3 [Indexed $m] [Provided $m]] \
71		compare only_indexed only_provided
72
73	    foreach p [lsort -dict $only_indexed ] { +w "Indexed/No Provider:  $p" }
74	    foreach p [lsort -dict $only_provided] { +w "Provided/Not Indexed: $p" }
75
76	    foreach p [lsort -dict $compare] {
77		set iv [IndexedVersions  $m $p]
78		set pv [ProvidedVersions $m $p]
79		if {[struct::set equal $iv $pv]} continue
80
81		struct::list assign \
82		    [struct::set intersect3 $pv $iv] \
83		    __ pmi imp
84
85		+w "Indexed </> Provided: $p \[<$imp </> $pmi\]"
86	    }
87	}
88	ModuleSummary
89    }
90    return
91}
92
93proc ::sak::validate::versions::summary {} {
94    Summary
95    return
96}
97
98# ###
99
100proc ::sak::validate::versions::MapPackages {} {
101    variable    pkg
102    array unset pkg *
103
104    !
105    += Package
106    foreach {pname pdata} [ipackages] {
107	= "$pname ..."
108	foreach {pvlist pmodule} $pdata break
109	lappend pkg(mi,$pmodule) $pname
110	lappend pkg(vi,$pmodule,$pname) $pvlist
111
112	foreach {pname pvlist} [ppackages $pmodule] {
113	    lappend pkg(mp,$pmodule) $pname
114	    lappend pkg(vp,$pmodule,$pname) $pvlist
115	}
116    }
117    !
118    =| {Packages mapped ...}
119    return
120}
121
122proc ::sak::validate::versions::Provided {m} {
123    variable pkg
124    return [lsort -dict $pkg(mp,$m)]
125}
126
127proc ::sak::validate::versions::Indexed {m} {
128    variable pkg
129    if {![info exists pkg(mi,$m)]} { return {} }
130    return [lsort -dict $pkg(mi,$m)]
131}
132
133proc ::sak::validate::versions::ProvidedVersions {m p} {
134    variable pkg
135    return [lsort -dict $pkg(vp,$m,$p)]
136}
137
138proc ::sak::validate::versions::IndexedVersions {m p} {
139    variable pkg
140    return [lsort -dict $pkg(vi,$m,$p)]
141}
142
143###
144
145proc ::sak::validate::versions::+e {msg} {
146    variable merrors ; incr merrors
147    variable errors  ; incr errors
148    log "@@ ERROR $msg"
149    return
150}
151
152proc ::sak::validate::versions::+w {msg} {
153    variable mwarnings ; incr mwarnings
154    variable warnings  ; incr warnings
155    log "@@ WARN  $msg"
156    return
157}
158
159proc ::sak::validate::versions::Count {modules} {
160    variable maxml 0
161    !
162    foreach m [linsert $modules 0 Module] {
163	= "M $m"
164	set l [string length $m]
165	if {$l > $maxml} {set maxml $l}
166    }
167    =| "Validate versions (indexed vs. provided) ..."
168    return
169}
170
171proc ::sak::validate::versions::Head {m} {
172    variable maxml
173    += ${m}[blank [expr {$maxml - [string length $m]}]]
174    return
175}
176
177###
178
179proc ::sak::validate::versions::InitModuleCounters {} {
180    variable merrors    0
181    variable mwarnings  0
182    return
183}
184
185proc ::sak::validate::versions::ModuleSummary {} {
186    variable merrors
187    variable mwarnings
188
189    set err "E [F $merrors]"
190    set wrn "W [F $mwarnings]"
191
192    if {$mwarnings} { set wrn [=yel $wrn] ; >> warn }
193    if {$merrors}   { set err [=red $err] ; >> fail }
194
195    =| "~~ $err $wrn"
196    return
197}
198
199###
200
201proc ::sak::validate::versions::InitCounters {} {
202    variable errors    0
203    variable warnings  0
204    return
205}
206
207proc ::sak::validate::versions::Summary {} {
208    variable errors
209    variable warnings
210
211    set err   [F $errors]
212    set wrn   [F $warnings]
213
214    if {$errors}    { set err [=red $err] }
215    if {$warnings}  { set wrn [=yel $wrn] }
216
217    sum ""
218    sum "Versions statistics"
219    sum "#Errors:       $err"
220    sum "#Warnings:     $wrn"
221    return
222}
223
224###
225
226proc ::sak::validate::versions::F {n} { format %6d $n }
227
228###
229
230proc ::sak::validate::versions::At {m} {
231    global distribution
232    return [file join $distribution modules $m]
233}
234
235# ###
236
237namespace eval ::sak::validate::versions {
238    # Max length of module names and patchlevel information.
239    variable maxml 0
240
241    # Counters across all modules
242    variable errors    0 ; # Number of errors found (= modules without pkg index)
243    variable warnings  0 ; # Number of warings
244
245    # Same counters, per module.
246    variable merrors    0
247    variable mwarnings  0
248
249    # Map from modules to packages and their versions.
250    variable  pkg
251    array set pkg {}
252}
253
254##
255# ###
256
257package provide sak::validate::versions 1.0
258