#! /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 */*/*] {
unset -nocomplain currpkginfo
set currpkginfo(pkgdir) $pkgdir
set teapot [file join $pkgdir teapot.txt]
set multifile 1
if {![file exists $teapot]} {
set files [glob -directory $pkgdir *]
if {[llength $files] == 1} {
set teapot [lindex $files 0]
set multifile 0
} else {
continue
}
}
set currpkginfo(multifile) $multifile
if {$multifile} {
set currpkginfo(extfile) file.zip
} else {
set currpkginfo(extfile) file.tm
}
set fd [open $teapot r]
set data [read $fd]
close $fd
set processline $multifile
foreach line [split $data \n] {
set line [string trim $line]
if {!$multifile} {
if {$line == "# @@ Meta Begin"} {
set processline 1
continue
}
if {$line == "# @@ Meta End"} {
break
}
set line [regsub {^ *# *} $line {}]
}
if {!$processline} {
continue
}
set cmd "INVALID"
catch {
set cmd [string toupper [lindex $line 0]]
}
switch -- $cmd {
"PACKAGE" {
set name [lindex $line 1]
set vers [lindex $line 2]
set currpkginfo(name) $name
set currpkginfo(vers) $vers
}
"META" {
set var [string tolower [lindex $line 1]]
set val [lrange $line 2 end]
if {![info exists currpkginfo($var)]} {
set currpkginfo($var) ""
}
if {[lsearch -exact $currpkginfo($var) $val] == -1} {
lappend currpkginfo($var) $val
}
}
}
}
set pkginfo([list $currpkginfo(name) $currpkginfo(vers) $currpkginfo(platform)]) [array get currpkginfo]
}
return [array get pkginfo]
}
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_tpm {entlist} {
set ents [list]
foreach part $entlist {
set entinfo [list]
foreach enttype $part {
set type [lindex $enttype 0]
set ent [lindex $enttype 1]
if {$type == "entity"} {
# Only include the entity type if it is complete...
set work [complete_entpath $ent [join $part]]
if {$work == ""} {
continue
}
}
lappend entinfo $ent
}
lappend ents $entinfo
}
set ret {<!-- [[TPM[[}
append ret $ents
append ret {]]MPT]] -->}
return $ret
}
proc generate_table {fields numitems} {
set ret ""
foreach field $fields {
append ret " <tr>\n"
unset -nocomplain entinfo
foreach enttype [lrange $field 0 [expr $numitems - 1]] {
set type [lindex $enttype 0]
set item [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 type [lindex $enttype 0]
set item [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 name $pkg]]
if {[lsearch -exact $pkglist $addent] != -1} {
continue
}
lappend pkglist $addent
}
set pkglist [lsort -dictionary $pkglist]
file mkdir [file dirname $indexfile]
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 mkdir [file dirname $altindexfile]
file delete -force -- $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 [list entity package] [list name $pkg] [list ver $ver] [list arch $arch] [list unknown 0]]
}
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>"
puts $fd [generate_tpm $pkglist]
puts $fd " <h1>List of all packages</h1>"
puts $fd " <table>"
puts $fd " <tr>"
puts $fd " <th>What</th>"
puts $fd " <th>Name</th>"
puts $fd " <th>Version</th>"
puts $fd " <th>Platform</th>"
puts $fd " </tr>"
puts $fd [generate_table $pkglist 4]
puts $fd " </table>"
puts $fd " </body>"
puts $fd "</html>"
close $fd
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
foreach ent [array names pkginfo] {
set pkg [lindex $ent 0]
set ver [lindex $ent 1]
set arch [lindex $ent 2]
array set currpkginfo $pkginfo($ent)
set pkgdir $currpkginfo(pkgdir)
set multifile $currpkginfo(multifile)
set extfiletail $currpkginfo(extfile)
set workdir [file join $dstdir package name $pkg ver $ver arch $arch]
set regfile [file join $workdir file]
set extfile [file join $workdir $extfiletail]
if {[file exists $extfile] && !$force} {
continue
}
catch {
file mkdir $workdir
}
if {$multifile} {
if {[catch {
cd $pkgdir
file delete -- $extfile
exec zip -r $extfile . -x build.log
} err]} {
puts "Error while zipping: $err"
}
} else {
set origfile [lindex [glob -directory $pkgdir *] 0]
file copy -force -- $origfile $extfile
}
file delete -- $regfile
file link -hard $regfile $extfile
file attributes $regfile -permissions -x
file attributes $extfile -permissions -x
}
}
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 $entity_type]]
foreach dispfield $dispfields {
lappend currpkgdata [list $dispfield $currpkginfo($dispfield)]
}
if {[lsearch -exact $pkglist $currpkgdata] != -1} {
continue
}
lappend pkglist $currpkgdata
}
set pkglist [lsort -dictionary $pkglist]
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\" cellpadding=\"5\">"
puts $fd " <tr>"
puts $fd " <th>Key</th>"
puts $fd " <th>Value</th>"
puts $fd " </tr>"
foreach descfield [list rsk::build::date as::author as::build::date as::origin category description license platform require summary] {
if {![info exists currpkginfo($descfield)]} {
continue
}
set descval $currpkginfo($descfield)
switch -- $descfield {
"require" - "as::author" - "as::origin" {
catch {
set descval [join $descval]
}
}
}
puts $fd " <tr>"
puts $fd " <td>$descfield</td>"
puts $fd " <td>[join $descval "<br>"]</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)
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
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
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