1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
|
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
|
+
+
+
+
+
+
+
+
+
+
|
#! /usr/bin/env tclsh
if {[llength $argv] != "2"} {
puts stderr "Usage: teapot_index <srcdir> <destdir>"
exit 1
}
set srcdir [file normalize [lindex $argv 0]]
set dstdir [file normalize [lindex $argv 1]]
# Define requirements for entities
## Must be sync'd with [teapot_index]
set entity_definition(package) [list name ver arch]
# Define maping of field name to text
set entity_fieldnames([list package name]) "Name"
set entity_fieldnames([list package ver]) "Version"
set entity_fieldnames([list package arch]) "Platform"
set entity_fieldnames([list entity]) "What"
# Index all packages
proc teapot_index {srcdir} {
array set pkginfo [list]
foreach pkgdir [glob -directory $srcdir -type d */out/*] {
unset -nocomplain currpkginfo
set currpkginfo(pkgdir) $pkgdir
|
| ︙ | | |
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
|
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
|
+
+
+
+
+
+
+
+
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
-
+
+
+
+
+
+
+
-
+
+
+
|
set pkginfo([list $currpkginfo(name) $currpkginfo(vers) $currpkginfo(platform)]) [array get currpkginfo]
}
return [array get pkginfo]
}
proc generate_tpm {entlist} {
set pkgs [list]
foreach part $entlist {
set pkginfo [list]
foreach enttype $part {
set pkg [lindex $enttype 0]
lappend pkginfo $pkg
}
lappend pkgs $pkginfo
}
set ret {<!-- [[TPM[[}
append ret $entlist
append ret $pkgs
append ret {]]MPT]] -->}
return $ret
}
proc complete_entpath {type entinfo_arrlist} {
array set entinfo $entinfo_arrlist
set req_fields $::entity_definition($type)
set retval [list $type]
foreach req_field $req_fields {
if {![info exists entinfo($req_field)]} {
return ""
}
lappend retval $req_field $entinfo($req_field)
}
return $retval
}
proc generate_table {fields numitems} {
set ret ""
foreach field $fields {
append ret " <tr>\n"
unset -nocomplain entinfo
foreach part [lrange $field 0 [expr $numitems - 1]] {
append ret " <td>$part</td>\n"
foreach enttype [lrange $field 0 [expr $numitems - 1]] {
set item [lindex $enttype 0]
set type [lindex $enttype 1]
set entinfo($type) $item
}
if {[info exists entinfo(entity)]} {
set entity_type $entinfo(entity)
set req_fields $::entity_definition($entity_type)
}
set entpath_parts [list]
foreach enttype [lrange $field 0 [expr $numitems - 1]] {
set item [lindex $enttype 0]
set type [lindex $enttype 1]
if {$type != "entity"} {
lappend entpath_parts $type $item
}
set complete_entpath_parts ""
if {[info exists entity_type]} {
set complete_entpath_parts [complete_entpath $entity_type $entpath_parts]
}
if {$complete_entpath_parts == ""} {
set entpath [join [join [list entity $entpath_parts]] /]
} else {
set entpath [join $complete_entpath_parts /]
}
append ret " <td><a href=\"/$entpath\">$item</a></td>\n"
}
append ret " </tr>\n"
}
return [string range $ret 0 end-1]
}
# Create "index.html"
proc create_output_index {dstdir pkginfo_arrlist} {
array set pkginfo $pkginfo_arrlist
set indexfile [file join $dstdir index.html]
set altindexfile [file join $dstdir entity index.html]
set pkglist [list]
foreach ent [array names pkginfo] {
set pkg [lindex $ent 0]
set addent [list [list $pkg name]]
if {[lsearch -exact $pkglist $pkg] != -1} {
if {[lsearch -exact $pkglist $addent] != -1} {
continue
}
lappend pkglist $pkg
lappend pkglist $addent
}
set pkglist [lsort -dictionary $pkglist]
set fd [open $indexfile w]
puts $fd "<html>"
puts $fd " <head>"
puts $fd " <title>List of all entities</title>"
puts $fd " </head>"
puts $fd " <body>"
puts $fd [generate_tpm $pkglist]
puts $fd " <h1>List of all entities</h1>"
puts $fd " <table>"
puts $fd [generate_table $pkglist 1]
puts $fd " </table>"
puts $fd " </body>"
puts $fd "</html>"
close $fd
file delete -- $altindexfile
file mkdir [file dirname $altindexfile]
file link -hard $altindexfile $indexfile
}
# Create "package/list"
proc create_output_pkglist {dstdir pkginfo_arrlist} {
array set pkginfo $pkginfo_arrlist
set pkgdir [file join $dstdir package]
catch {
file mkdir $pkgdir
}
set indexfile [file join $pkgdir list.html]
set altindexfile [file join $pkgdir list]
set pkglist [list]
foreach ent [array names pkginfo] {
set pkg [lindex $ent 0]
set ver [lindex $ent 1]
set arch [lindex $ent 2]
lappend pkglist [list package $pkg $ver $arch 0]
lappend pkglist [list [list package entity] [list $pkg name] [list $ver ver] [list $arch arch] [list 0 unknown]]
}
set pkglist [lsort -dictionary $pkglist]
set fd [open $indexfile w]
puts $fd "<html>"
puts $fd " <head>"
puts $fd " <title>List of all packages</title>"
puts $fd " </head>"
puts $fd " <body>"
|
| ︙ | | |
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
|
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
|
-
+
|
puts $fd " </tr>"
puts $fd [generate_table $pkglist 4]
puts $fd " </table>"
puts $fd " </body>"
puts $fd "</html>"
close $fd
file delete $altindexfile
file delete -- $altindexfile
file link -hard $altindexfile $indexfile
}
# Create "package/name/<pkg>/ver/<ver>/arch/<arch>/file"
proc create_output_files {dstdir pkginfo_arrlist {force 0}} {
array set pkginfo $pkginfo_arrlist
|
| ︙ | | |
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
|
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
|
-
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
if {[file exists $extfile] && !$force} {
continue
}
if {[catch {
cd $pkgdir
file delete $extfile
file delete -- $extfile
exec zip -r $extfile . -x build.log
} err]} {
puts "Error while zipping: $err"
}
} else {
set origfile [lindex [glob $pkgdir *] 0]
file copy -force -- $origfile $extfile
}
file delete $regfile
file delete -- $regfile
file link -hard $regfile $extfile
}
}
proc create_entity_file {entity dstdir pkginfo_arrlist} {
array set pkginfo $pkginfo_arrlist
array set entinfo $entity
if {![info exists entinfo(entity)]} {
return
}
set entity_type $entinfo(entity)
set req_fields $::entity_definition($entity_type)
set complete 1
set pkgpat [list]
set dispfields [list]
foreach req_field $req_fields {
if {![info exists entinfo($req_field)]} {
set complete 0
lappend pkgpat "*"
if {![info exists pkgnextlevel]} {
set pkgnextlevel $req_field
lappend dispfields $req_field
}
} else {
lappend pkgpat $entinfo($req_field)
lappend dispfields $req_field
}
}
if {$complete} {
set entpath_parts [list $entity_type]
foreach req_field $req_fields {
lappend entpath_parts $req_field $entinfo($req_field)
}
} else {
set entpath_parts [list entity]
foreach req_field $req_fields {
if {[info exists entinfo($req_field)]} {
lappend entpath_parts $req_field $entinfo($req_field)
}
}
}
set entpath [join $entpath_parts /]
if {[string match "/*" $entpath]} {
return
}
set indexfile [file join $dstdir $entpath index.html]
set tmpindexfile [file join $dstdir $entpath index.html.tmp]
catch {
file mkdir [file dirname $indexfile]
}
set fd [open $tmpindexfile w]
puts $fd "<html>"
puts $fd " <head>"
puts $fd " <title>"
puts $fd " </title>"
puts $fd " </head>"
puts $fd " <body>"
set pkglist [list]
if {!$complete} {
foreach pkgent [array names pkginfo $pkgpat] {
unset -nocomplain currpkginfo
for {set idx 0} {$idx < [llength $req_fields]} {incr idx} {
set field [lindex $req_fields $idx]
set value [lindex $pkgent $idx]
set currpkginfo($field) $value
}
set currpkgdata [list [list $entity_type entity]]
foreach dispfield $dispfields {
lappend currpkgdata [list $currpkginfo($dispfield) $dispfield]
}
if {[lsearch -exact $pkglist $currpkgdata] != -1} {
continue
}
lappend pkglist $currpkgdata
}
puts $fd [generate_tpm $pkglist]
puts $fd " <h1>$pkgnextlevel</h1>"
puts $fd " <table>"
puts $fd " <tr>"
foreach dispfield [join [list entity $dispfields]] {
if {[info exists ::entity_fieldnames([list $entity_type $dispfield])]} {
set dispfieldheader $::entity_fieldnames([list $entity_type $dispfield])
} else {
set dispfieldheader $::entity_fieldnames([list $dispfield])
}
puts $fd " <th>$dispfieldheader</th>"
}
puts $fd " </tr>"
puts $fd [generate_table $pkglist 10]
puts $fd " </table>"
} else {
set dispname_list [list]
set pathname_list [list $entity_type]
foreach field $req_fields {
lappend dispname_list $entinfo($field)
lappend pathname_list $field $entinfo($field)
}
set key $dispname_list
array set currpkginfo $pkginfo($key)
set pathname_dir "[join $pathname_list /]"
set pathname_dirlocal [file join $dstdir $pathname_dir]
set pathname_tail $currpkginfo(extfile)
if {$pathname_tail == ""} {
set pathname_tail "file"
}
set pathname_uri "/$pathname_dir/$pathname_tail"
puts $fd " <h1>Details of $entity_type [join $dispname_list]</h1>"
puts $fd " <p><a href=\"$pathname_uri\">Package archive</a></p>"
puts $fd " <p>Details</p>"
puts $fd " <table border=\"1\">"
puts $fd " <tr>"
puts $fd " <th>Key</th>"
puts $fd " <th>Value</th>"
puts $fd " </tr>"
foreach descfield [list rsk::build::date category description license platform require summary] {
if {![info exists currpkginfo($descfield)]} {
continue
}
set descval $currpkginfo($descfield)
switch -- $descfield {
"require" {
catch {
set descval [join $descval {, }]
}
}
}
puts $fd " <tr>"
puts $fd " <td>$descfield</td>"
puts $fd " <td>$descval</td>"
puts $fd " </tr>"
}
puts $fd " </table>"
}
puts $fd " </body>"
puts $fd "</html>"
close $fd
file rename -force -- $tmpindexfile $indexfile
}
proc create_all_entity_files {dstdir pkginfo_arrlist} {
set entfields $::entity_definition(package)
array set pkginfo $pkginfo_arrlist
set seen_entities [list]
foreach pkgdata [lsort -dictionary [array names pkginfo]] {
unset -nocomplain entity
lappend entity entity package
for {set endidx 0} {$endidx < [llength $entfields]} {incr endidx} {
lappend entity [lindex $entfields $endidx]
lappend entity [lindex $pkgdata $endidx]
if {[lsearch -exact $seen_entities $entity] != -1} {
continue
}
lappend seen_entities $entity
create_entity_file $entity $dstdir $pkginfo_arrlist
}
}
}
set pkginfo [teapot_index $srcdir]
create_output_index $dstdir $pkginfo
create_output_pkglist $dstdir $pkginfo
create_output_files $dstdir $pkginfo
create_all_entity_files $dstdir $pkginfo
|