144 lines
4.6 KiB
Tcl
Raw Normal View History

2014-02-05 16:43:59 -08:00
################################################################################
################################################################################
#### tclcurl.tcl
################################################################################
################################################################################
## Includes the tcl part of TclCurl
################################################################################
################################################################################
## (c) 2001-2011 Andres Garcia Garcia. fandom@telefonica.net
## See the file "license.terms" for information on usage and redistribution
## of this file and for a DISCLAIMER OF ALL WARRANTIES.
################################################################################
################################################################################
namespace eval curl {
################################################################################
# configure
# Invokes the 'curl-config' script to be able to know what features have
# been compiled in the installed version of libcurl.
# Possible options are '-prefix', '-feature' and 'vernum'
################################################################################
proc ::curl::curlConfig {option} {
if {$::tcl_platform(platform)=="windows"} {
error "This command is not available in Windows"
}
switch -exact -- $option {
-prefix {
return [exec curl-config --prefix]
}
-feature {
set featureList [exec curl-config --feature]
regsub -all {\\n} $featureList { } featureList
return $featureList
}
-vernum {
return [exec curl-config --vernum]
}
-ca {
return [exec curl-config --ca]
}
default {
error "bad option '$option': must be '-prefix', '-feature', '-vernum' or '-ca'"
}
}
return
}
################################################################################
# transfer
# The transfer command is used for simple transfers in which you don't
# want to request more than one file.
#
# Parameters:
# Use the same parameters you would use in the 'configure' command to
# configure the download and the same as in 'getinfo' with a 'info'
# prefix to get info about the transfer.
################################################################################
proc ::curl::transfer {args} {
variable getInfo
variable curlBodyVar
set i 0
set newArgs ""
catch {unset getInfo}
if {[llength $args]==0} {
puts "No transfer configured"
return
}
foreach {option value} $args {
set noPassOption 0
set block 1
switch -regexp -- $option {
-info.* {
set noPassOption 1
regsub -- {-info} $option {} option
set getInfo($option) $value
}
-block {
set noPassOption 1
set block $value
}
-bodyvar {
upvar $value curlBodyVar
set value curlBodyVar
}
-headervar {
upvar $value curlHeaderVar
set value curlHeaderVar
}
-errorbuffer {
upvar $value curlErrorVar
set value curlErrorVar
}
}
if {$noPassOption==0} {
lappend newArgs $option $value
}
}
if {[catch {::curl::init} curlHandle]} {
error "Could not init a curl session: $curlHandle"
}
if {[catch {eval $curlHandle configure $newArgs} result]} {
$curlHandle cleanup
error $result
}
if {$block==1} {
if {[catch {$curlHandle perform} result]} {
$curlHandle cleanup
error $result
}
if {[info exists getInfo]} {
foreach {option var} [array get getInfo] {
upvar $var info
set info [eval $curlHandle getinfo $option]
}
}
if {[catch {$curlHandle cleanup} result]} {
error $result
}
} else {
# We create a multiHandle
set multiHandle [curl::multiinit]
# We add the easy handle to the multi handle.
$multiHandle addhandle $curlHandle
# So now we create the event source passing the multiHandle as a parameter.
curl::createEventSource $multiHandle
# And we return, it is non blocking after all.
}
return 0
}
}