492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
|
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
|
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+
-
-
-
-
-
+
+
+
+
-
-
-
-
+
+
+
+
-
+
+
|
close $fd
file rename -force -- $tmpindexfile $indexfile
}
proc create_all_entity_files {dstdir pkginfo_arrlist} {
set entfields $::entity_definition(package)
for {set idx 0} {$idx < [llength $entfields]} {incr idx} {
set fieldname [lindex $entfields $idx]
set fieldname_to_idx($fieldname) $idx
}
set enttypes_list [list]
for {set idx 1} {$idx < int(pow(2, [llength $entfields]))} {incr idx} {
set enttypes_list_cur [list]
for {set subidx 0} {$subidx < [llength $entfields]} {incr subidx} {
if {$idx & (1 << $subidx)} {
lappend enttypes_list_cur [lindex $entfields $subidx]
}
}
lappend enttypes_list $enttypes_list_cur
}
array set pkginfo $pkginfo_arrlist
set seen_entities [list]
foreach pkgdata [lsort -dictionary [array names pkginfo]] {
foreach enttypes $enttypes_list {
unset -nocomplain entity
lappend entity entity package
unset -nocomplain entity
lappend entity entity package
for {set endidx 0} {$endidx < [llength $entfields]} {incr endidx} {
set enttype [lindex $entfields $endidx]
set entval [lindex $pkgdata $endidx]
lappend entity $enttype
lappend entity $entval
foreach enttype $enttypes {
set entval [lindex $pkgdata $fieldname_to_idx($enttype)]
lappend entity $enttype
lappend entity $entval
if {[lsearch -exact $seen_entities $entity] != -1} {
continue
}
lappend seen_entities $entity
if {[lsearch -exact $seen_entities $entity] != -1} {
continue
}
lappend seen_entities $entity
create_entity_file $entity $dstdir $pkginfo_arrlist
create_entity_file $entity $dstdir $pkginfo_arrlist
}
}
}
}
set pkginfo [teapot_index $srcdir]
create_output_index $dstdir $pkginfo
create_output_pkglist $dstdir $pkginfo
|