teapot_index at [6b2622b683]

File server/teapot_index artifact 18e199e0c9 part of check-in 6b2622b683


#! /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 -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 {<!-- [[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 -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 "<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