Hex Artifact Content

Artifact c44684b043a659ef81082b4cd8af074862f2fb07:


0000: 23 21 20 2f 75 73 72 2f 62 69 6e 2f 65 6e 76 20  #! /usr/bin/env 
0010: 74 63 6c 73 68 0a 0a 73 65 74 20 74 65 61 70 6f  tclsh..set teapo
0020: 74 73 65 72 76 65 72 73 20 5b 6c 69 73 74 20 74  tservers [list t
0030: 65 61 70 6f 74 2e 61 63 74 69 76 65 73 74 61 74  eapot.activestat
0040: 65 2e 63 6f 6d 5d 0a 0a 6c 61 70 70 65 6e 64 20  e.com]..lappend 
0050: 61 75 74 6f 5f 70 61 74 68 20 5b 66 69 6c 65 20  auto_path [file 
0060: 6a 6f 69 6e 20 5b 66 69 6c 65 20 64 69 72 6e 61  join [file dirna
0070: 6d 65 20 5b 69 6e 66 6f 20 73 63 72 69 70 74 5d  me [info script]
0080: 5d 20 6c 69 62 5d 0a 0a 70 61 63 6b 61 67 65 20  ] lib]..package 
0090: 72 65 71 75 69 72 65 20 74 65 61 70 6f 74 63 6c  require teapotcl
00a0: 69 65 6e 74 0a 0a 70 72 6f 63 20 70 72 69 6e 74  ient..proc print
00b0: 5f 68 65 6c 70 20 7b 7d 20 7b 0a 09 70 75 74 73  _help {} {..puts
00c0: 20 73 74 64 65 72 72 20 22 55 73 61 67 65 3a 20   stderr "Usage: 
00d0: 74 65 61 70 6f 74 2d 63 6c 69 65 6e 74 20 67 65  teapot-client ge
00e0: 74 20 3c 64 69 72 3e 20 3c 6f 73 3e 20 3c 63 70  t <dir> <os> <cp
00f0: 75 3e 20 3c 70 61 63 6b 61 67 65 73 2e 2e 2e 3e  u> <packages...>
0100: 22 0a 09 70 75 74 73 20 73 74 64 65 72 72 20 22  "..puts stderr "
0110: 55 73 61 67 65 3a 20 74 65 61 70 6f 74 2d 63 6c  Usage: teapot-cl
0120: 69 65 6e 74 20 6c 69 73 74 20 3f 3c 6f 73 3e 20  ient list ?<os> 
0130: 3f 3c 63 70 75 3e 3f 3f 22 0a 7d 0a 0a 73 65 74  ?<cpu>??".}..set
0140: 20 63 6d 64 20 5b 6c 69 6e 64 65 78 20 24 61 72   cmd [lindex $ar
0150: 67 76 20 30 5d 0a 73 65 74 20 61 72 67 76 20 5b  gv 0].set argv [
0160: 6c 72 61 6e 67 65 20 24 61 72 67 76 20 31 20 65  lrange $argv 1 e
0170: 6e 64 5d 0a 0a 73 77 69 74 63 68 20 2d 2d 20 24  nd]..switch -- $
0180: 63 6d 64 20 7b 0a 09 22 67 65 74 22 20 7b 0a 09  cmd {.."get" {..
0190: 09 69 66 20 7b 5b 6c 6c 65 6e 67 74 68 20 24 61  .if {[llength $a
01a0: 72 67 76 5d 20 3c 20 34 7d 20 7b 0a 09 09 09 70  rgv] < 4} {....p
01b0: 72 69 6e 74 5f 68 65 6c 70 0a 09 09 09 65 78 69  rint_help....exi
01c0: 74 20 31 0a 09 09 7d 0a 0a 09 09 73 65 74 20 65  t 1...}....set e
01d0: 78 69 73 74 69 6e 67 65 78 74 73 20 5b 6c 69 73  xistingexts [lis
01e0: 74 5d 0a 0a 09 09 73 65 74 20 64 69 72 20 5b 6c  t]....set dir [l
01f0: 69 6e 64 65 78 20 24 61 72 67 76 20 30 5d 0a 09  index $argv 0]..
0200: 09 73 65 74 20 6f 73 20 5b 6c 69 6e 64 65 78 20  .set os [lindex 
0210: 24 61 72 67 76 20 31 5d 0a 09 09 73 65 74 20 63  $argv 1]...set c
0220: 70 75 20 5b 6c 69 6e 64 65 78 20 24 61 72 67 76  pu [lindex $argv
0230: 20 32 5d 0a 09 09 73 65 74 20 70 61 63 6b 61 67   2]...set packag
0240: 65 73 20 5b 6c 72 61 6e 67 65 20 24 61 72 67 76  es [lrange $argv
0250: 20 33 20 65 6e 64 5d 0a 0a 09 09 73 65 74 20 6e   3 end]....set n
0260: 65 77 70 61 63 6b 61 67 65 73 20 5b 6c 69 73 74  ewpackages [list
0270: 5d 0a 09 09 66 6f 72 65 61 63 68 20 70 61 63 6b  ]...foreach pack
0280: 61 67 65 20 24 70 61 63 6b 61 67 65 73 20 7b 0a  age $packages {.
0290: 09 09 09 69 66 20 7b 5b 73 74 72 69 6e 67 20 69  ...if {[string i
02a0: 6e 64 65 78 20 24 70 61 63 6b 61 67 65 20 30 5d  ndex $package 0]
02b0: 20 3d 3d 20 22 21 22 7d 20 7b 0a 09 09 09 09 6c   == "!"} {.....l
02c0: 61 70 70 65 6e 64 20 65 78 69 73 74 69 6e 67 65  append existinge
02d0: 78 74 73 20 5b 73 74 72 69 6e 67 20 72 61 6e 67  xts [string rang
02e0: 65 20 24 70 61 63 6b 61 67 65 20 31 20 65 6e 64  e $package 1 end
02f0: 5d 0a 09 09 09 7d 20 65 6c 73 65 20 7b 0a 09 09  ]....} else {...
0300: 09 09 6c 61 70 70 65 6e 64 20 6e 65 77 70 61 63  ..lappend newpac
0310: 6b 61 67 65 73 20 24 70 61 63 6b 61 67 65 0a 09  kages $package..
0320: 09 09 7d 0a 09 09 7d 0a 09 09 73 65 74 20 70 61  ..}...}...set pa
0330: 63 6b 61 67 65 73 20 24 6e 65 77 70 61 63 6b 61  ckages $newpacka
0340: 67 65 73 0a 0a 09 09 73 65 74 20 65 78 74 73 69  ges....set extsi
0350: 6e 66 6f 20 5b 3a 3a 74 65 61 70 6f 74 63 6c 69  nfo [::teapotcli
0360: 65 6e 74 3a 3a 64 6f 77 6e 6c 6f 61 64 5f 65 78  ent::download_ex
0370: 74 65 6e 73 69 6f 6e 73 20 5b 66 69 6c 65 20 6a  tensions [file j
0380: 6f 69 6e 20 24 64 69 72 20 6c 69 62 5d 20 24 74  oin $dir lib] $t
0390: 65 61 70 6f 74 73 65 72 76 65 72 73 20 24 70 61  eapotservers $pa
03a0: 63 6b 61 67 65 73 20 24 6f 73 20 24 63 70 75 20  ckages $os $cpu 
03b0: 24 65 78 69 73 74 69 6e 67 65 78 74 73 5d 0a 09  $existingexts]..
03c0: 09 73 65 74 20 65 78 74 73 20 5b 6c 69 73 74 5d  .set exts [list]
03d0: 0a 09 09 70 75 74 73 20 22 46 65 74 63 68 65 64  ...puts "Fetched
03e0: 20 45 78 74 65 6e 73 69 6f 6e 73 3a 22 0a 09 09   Extensions:"...
03f0: 66 6f 72 65 61 63 68 20 7b 65 78 74 20 65 78 74  foreach {ext ext
0400: 69 6e 66 6f 7d 20 24 65 78 74 73 69 6e 66 6f 20  info} $extsinfo 
0410: 7b 0a 09 09 09 6c 61 70 70 65 6e 64 20 65 78 74  {....lappend ext
0420: 73 20 24 65 78 74 0a 09 09 09 70 75 74 73 20 22  s $ext....puts "
0430: 20 20 24 65 78 74 20 76 5b 6c 69 6e 64 65 78 20    $ext v[lindex 
0440: 24 65 78 74 69 6e 66 6f 20 30 5d 22 0a 09 09 7d  $extinfo 0]"...}
0450: 0a 0a 09 09 73 65 74 20 66 61 69 6c 65 64 65 78  ....set failedex
0460: 74 73 20 5b 6c 69 73 74 5d 0a 09 09 66 6f 72 65  ts [list]...fore
0470: 61 63 68 20 70 6b 67 20 24 70 61 63 6b 61 67 65  ach pkg $package
0480: 73 20 7b 0a 09 09 09 69 66 20 7b 5b 6c 73 65 61  s {....if {[lsea
0490: 72 63 68 20 2d 65 78 61 63 74 20 24 65 78 74 73  rch -exact $exts
04a0: 20 24 70 6b 67 5d 20 3d 3d 20 2d 31 7d 20 7b 0a   $pkg] == -1} {.
04b0: 09 09 09 09 6c 61 70 70 65 6e 64 20 66 61 69 6c  ....lappend fail
04c0: 65 64 65 78 74 73 20 24 70 6b 67 0a 09 09 09 7d  edexts $pkg....}
04d0: 0a 09 09 7d 0a 09 09 69 66 20 7b 5b 6c 6c 65 6e  ...}...if {[llen
04e0: 67 74 68 20 24 66 61 69 6c 65 64 65 78 74 73 5d  gth $failedexts]
04f0: 20 21 3d 20 30 7d 20 7b 0a 09 09 09 70 75 74 73   != 0} {....puts
0500: 20 22 46 61 69 6c 65 64 20 74 6f 20 66 65 74 63   "Failed to fetc
0510: 68 3a 22 0a 09 09 09 66 6f 72 65 61 63 68 20 65  h:"....foreach e
0520: 78 74 20 24 66 61 69 6c 65 64 65 78 74 73 20 7b  xt $failedexts {
0530: 0a 09 09 09 09 70 75 74 73 20 22 20 20 24 65 78  .....puts "  $ex
0540: 74 22 0a 09 09 09 7d 0a 09 09 09 65 78 69 74 20  t"....}....exit 
0550: 31 0a 09 09 7d 0a 09 7d 0a 09 22 6c 69 73 74 22  1...}..}.."list"
0560: 20 7b 0a 09 09 69 66 20 7b 24 74 63 6c 5f 70 6c   {...if {$tcl_pl
0570: 61 74 66 6f 72 6d 28 70 6c 61 74 66 6f 72 6d 29  atform(platform)
0580: 20 3d 3d 20 22 75 6e 69 78 22 7d 20 7b 0a 09 09   == "unix"} {...
0590: 09 73 65 74 20 6f 73 20 5b 73 74 72 69 6e 67 20  .set os [string 
05a0: 74 6f 6c 6f 77 65 72 20 24 74 63 6c 5f 70 6c 61  tolower $tcl_pla
05b0: 74 66 6f 72 6d 28 6f 73 29 5d 0a 09 09 7d 20 65  tform(os)]...} e
05c0: 6c 73 65 20 7b 0a 09 09 09 73 65 74 20 6f 73 20  lse {....set os 
05d0: 5b 73 74 72 69 6e 67 20 74 6f 6c 6f 77 65 72 20  [string tolower 
05e0: 24 74 63 6c 5f 70 6c 61 74 66 6f 72 6d 28 70 6c  $tcl_platform(pl
05f0: 61 74 66 6f 72 6d 29 5d 0a 09 09 7d 0a 09 09 73  atform)]...}...s
0600: 65 74 20 63 70 75 20 5b 73 74 72 69 6e 67 20 74  et cpu [string t
0610: 6f 6c 6f 77 65 72 20 24 74 63 6c 5f 70 6c 61 74  olower $tcl_plat
0620: 66 6f 72 6d 28 6d 61 63 68 69 6e 65 29 5d 0a 09  form(machine)]..
0630: 09 69 66 20 7b 5b 6c 6c 65 6e 67 74 68 20 24 61  .if {[llength $a
0640: 72 67 76 5d 20 3e 20 30 7d 20 7b 0a 09 09 09 73  rgv] > 0} {....s
0650: 65 74 20 6f 73 20 5b 6c 69 6e 64 65 78 20 24 61  et os [lindex $a
0660: 72 67 76 20 30 5d 0a 09 09 7d 0a 09 09 69 66 20  rgv 0]...}...if 
0670: 7b 5b 6c 6c 65 6e 67 74 68 20 24 61 72 67 76 5d  {[llength $argv]
0680: 20 3e 20 31 7d 20 7b 0a 09 09 09 73 65 74 20 63   > 1} {....set c
0690: 70 75 20 5b 6c 69 6e 64 65 78 20 24 61 72 67 76  pu [lindex $argv
06a0: 20 31 5d 0a 09 09 7d 0a 0a 09 09 70 75 74 73 20   1]...}....puts 
06b0: 22 45 78 74 65 6e 73 69 6f 6e 73 20 61 76 61 69  "Extensions avai
06c0: 6c 61 62 6c 65 20 66 6f 72 20 4f 53 3d 24 6f 73  lable for OS=$os
06d0: 2c 20 43 50 55 3d 24 63 70 75 3a 22 0a 0a 09 09  , CPU=$cpu:"....
06e0: 61 72 72 61 79 20 73 65 74 20 65 78 74 73 20 5b  array set exts [
06f0: 3a 3a 74 65 61 70 6f 74 63 6c 69 65 6e 74 3a 3a  ::teapotclient::
0700: 67 65 74 5f 65 78 74 65 6e 73 69 6f 6e 73 20 24  get_extensions $
0710: 74 65 61 70 6f 74 73 65 72 76 65 72 73 20 24 6f  teapotservers $o
0720: 73 20 24 63 70 75 5d 0a 09 09 66 6f 72 65 61 63  s $cpu]...foreac
0730: 68 20 65 78 74 20 5b 6c 73 6f 72 74 20 2d 64 69  h ext [lsort -di
0740: 63 74 69 6f 6e 61 72 79 20 5b 61 72 72 61 79 20  ctionary [array 
0750: 6e 61 6d 65 73 20 65 78 74 73 5d 5d 20 7b 0a 09  names exts]] {..
0760: 09 09 73 65 74 20 65 78 74 69 6e 66 6f 20 24 65  ..set extinfo $e
0770: 78 74 73 28 24 65 78 74 29 0a 0a 09 09 09 73 65  xts($ext).....se
0780: 74 20 65 78 74 76 65 72 73 20 5b 6c 69 73 74 5d  t extvers [list]
0790: 0a 09 09 09 66 6f 72 65 61 63 68 20 65 78 74 69  ....foreach exti
07a0: 6e 66 6f 69 74 65 6d 20 24 65 78 74 69 6e 66 6f  nfoitem $extinfo
07b0: 20 7b 0a 09 09 09 09 73 65 74 20 65 78 74 69 6e   {.....set extin
07c0: 66 6f 69 74 65 6d 76 65 72 73 20 5b 6c 69 6e 64  foitemvers [lind
07d0: 65 78 20 24 65 78 74 69 6e 66 6f 69 74 65 6d 20  ex $extinfoitem 
07e0: 30 5d 0a 09 09 09 09 69 66 20 7b 5b 6c 73 65 61  0].....if {[lsea
07f0: 72 63 68 20 2d 65 78 61 63 74 20 24 65 78 74 76  rch -exact $extv
0800: 65 72 73 20 24 65 78 74 69 6e 66 6f 69 74 65 6d  ers $extinfoitem
0810: 76 65 72 73 5d 20 3d 3d 20 2d 31 7d 20 7b 0a 09  vers] == -1} {..
0820: 09 09 09 09 6c 61 70 70 65 6e 64 20 65 78 74 76  ....lappend extv
0830: 65 72 73 20 24 65 78 74 69 6e 66 6f 69 74 65 6d  ers $extinfoitem
0840: 76 65 72 73 0a 09 09 09 09 7d 0a 09 09 09 7d 0a  vers.....}....}.
0850: 09 09 09 73 65 74 20 65 78 74 76 65 72 73 20 5b  ...set extvers [
0860: 6c 73 6f 72 74 20 2d 64 65 63 72 65 61 73 69 6e  lsort -decreasin
0870: 67 20 2d 64 69 63 74 69 6f 6e 61 72 79 20 24 65  g -dictionary $e
0880: 78 74 76 65 72 73 5d 0a 0a 09 09 09 70 75 74 73  xtvers].....puts
0890: 20 22 20 20 24 65 78 74 20 5b 6c 69 6e 64 65 78   "  $ext [lindex
08a0: 20 24 65 78 74 76 65 72 73 20 30 5d 22 0a 09 09   $extvers 0]"...
08b0: 7d 0a 09 7d 0a 09 64 65 66 61 75 6c 74 20 7b 0a  }..}..default {.
08c0: 09 09 70 72 69 6e 74 5f 68 65 6c 70 0a 09 09 65  ..print_help...e
08d0: 78 69 74 20 31 0a 09 7d 0a 7d 0a                 xit 1..}.}.