1: # rivet_ncgi.tcl -- Rivet ncgi compatibility layer 2: 3: # $Id: rivet_ncgi.tcl,v 1.1 2004/08/23 21:52:35 davidw Exp $ 4: 5: package provide ncgi 1.0 6: 7: package require fileutil 8: package require http 9: 10: namespace eval ncgi { 11: } 12: 13: # ::ncgi::parse -- 14: # 15: # Mostly a no-op for Rivet, although it loads up the ::env 16: # variable. 17: # 18: # Arguments: 19: # None. 20: # 21: # Side Effects: 22: # Modifies ::env environment to include stuff from the request. 23: # 24: # Results: 25: # None. 26: 27: proc ::ncgi::parse {} { 28: load_env ::env 29: } 30: 31: # ::ncgi::value -- 32: # 33: # Returns the value of a 'cgi' variable. 34: # 35: # Arguments: 36: # key - variable name. 37: # default - default value should it not exist. 38: # 39: # Side Effects: 40: # None. 41: # 42: # Results: 43: # The value of the specified variable, or {} if it is empty. 44: 45: proc ::ncgi::value {key {default {}}} { 46: if { [var exists $key] } { 47: return [var get $key] 48: } else { 49: return $default 50: } 51: } 52: 53: # ::ncgi::encode -- 54: # 55: # HTML encode a string. 56: # 57: # Arguments: 58: # string - text to encode. 59: # 60: # Side Effects: 61: # None. 62: # 63: # Results: 64: # Encoded string. 65: 66: proc ::ncgi::encode {string} { 67: return [http::formatQuery $string] 68: } 69: 70: # ::ncgi::importFile -- 71: # 72: # See the ncgi documentation. 73: 74: proc ::ncgi::importFile {cmd var {filename {}}} { 75: switch -exact -- $cmd { 76: -server { 77: if { $filename == {} } { 78: set filename [::fileutil::tempfile ncgi] 79: } 80: upload save $var $filename 81: return $filename 82: } 83: -client { 84: return [upload filename $var] 85: } 86: -type { 87: return [upload type] 88: } 89: -data { 90: return [upload data $var] 91: } 92: default { 93: error "Unknown subcommand to ncgi::import_file: $cmd" 94: } 95: } 96: } 97: 98: # ::ncgi::empty -- 99: # 100: # Returns 1 if the CGI variable in question is not set, 0 if it 101: # is set. 102: # 103: # Arguments: 104: # name - variable name. 105: # 106: # Side Effects: 107: # None. 108: # 109: # Results: 110: # 1 or 0. 111: 112: proc ::ncgi::empty {name} { 113: expr {! [var exists $name]} 114: } 115: 116: # ::ncgi::::redirect -- 117: # 118: # Generate a redirect. 119: # 120: # Arguments: 121: # uri - new URL to go to. 122: # 123: # Side Effects: 124: # Must be done before puts statements. 125: # 126: # Results: 127: # None. 128: 129: proc ::ncgi::::redirect {uri} { 130: headers redirect $uri 131: } |