Check-in [1bf8a9efe1]
Overview
Comment:Added teapot project (client-only so far), derivative of starkit2exe
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:1bf8a9efe1e0ab00f2f346daadd85001b66ce1d5
User & Date: rkeene on 2009-04-18 02:43:20
Other Links: manifest | tags
Context
2009-04-18
02:48
Renamed teapot.tcl to teapot-client.tcl check-in: d64ee24bd0 user: rkeene tags: trunk
02:43
Added teapot project (client-only so far), derivative of starkit2exe check-in: 1bf8a9efe1 user: rkeene tags: trunk
02:43
initial empty check-in check-in: 23dfc15ca5 user: rkeene tags: trunk
Changes

Added client/lib/teapotclient0.1/pkgIndex.tcl version [f041fc3a79].

            1  +# Tcl package index file, version 1.1
            2  +# This file is generated by the "pkg_mkIndex" command
            3  +# and sourced either when an application starts up or
            4  +# by a "package unknown" script.  It invokes the
            5  +# "package ifneeded" command to set up package-related
            6  +# information so that packages will be loaded automatically
            7  +# in response to "package require" commands.  When this
            8  +# script is sourced, the variable $dir must contain the
            9  +# full path name of this file's directory.
           10  +
           11  +package ifneeded teapotclient 0.1 [list source [file join $dir teapotclient.tcl]]

Added client/lib/teapotclient0.1/teapotclient.tcl version [b940fef8b1].

            1  +#! /usr/bin/env tclsh
            2  +
            3  +# This file has no license.  It is in the public domain.
            4  +# -- Roy Keene <tcl@rkeene.org> [20081025T1400Q]
            5  +
            6  +package require md5
            7  +package require http
            8  +package require fileutil
            9  +
           10  +namespace eval ::teapotclient {}
           11  +namespace eval ::teapotclient {
           12  +	set pkgcachedir "/tmp/DELETEME_teapotclient_[string tolower [md5::md5 -hex [list [info script] $::tcl_platform(user)]]].cache"
           13  +
           14  +        # Conversions from Teapot-style names to local ones
           15  +	set osTeapotToLocal(tcl) *
           16  +	set osTeapotToLocal(linux-*) linux
           17  +	set osTeapotToLocal(win32) windows
           18  +	set osTeapotToLocal(solaris*) solaris
           19  +	set osTeapotToLocal(freebsd) freebsd_*
           20  +	set osTeapotToLocal(irix) irix_*
           21  +
           22  +	set cpuTeapotToLocal(ix86) x86
           23  +	set cpuTeapotToLocal(sparc) sun4*
           24  +	set cpuTeapotToLocal(universal) *
           25  +	set cpuTeapotToLocal(powerpc) ppc
           26  +
           27  +	proc download_extensions {rootdir servers extensions os cpu {existingExts "Tcl Tk"}} {
           28  +		foreach server $servers {
           29  +			foreach {pkg pkginfo} [get_extensions $server $os $cpu] {
           30  +				foreach pkginstance $pkginfo {
           31  +					lappend pkginstance $server
           32  +					lappend pkgdata($pkg) $pkginstance
           33  +				}
           34  +			}
           35  +		}
           36  +
           37  +		foreach pkg [array names pkgdata] {
           38  +			set pkgdata($pkg) [lsort -decreasing -dictionary $pkgdata($pkg)]
           39  +		}
           40  +
           41  +		array set extDependencies [list]
           42  +		foreach extension $extensions {
           43  +			set extension [file tail $extension]
           44  +
           45  +			if {![info exists pkgdata($extension)]} {
           46  +				continue
           47  +			}
           48  +
           49  +			set pkginfo [lindex $pkgdata($extension) 0]
           50  +
           51  +			set ver [lindex $pkginfo 0]
           52  +			set arch [lindex $pkginfo 1]
           53  +			set server [lindex $pkginfo 2]
           54  +
           55  +			set pkgdir [file join $rootdir lib $extension$ver]
           56  +			file mkdir $pkgdir $::teapotclient::pkgcachedir
           57  +
           58  +			set url "http://$server/package/name/$extension/ver/$ver/arch/$arch/file"
           59  +			set urlcachefile [file join $::teapotclient::pkgcachedir [::md5::md5 -hex $url]]
           60  +
           61  +			if {![file exists $urlcachefile]} {
           62  +				set tmpfd [open $urlcachefile w]
           63  +				set token [::http::geturl $url -channel $tmpfd]
           64  +
           65  +				::http::cleanup $token
           66  +				close $tmpfd
           67  +			}
           68  +
           69  +			set retarr($extension) [list $ver $arch $server]
           70  +			switch -regexp -- [::fileutil::fileType $urlcachefile] {
           71  +				"(^| )zip($| )" {
           72  +					catch {
           73  +						exec unzip -d $pkgdir -n -qq $urlcachefile
           74  +					}
           75  +
           76  +					# Process $pkgdir/teapot.txt
           77  +					set teapot [file join $pkgdir teapot.txt]
           78  +					if {[file exists $teapot]} {
           79  +						set fd [open $teapot r]
           80  +						for {gets $fd line} {![eof $fd]} {gets $fd line} {
           81  +							if {[string match "Meta require *" $line]} {
           82  +								set depinfo [lindex $line 2]
           83  +								set dep [lindex $depinfo 0]
           84  +								set depextra [lrange $depinfo 1 end]
           85  +								lappend extDependencies($dep) $depextra
           86  +							}
           87  +						}
           88  +						close $fd
           89  +					}
           90  +				}
           91  +				"(^| )text($| )" {
           92  +					unset -nocomplain fd
           93  +
           94  +					set extfile [file join $pkgdir ${extension}.tcl]
           95  +					set idxfile [file join $pkgdir pkgIndex.tcl]
           96  +
           97  +					catch {
           98  +						file copy -force -- $urlcachefile $extfile
           99  +
          100  +						set fd [open $idxfile w]
          101  +						puts $fd "package ifneeded $extension $ver \[list source \[file join \$dir [file tail $extfile]\]\]"
          102  +					}
          103  +
          104  +					catch {
          105  +						close $fd
          106  +					}
          107  +
          108  +					# Process $extfile
          109  +					set fd [open $extfile r]
          110  +					for {gets $fd line} {![eof $fd]} {gets $fd line} {
          111  +						if {[string match "# Meta require *" $line]} {
          112  +							set depinfo [lindex $line 3]
          113  +							set dep [lindex $depinfo 0]
          114  +							set depextra [lrange $depinfo 1 end]
          115  +							lappend extDependencies($dep) $depextra
          116  +						}
          117  +					}
          118  +					close $fd
          119  +				}
          120  +			}
          121  +		}
          122  +
          123  +		foreach {dep depinfo} [array get extDependencies] {
          124  +			set depReq -1
          125  +			foreach depinstinfo $depinfo {
          126  +				set depver [lindex $depinstinfo 0]
          127  +				set depinstinfo [lrange $depinstinfo 1 end]
          128  +
          129  +				foreach {var val} $depinstinfo {
          130  +					switch -- $var {
          131  +						"-platform" {
          132  +							if {$val != $os} {
          133  +								if {$depReq == -1} {
          134  +									set depReq 0
          135  +								}
          136  +							}
          137  +						}
          138  +					}
          139  +				}
          140  +			}
          141  +
          142  +			if {$depReq == 0} {
          143  +				continue
          144  +			}
          145  +
          146  +			if {[lsearch $existingExts $dep] == -1} {
          147  +				lappend existingExts $dep
          148  +				lappend fetchDeps $dep
          149  +			}
          150  +		}
          151  +
          152  +		if {[info exists fetchDeps]} {
          153  +			set addRet [download_extensions_teapot $rootdir $servers $fetchDeps $os $cpu $existingExts]
          154  +			array set retarr $addRet
          155  +		}
          156  +
          157  +		return [array get retarr]
          158  +	}
          159  +
          160  +	proc get_extensions {server {limitos "*"} {limitcpu "*"}} {
          161  +		upvar ::teapotclient::osTeapotToLocal osTeapotToLocal
          162  +		upvar ::teapotclient::cpuTeapotToLocal cpuTeapotToLocal
          163  +
          164  +		file mkdir $::teapotclient::pkgcachedir
          165  +		set cachefile [file join $::teapotclient::pkgcachedir TEAPOTINFO]
          166  +		
          167  +		set currtime [clock seconds]
          168  +
          169  +		if {[file exists $cachefile]} {
          170  +			catch {
          171  +				set fd [open $cachefile r]
          172  +				set data [read $fd]
          173  +				close $fd
          174  +
          175  +				set datatime [lindex $data 0]
          176  +				if {($currtime - $datatime) < 86400} {
          177  +					set children [lindex $data 1]
          178  +				}
          179  +			}
          180  +		}
          181  +
          182  +		if {![info exists children]} {
          183  +			package require http
          184  +
          185  +			set url "http://[join [list $server package list] /]"
          186  +
          187  +			set token [::http::geturl $url]
          188  +			if {[::http::ncode $token] != "200"} {
          189  +				return [list]
          190  +			}
          191  +
          192  +			set data [::http::data $token]
          193  +			::http::cleanup $token
          194  +
          195  +			set work [join [split $data \n] { }]
          196  +			regexp {\[\[TPM\[\[(.*)\]\]MPT\]\]} $work -> children
          197  +
          198  +			catch {
          199  +				set fd [open $cachefile w]
          200  +				puts $fd [list $currtime $children]
          201  +				close $fd
          202  +			}
          203  +		}
          204  +
          205  +		foreach child $children {
          206  +			set type [lindex $child 0]
          207  +			if {$type != "package"} {
          208  +				continue
          209  +			}
          210  +
          211  +			set pkg [lindex $child 1]
          212  +			set ver [lindex $child 2]
          213  +			set arch [lindex $child 3]
          214  +			set arch_work [split $arch -]
          215  +			set arch_os [join [lrange $arch_work 0 end-1] -]
          216  +			set arch_cpu [lindex $arch_work end]
          217  +
          218  +			if {$arch == "source"} {
          219  +				continue
          220  +			}
          221  +
          222  +			set isCompatOS 0
          223  +			if {$arch == "tcl"} {
          224  +				set isCompatOS 1
          225  +			} elseif {[string match $limitos $arch_os]} {
          226  +				set isCompatOS 1
          227  +			} else {
          228  +				foreach {teapot local} [array get osTeapotToLocal] {
          229  +					if {[string match $limitos $local] || [string match $local $limitos]} {
          230  +						if {[string match $teapot $arch_os] || [string match $arch_os $teapot]} {
          231  +							set isCompatOS 1
          232  +							break
          233  +						}
          234  +					}
          235  +				}
          236  +			}
          237  +			if {!$isCompatOS} {
          238  +				continue
          239  +			}
          240  +
          241  +			set isCompatCPU 0
          242  +			if {$arch == "tcl"} {
          243  +				set isCompatCPU 1
          244  +			} elseif {[string match $limitcpu $arch_cpu]} {
          245  +				set isCompatCPU 1
          246  +			} else {
          247  +				foreach {teapot local} [array get cpuTeapotToLocal] {
          248  +					if {[string match $limitcpu $local] || [string match $local $limitcpu]} {
          249  +						if {[string match $teapot $arch_cpu] || [string match $arch_cpu $teapot]} {
          250  +							set isCompatCPU 1
          251  +							break
          252  +						}
          253  +					}
          254  +				}
          255  +			}
          256  +			if {!$isCompatCPU} {
          257  +				continue
          258  +			}
          259  +
          260  +			lappend pkginfo($pkg) [list $ver $arch]
          261  +		}
          262  +
          263  +		foreach pkg [array names pkginfo] {
          264  +			set pkginfo($pkg) [lsort -decreasing -dictionary $pkginfo($pkg)]
          265  +		}
          266  +
          267  +		return [array get pkginfo]
          268  +	}
          269  +
          270  +}
          271  +
          272  +package provide teapotclient 0.1

Added client/teapot.tcl version [384fceb21a].

            1  +#! /usr/bin/env tclsh
            2  +
            3  +set teapotservers [list teapot.activestate.com]
            4  +
            5  +lappend auto_path [file join [file dirname [info script]] lib]
            6  +
            7  +package require teapotclient
            8  +
            9  +proc print_help {} {
           10  +	puts stderr "Usage: teapot.tcl get <dir> <os> <cpu> <packages...>"
           11  +	puts stderr "Usage: teapot.tcl list ?<os> ?<cpu>??"
           12  +}
           13  +
           14  +set cmd [lindex $argv 0]
           15  +set argv [lrange $argv 1 end]
           16  +
           17  +switch -- $cmd {
           18  +	"get" {
           19  +		if {[llength $argv] < 4} {
           20  +			print_help
           21  +			exit 1
           22  +		}
           23  +
           24  +		set dir [lindex $argv 0]
           25  +		set os [lindex $argv 1]
           26  +		set cpu [lindex $argv 2]
           27  +		set packages [lrange $argv 3 end]
           28  +		set extsinfo [::teapotclient::download_extensions $dir $teapotservers $packages $os $cpu]
           29  +		set exts [list]
           30  +		puts "Fetched Extensions:"
           31  +		foreach {ext extinfo} $extsinfo {
           32  +			lappend exts $ext
           33  +			puts "  $ext v[lindex $extinfo 0]"
           34  +		}
           35  +
           36  +		set failedexts [list]
           37  +		foreach pkg $packages {
           38  +			if {[lsearch -exact $exts $pkg] == -1} {
           39  +				lappend failedexts $pkg
           40  +			}
           41  +		}
           42  +		if {[llength $failedexts] != 0} {
           43  +			puts "Failed to fetch:"
           44  +			foreach ext $failedexts {
           45  +				puts "  $ext"
           46  +			}
           47  +			exit 1
           48  +		}
           49  +	}
           50  +	"list" {
           51  +		set os "*"
           52  +		set cpu "*"
           53  +		if {[llength $argv] > 0} {
           54  +			set os [lindex $argv 0]
           55  +		}
           56  +		if {[llength $argv] > 1} {
           57  +			set cpu [lindex $argv 1]
           58  +		}
           59  +
           60  +		puts "Extensions available for OS=$os, CPU=$cpu:"
           61  +
           62  +		set extsinfo [::teapotclient::get_extensions $teapotservers $os $cpu]
           63  +		foreach {ext extinfo} $extsinfo {
           64  +			set extvers [list]
           65  +			foreach extinfoitem $extinfo {
           66  +				set extinfoitemvers [lindex $extinfoitem 0]
           67  +				if {[lsearch -exact $extvers $extinfoitemvers] == -1} {
           68  +					lappend extvers $extinfoitemvers
           69  +				}
           70  +			}
           71  +			set extvers [lsort -decreasing -dictionary $extvers]
           72  +
           73  +			puts "  $ext [lindex $extvers 0]"
           74  +		}
           75  +	}
           76  +	default {
           77  +		print_help
           78  +		exit 1
           79  +	}
           80  +}