1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
|
# copyright (C) 1997-1999 Jean-Luc Fontaine (mailto:jfontain@multimania.com)
# this program is free software: please read the COPYRIGHT file enclosed in this package or use the Help Copyright menu
set rcsId {$Id: apacheu.tcl,v 1.5 1999/07/19 19:49:23 jfontain Exp $}
package provide apacheutilities 1.1
package require http 2
::http::config ;# force immediate loading so that following procedure can be overloaded
proc ::http::Finish {token {errormsg ""}} { ;# modified from http package so that no transaction data is freed and errors caught
variable $token
upvar 0 $token state
global errorInfo errorCode
if {[string length $errormsg] != 0} {
set state(error) [list $errormsg $errorInfo $errorCode]
set state(status) error
}
catch {close $state(sock)}
catch {after cancel $state(after)}
if {[info exists state(-command)]} {
eval $state(-command) {$token}
}
}
namespace eval apache {
# works for both apache and apachex modules, flag can be ?auto, ?notable, ...
proc url {optionsName hostName moduleName {flag {}}} {
upvar $optionsName options
upvar $hostName host
if {![catch {set url $options(--remote)}]||![catch {set url $options(-r)}]} {
if {[string first ? $url]>=0} { ;# we specify the flag ourselves
puts stderr "usage: moodss ... $moduleName \[-r|--remote\] \[http://\]host\[statusLocator\] ..."
exit 1
}
regsub {/$} $url {} url ;# eventually remove trailing slash
if {![regexp {[^/]/[^/]} $url]} { ;# if status locator is not present
append url /server-status ;# use default
}
append url $flag
regsub {^http://} $url {} url ;# eventually remove useless protocol header
scan $url {%[^/]} host
} else {
set url 127.0.0.1/server-status${flag} ;# default for server on localhost
set host 127.0.0.1
}
return $url
}
proc formattedTime {seconds} {
set string {}
set interval [expr {$seconds/86400}] ;# days
if {$interval>0} {
append string ${interval}d
set seconds [expr {$seconds%86400}]
}
set interval [expr {$seconds/3600}] ;# hours
if {$interval>0} {
append string ${interval}h
set seconds [expr {$seconds%3600}]
}
set interval [expr {$seconds/60}] ;# minutes
if {$interval>0} {
append string ${interval}m
set seconds [expr {$seconds%60}]
}
append string ${seconds}s
return $string
}
}
|
