cvs commit: mod_dtcl/contrib dtclparser.tcl

[da...@apache.org]

davidw      01/03/20 11:10:35

  Added:       .        README.debug
               contrib  dtclparser.tcl
  Log:
  Added debugging README, as well as Tcl .ttml parser.
  
  Revision  Changes    Path
  1.1                  mod_dtcl/README.debug
  
  Index: README.debug
  ===================================================================
  How to debug problems in mod_dtcl:
  
  First, try looking in your error logs.  Often times the problem can be
  found there.  Or, if you are getting a funny page, look in the page
  sources to make sure mod_dtcl isn't returning an error that is being
  hidden by some HTML.
  
  Second, you can try running a system call tracer on Apache/mod_dtcl.
  On Linux, this is 'strace', on FreeBSD, ktrace.  Run it like this,
  after Apache has been stopped: "strace -o outputfile apache -X".  That
  should give you some information about what's going on.
  
  If it's not enough, compile apache/mod_dtcl with the debugging flag
  set (-g with gcc), and run it like so:
  
  (assuming that you have a system with the GNU debugger, gdb)
  gdb apache
  > run -X
  ...
  crash or whatever
  > bt # does a stack trace
  
  These are things that are useful to post to the mailing list (if
  they're not too big), or send to the author(s).  They are also good
  ways of learning about what's going on 'behind the scenes'.
  
  - davidw
  
  
  
  1.1                  mod_dtcl/contrib/dtclparser.tcl
  
  Index: dtclparser.tcl
  ===================================================================
  #!/bin/sh
  # the next line restarts using tclsh \
  exec tclsh "$0" "$@"
  
  # This is an attempt to duplicate the dtcl parser in pure Tcl.  It is
  # not currently complete.
  
  # $Id: dtclparser.tcl,v 1.1 2001/03/20 19:10:33 davidw Exp $
  
  set buffer ""
  
  proc dtcl_info { } {
  }
  
  proc buffered { x } {
  }
  
  proc headers { args } {    
  }
  
  proc include { filename } {
      set fl [ open $filename ]
      fconfigure $fl -translation binary
      puts -nonewline [ read $fl ]
      close $fl
  }
  
  proc parse { filename } {
      main $filename 0
  }
  
  proc hflush { } {
  }
  
  proc no_body { } {
  }
  
  proc hgetvars { } {
      array set ENVS {x y}
      array set VARS {a b}
  }
  
  proc buffer_add { x } {
      puts -nonewline "$x"
  }
  
  proc hputs { x } {
      puts -nonewline "$x"
  }
  
  proc accumulate { x } {
      global buffer
      append buffer $x
  }
  
  proc main { filename toplevel } {
      global buffer
      set fl [ open $filename ]
  
      if { $toplevel != 1 } {
  	accumulate "namespace eval request \{\n"
  	accumulate "buffer_add \"\n"
      } else {
  	accumulate "hputs \"\n"
      }
      set inside 0
      while { 1 } {
  	if { [ eof $fl ] } { break }
  	set char [ read $fl 1 ]
  	if { $inside == 0 } { 
  	    if { $char == "<" } { 
  		set char2 [ read $fl 1 ]
  		if { $char2 == "?" } {
  		    set inside 1
  		    accumulate "\"\n"
  		} else {
  		    set char2 [ string map {\$ \\\$ \" \\\" [ \\\[ ] \\\] \\ \\\\} $char2 ]
  		    accumulate "<$char2"
  		}
  	    } else {
  		set char [ string map {\$ \\\$ \" \\\" [ \\\[ ] \\\] \\ \\\\} $char ]
  		accumulate "$char"
  	    }
  	} else {
  	    if { $char == "?" } { 
  		set char2 [ read $fl 1 ]	    
  		if { $char2 == ">" } {
  		    accumulate "\nhputs \"\n"
  		    set inside 0
  		} else {
  		    accumulate "+$char2"
  		}	    
  	    } else {
  		accumulate "$char"		
  	    }
  	}
      }
      if { $inside == 0 } {
  	accumulate "\""
      }
      if { $toplevel != 1 } {
  	accumulate "\n\}\nnamespace delete request\n"
      }
  #    puts "$buffer"
      catch { eval "$buffer" } err
      if { $err != "" } { 
  	puts $err
  	puts "------------"
  	puts "$buffer" 
      }
  }
  
  main [ lindex $argv 0 ] 1