[naviserver-commits] naviserver/tcl file.tcl,1.3,1.4

[Vlad S. <ser...@us...>]

Update of /cvsroot/naviserver/naviserver/tcl
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv8239/tcl

Modified Files:
	file.tcl 
Log Message:
added support for caching tcl bytecode if ns_cache module is loaded


Index: file.tcl
===================================================================
RCS file: /cvsroot/naviserver/naviserver/tcl/file.tcl,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** file.tcl	26 Mar 2005 17:42:26 -0000	1.3
--- file.tcl	26 Apr 2005 15:59:41 -0000	1.4
***************
*** 65,142 ****
  }
  
! if { ![string equal [info commands "ns_cache"] ""] } {
!     proc ns_sourceproc {ignored} {
! 
!         ns_share errorPage
  
!         set file [ns_url2file [ns_conn url]]
!         if ![file exists $file] {
!             ns_returnnotfound
!         } else {
! 	    set code [catch {
! 	        source_cached $file
! 	    } result ]
  
! 	    global errorCode errorInfo
! 	
! 	    if { ![info exists errorCode] } {
! 	        # Tcl bug workaround.
! 	        set errorCode NONE
! 	    }
! 	    if { ![info exists errorInfo] } {
! 	        # Another Tcl bug workaround.
! 	        set errorInfo ""
! 	    }
! 	
! 	    if {$code == 1 && $errorCode == "NS_TCL_ABORT"} {
! 	        return
! 	    }
  
! 	    if { $errorPage == "" } {
! 	        return -code $code \
! 		    -errorcode $errorCode -errorinfo $errorInfo $result
! 	    } else {
! 	        ## Custom error page -- unfortunately we can't pass parameters.
! 	        source $errorPage
! 	    }
          }
      }
  } else {
-     proc ns_sourceproc {ignored} {
  
!         ns_share errorPage
  
!         set file [ns_url2file [ns_conn url]]
!         if ![file exists $file] {
!             ns_returnnotfound
!         } else {
! 	    set code [catch {
! 	        source $file
! 	    } result ]
  
! 	    global errorCode errorInfo
  	
! 	    if { ![info exists errorCode] } {
! 	        # Tcl bug workaround.
! 	        set errorCode NONE
! 	    }
! 	    if { ![info exists errorInfo] } {
! 	        # Another Tcl bug workaround.
! 	        set errorInfo ""
! 	    }
  	
! 	    if {$code == 1 && $errorCode == "NS_TCL_ABORT"} {
! 	        return
! 	    }
  
! 	    if { $errorPage == "" } {
! 	        return -code $code \
! 		    -errorcode $errorCode -errorinfo $errorInfo $result
! 	    } else {
! 	        ## Custom error page -- unfortunately we can't pass parameters.
! 	        source $errorPage
! 	    }
!         }
      }
  }
- 
--- 65,145 ----
  }
  
! #
! #
! #      Support for caching Tcl-page bytecodes.
! #
  
! if { ![string equal [info commands "ns_cache"] ""] } {
  
!     ns_cache create util_file_contents_cached -thread 1 \
!         -size [ns_config "ns/server/[ns_info server]" SourceCacheSize 5000000]
  
!     # Get the contents of a file from the cache or disk.
!     proc ns_sourcefile {filename} {
!         file stat $filename stat
!         set current_cookie [list $stat(mtime) $stat(ctime) $stat(ino) $stat(dev)]
!         set cached_p [ns_cache get util_file_contents_cached $filename pair]
!         if {$cached_p} {
!             set cached_cookie [lindex $pair 0]
!             if {![string equal $cached_cookie $current_cookie]} {
!                 ns_cache flush util_file_contents_cached $filename
!                 set cached_p 0
!             }
!         }
!         if {!$cached_p} {
!             # Now cache the Tcl_Obj in a thread-local cache.
!             set pair [ns_cache eval util_file_contents_cached $filename {
!                 set fd [open $filename]
!                 set contents [read $fd]
!                 close $fd
!                 list $current_cookie $contents
!             }]
          }
+         # And here's the magic part.  We're using "for" here to translate the
+         # text source file into bytecode, which will be associated with the 
+         # Tcl_Obj we just cached (as its internal representation).  "eval"
+         # doesn't do this as the eval provided in Tcl uses the TCL_EVAL_DIRECT
+         # flag, and hence interprets the text directly.
+         uplevel [for [lindex $pair 1] {0} {} {}]
      }
+ 
  } else {
  
!     proc ns_sourcefile {filename} {
!         uplevel source $filename
!     }
! }
  
! proc ns_sourceproc { args } {
  
!     ns_share errorPage
! 
!     set file [ns_url2file [ns_conn url]]
!     if { ![file exists $file] } {
!         ns_returnnotfound
!         return
!     }
!     set code [catch { ns_sourcefile $file } result ]
! 
!     global errorCode errorInfo
  	
!     if { ![info exists errorCode] } {
!         # Tcl bug workaround.
!         set errorCode NONE
!     }
!     if { ![info exists errorInfo] } {
!         # Another Tcl bug workaround.
!         set errorInfo ""
!     }
  	
!     if { $code == 1 && $errorCode == "NS_TCL_ABORT" } {
!         return
!     }
  
!     if { $errorPage == "" } {
!         return -code $code -errorcode $errorCode -errorinfo $errorInfo $result
!     } else {
!         ## Custom error page -- unfortunately we can't pass parameters.
!         source $errorPage
      }
  }