1 ################################################################################
2 ################################################################################
4 ################################################################################
5 ################################################################################
6 ## Includes the tcl part of TclCurl
7 ################################################################################
8 ################################################################################
9 ## (c) 2001-2009 Andres Garcia Garcia. fandom@telefonica.net
10 ## See the file "license.terms" for information on usage and redistribution
11 ## of this file and for a DISCLAIMER OF ALL WARRANTIES.
12 ################################################################################
13 ################################################################################
15 package provide TclCurl 7.19.6
19 ################################################################################
21 # Invokes the 'curl-config' script to be able to know what features have
22 # been compiled in the installed version of libcurl.
23 # Possible options are '-prefix', '-feature' and 'vernum'
24 ################################################################################
25 proc ::curl::curlConfig {option} {
27 if {$::tcl_platform(platform)=="windows"} {
28 error "This command is not available in Windows"
31 switch -exact -- $option {
33 return [exec curl-config --prefix]
36 set featureList [exec curl-config --feature]
37 regsub -all {\\n} $featureList { } featureList
41 return [exec curl-config --vernum]
44 return [exec curl-config --ca]
47 error "bad option '$option': must be '-prefix', '-feature', '-vernum' or '-ca'"
53 ################################################################################
55 # The transfer command is used for simple transfers in which you don't
56 # want to request more than one file.
59 # Use the same parameters you would use in the 'configure' command to
60 # configure the download and the same as in 'getinfo' with a 'info'
61 # prefix to get info about the transfer.
62 ################################################################################
63 proc ::curl::transfer {args} {
71 foreach {option value} $args {
74 switch -regexp -- $option {
77 regsub -- {-info} $option {} option
78 set getInfo($option) $value
85 upvar $value curlBodyVar
89 upvar $value curlHeaderVar
90 set value curlHeaderVar
93 upvar $value curlErrorVar
94 set value curlErrorVar
97 if {$noPassOption==0} {
98 lappend newArgs $option $value
102 if {[catch {::curl::init} curlHandle]} {
103 error "Could not init a curl session: $curlHandle"
106 if {[catch {eval $curlHandle configure $newArgs} result]} {
112 if {[catch {$curlHandle perform} result]} {
116 if {[info exists getInfo]} {
117 foreach {option var} [array get getInfo] {
119 set info [eval $curlHandle getinfo $option]
122 if {[catch {$curlHandle cleanup} result]} {
126 # We create a multiHandle
127 set multiHandle [curl::multiinit]
129 # We add the easy handle to the multi handle.
130 $multiHandle addhandle $curlHandle
132 # So now we create the event source passing the multiHandle as a parameter.
133 curl::createEventSource $multiHandle
135 # And we return, it is non blocking after all.