home *** CD-ROM | disk | FTP | other *** search
/ Practical Programming in Tcl & Tk (4th Edition) / TCLBOOK4.BIN / pc / exsource.old / 17_7.tcl < prev    next >
Text File  |  2003-04-15  |  1KB  |  46 lines
  1. #
  2. # Example 17-7
  3. # Http_Head validates a URL.
  4. #
  5.  
  6. proc Http_Head {url} {
  7.     upvar #0 $url state
  8.     catch {unset state}
  9.     set state(sock) [Http_Open $url HEAD]
  10.     fileevent $state(sock) readable [list HttpHeader $url]
  11.     # Specify the real name, not the upvar alias, to vwait
  12.     vwait $url\(status)
  13.     catch {close $state(sock)}
  14.     return $state(status)
  15. }
  16. proc HttpHeader {url} {
  17.     upvar #0 $url state
  18.     if {[eof $state(sock)]} {
  19.         set state(status) eof
  20.         close $state(sock)
  21.         return
  22.     }
  23.     if {[catch {gets $state(sock) line} nbytes]} {
  24.         set state(status) error
  25.         lappend state(headers) [list error $nbytes]
  26.         close $state(sock)
  27.         return
  28.     }
  29.     if {$nbytes < 0} {
  30.         # Read would block
  31.         return
  32.     } elseif {$nbytes == 0} {
  33.         # Header complete
  34.         set state(status) head
  35.     } elseif {![info exists state(headers)]} {
  36.         # Initial status reply from the server
  37.         set state(headers) [list http $line]
  38.     } else {
  39.         # Process key-value pairs
  40.         regexp {^([^:]+): *(.*)$} $line x key value
  41.         lappend state(headers) [string tolower $key] $value
  42.     }
  43. }
  44.  
  45.  
  46.