teapot_index at [4fbd51bc1d]

File server/teapot_index artifact 3523082fbc part of check-in 4fbd51bc1d


#! /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]]

# 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

		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]

					set currpkginfo($var) $val
				}
			}
		}

		set pkginfo([list $currpkginfo(name) $currpkginfo(vers) $currpkginfo(platform)]) [array get currpkginfo]
	}

	return [array get pkginfo]
}

proc generate_tpm {entlist} {
	set ret {<!-- [[TPM[[}
	append ret $entlist
	append ret {]]MPT]] -->}

	return $ret
}

proc generate_table {fields numitems} {
	set ret ""

	foreach field $fields {
		append ret "      <tr>\n"

		foreach part [lrange $field 0 [expr $numitems - 1]] {
			append ret "        <td>$part</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 pkglist [list]
	foreach ent [array names pkginfo] {
		set pkg [lindex $ent 0]
		if {[lsearch -exact $pkglist $pkg] != -1} {
			continue
		}

		lappend pkglist $pkg
	}

	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
}

# 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]
	}

	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]
		catch {
			file mkdir $workdir
		}

		if {$multifile} {
			if {[file exists $extfile] && !$force} {
				continue
			}

			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 $pkgdir *] 0]

			file copy -force -- $origfile $extfile
		}

		file delete $regfile
		file link -hard $regfile $extfile
	}
}

set pkginfo [teapot_index $srcdir]
create_output_index $dstdir $pkginfo
create_output_pkglist $dstdir $pkginfo
create_output_files $dstdir $pkginfo