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 +}