#! /usr/bin/env tclsh if {[llength $argv] != "2"} { puts stderr "Usage: teapot_index " 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 -nocomplain -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 -nocomplain -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 {} return $ret } proc generate_table {fields numitems} { set ret "" foreach field $fields { append ret " \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 " $item\n" } append ret " \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 "" puts $fd " " puts $fd " List of all entities" puts $fd " " puts $fd " " puts $fd [generate_tpm $pkglist] puts $fd "

List of all entities

" puts $fd " " puts $fd [generate_table $pkglist 1] puts $fd "
" puts $fd " " puts $fd "" 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 "" puts $fd " " puts $fd " List of all packages" puts $fd " " puts $fd " " puts $fd [generate_tpm $pkglist] puts $fd "

List of all packages

" puts $fd " " puts $fd " " puts $fd " " puts $fd " " puts $fd " " puts $fd " " puts $fd " " puts $fd [generate_table $pkglist 4] puts $fd "
WhatNameVersionPlatform
" puts $fd " " puts $fd "" close $fd file delete -- $altindexfile file link -hard $altindexfile $indexfile } # Create "package/name//ver//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 -nocomplain -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 "" puts $fd " " puts $fd " " puts $fd " " puts $fd " " puts $fd " " 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 "

$pkgnextlevel

" puts $fd " " puts $fd " " 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 " " } puts $fd " " puts $fd [generate_table $pkglist 10] puts $fd "
$dispfieldheader
" } 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 "

Details of $entity_type [join $dispname_list]

" puts $fd "

Package archive

" puts $fd "

Details

" puts $fd " " puts $fd " " puts $fd " " puts $fd " " puts $fd " " 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 " " puts $fd " " puts $fd " " puts $fd " " } puts $fd "
KeyValue
$descfield[join $descval "
"]
" } puts $fd " " puts $fd "" 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