1: ### 2: ## This package is a compatibility layer between Rivet and mod_dtcl. 3: ## 4: ## All of the mod_dtcl commands call their Rivet equivalents and return the 5: ## proper responses. 6: ### 7: 8: # Copyright 2002-2004 The Apache Software Foundation 9: 10: # Licensed under the Apache License, Version 2.0 (the "License"); 11: # you may not use this file except in compliance with the License. 12: # You may obtain a copy of the License at 13: 14: # http://www.apache.org/licenses/LICENSE-2.0 15: 16: # Unless required by applicable law or agreed to in writing, software 17: # distributed under the License is distributed on an "AS IS" BASIS, 18: # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 19: # See the License for the specific language governing permissions and 20: # limitations under the License. 21: 22: package provide Dtcl 1.0 23: 24: proc hgetvars {} { 25: uplevel { 26: catch {unset VARS} 27: load_env ENVS 28: load_cookies COOKIES 29: } 30: set vars [var all] 31: foreach {name val} $vars { 32: uplevel [list set VARS($name) "$val"] 33: } 34: unset vars 35: } 36: 37: proc hputs {args} { 38: set nargs [llength $args] 39: if {$nargs < 1 || $nargs > 2} { 40: return -code error {wrong # args: should be "hputs ?-error? text"} 41: } 42: 43: if {$nargs == 2} { 44: set string [lindex $args 1] 45: } else { 46: set string [lindex $args 0] 47: } 48: 49: puts $string 50: } 51: 52: proc hflush {} { 53: flush stdout 54: } 55: 56: proc dtcl_info {} { } |