1: # tclrivetparser.tcl -- parse Rivet files in pure Tcl. 2: 3: # Copyright 2003-2004 The Apache Software Foundation 4: 5: # Licensed under the Apache License, Version 2.0 (the "License"); 6: # you may not use this file except in compliance with the License. 7: # You may obtain a copy of the License at 8: 9: # http://www.apache.org/licenses/LICENSE-2.0 10: 11: # Unless required by applicable law or agreed to in writing, software 12: # distributed under the License is distributed on an "AS IS" BASIS, 13: # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 14: # See the License for the specific language governing permissions and 15: # limitations under the License. 16: 17: # $Id: tclrivetparser.tcl,v 1.3 2004/02/24 10:24:34 davidw Exp $ 18: 19: package provide tclrivetparser 0.1 20: 21: namespace eval rivet { 22: set starttag <? 23: set endtag ?> 24: set outputcmd {puts -nonewline} 25: namespace export parserivetdata 26: } 27: 28: # rivet::setoutputcmd -- 29: # 30: # Set the output command used. In regular Rivet scripts, we use 31: # puts, but that might not be ideal if you want to parse Rivet 32: # pages in a Tcl script. 33: # 34: # Arguments: 35: # newcmd - if empty, return the current command, if not, set the 36: # command. 37: # 38: # Side Effects: 39: # May set the output command used. 40: # 41: # Results: 42: # The current output command. 43: 44: proc rivet::setoutputcmd { {newcmd ""} } { 45: variable outputcmd 46: 47: if { $outputcmd == "" } { 48: return $outputcmd 49: } 50: set outputcmd $newcmd 51: } 52: 53: # rivet::parse -- 54: # 55: # Parse a buffer, transforming <? and ?> into the appropriate 56: # Tcl strings. Note that initial 'puts "' is not performed 57: # here. 58: # 59: # Arguments: 60: # data - data to scan. 61: # outbufvar - name of the output buffer. 62: # 63: # Side Effects: 64: # None. 65: # 66: # Results: 67: # Returns the $inside variable - 1 if we are inside a <? ?> 68: # section, 0 if we outside. 69: 70: proc rivet::parse { data outbufvar } { 71: variable outputcmd 72: variable starttag 73: variable endtag 74: set inside 0 75: 76: upvar $outbufvar outbuf 77: 78: set i 0 79: set p 0 80: set len [expr {[string length $data] + 1}] 81: set next [string index $data 0] 82: while {$i < $len} { 83: incr i 84: set cur $next 85: set next [string index $data $i] 86: if { $inside == 0 } { 87: # Outside the delimiting tags. 88: if { $cur == [string index $starttag $p] } { 89: incr p 90: if { $p == [string length $starttag] } { 91: append outbuf "\"\n" 92: set inside 1 93: set p 0 94: continue 95: } 96: } else { 97: if { $p > 0 } { 98: append outbuf [string range $starttag 0 [expr {$p - 1}]] 99: set p 0 100: } 101: switch -exact -- $cur { 102: "\{" { 103: append outbuf "\\{" 104: } 105: "\}" { 106: append outbuf "\\}" 107: } 108: "\$" { 109: append outbuf "\\$" 110: } 111: "\[" { 112: append outbuf "\\[" 113: } 114: "\]" { 115: append outbuf "\\]" 116: } 117: "\"" { 118: append outbuf "\\\"" 119: } 120: "\\" { 121: append outbuf "\\\\" 122: } 123: default { 124: append outbuf $cur 125: } 126: } 127: continue 128: } 129: } else { 130: # Inside the delimiting tags. 131: if { $cur == [string index $endtag $p] } { 132: incr p 133: if { $p == [string length $endtag] } { 134: append outbuf "\n$outputcmd \"" 135: set inside 0 136: set p 0 137: } 138: } else { 139: if { $p > 0 } { 140: append outbuf [string range $endtag 0 $p] 141: set p 0 142: } 143: append outbuf $cur 144: } 145: } 146: } 147: return $inside 148: } 149: 150: 151: # rivet::parserivetdata -- 152: # 153: # Parse a rivet script, and add the relavant opening and closing 154: # bits. 155: # 156: # Arguments: 157: # data - data to parse. 158: # 159: # Side Effects: 160: # None. 161: # 162: # Results: 163: # Returns the parsed script. 164: 165: proc rivet::parserivetdata { data } { 166: variable outputcmd 167: set outbuf "namespace eval request {\n" 168: append outbuf "$outputcmd \"" 169: if { [parse $data outbuf] == 0 } { 170: append outbuf "\"\n" 171: } 172: 173: append outbuf "\n}" 174: return $outbuf 175: } 176: 177: proc rivet::parserivet {file} { 178: 179: set buffer "" 180: catch { 181: set fd [open $file] 182: while {1} { 183: set data [read $fd 16384] 184: if {$data == ""} { 185: break 186: } 187: 188: append buffer $data 189: } 190: close $fd 191: } 192: 193: return [parserivetdata $buffer] 194: } |