package require TclCurl
proc httpBlobDelete {url} {
set curlHandle [curl::init]
$curlHandle configure -url $url -customrequest DELETE
catch { $curlHandle perform } curlErrorNumber
if { $curlErrorNumber != 0 } {
return -code error [curl::easystrerror $curlErrorNumber]
}
set responsecode [$curlHandle getinfo responsecode]
$curlHandle cleanup
if {$responsecode == 204} {
return -code ok
} elseif {$responsecode == 404} {
return -code error "Not Found"
} else {
return -code error "ERROR"
}
}
package require TclCurl
proc httpBlobPut {url data} {
set curlHandle [curl::init]
$curlHandle configure -url $url -customrequest PUT -postfields $data
catch { $curlHandle perform } curlErrorNumber
if { $curlErrorNumber != 0 } {
return -code error [curl::easystrerror $curlErrorNumber]
}
set responsecode [$curlHandle getinfo responsecode]
$curlHandle cleanup
if {$responsecode == 201} {
return -code ok
} elseif {$responsecode == 409} {
return -code error "Conflict"
} else {
return -code error "ERROR"
}
}
proc httpBlobGet {url} {
set curlHandle [curl::init]
$curlHandle configure -url $url -bodyvar html
catch { $curlHandle perform } curlErrorNumber
if { $curlErrorNumber != 0 } {
return -code error [curl::easystrerror $curlErrorNumber]
}
set responsecode [$curlHandle getinfo responsecode]
$curlHandle cleanup
if {$responsecode == 200} {
return -code ok $html
} elseif {$responsecode == 404} {
return -code error "Not Found"
} else {
return -code error "ERROR"
}
}
package require Tcl 8.6
package require TclOO
package require TclCurl
oo::class create CurlYQL {
variable html_result
constructor {} {
set html_result ""
}
destructor {
}
method query {query args} {
variable url
variable pairs
set url "https://query.yahooapis.com/v1/public/yql"
set pairs {}
lappend pairs "[curl::escape format]=[curl::escape json]"
lappend pairs "[curl::escape q]=[curl::escape $query]"
foreach {name value} $args {
lappend pairs "[curl::escape $name]=[curl::escape $value]"
}
append url ? [join $pairs &]
set curlHandle [curl::init]
$curlHandle configure -url $url -bodyvar [namespace current]::html_result
catch { $curlHandle perform } curlErrorNumber
if { $curlErrorNumber != 0 } {
error [curl::easystrerror $curlErrorNumber]
}
$curlHandle cleanup
}
#
# get the results
#
method getResults {} {
return $html_result
}
}
package require rl_json
set curlyql [CurlYQL new]
$curlyql query {select * from csv where url='http://download.finance.yahoo.com/d/quotes.csv?s=SPY,VOO,IVV&f=sl1d1t1c1ohgv&e=.csv' and columns='symbol,price,date,time,change,col1,high,low,col2'}
set query_result [$curlyql getResults]
if {[::rl_json::json exists $query_result query]==1} {
set rows [::rl_json::json get $query_result query results row]
puts "========================================\n"
foreach row $rows {
puts "symbol: [dict get $row symbol]"
puts "price: [dict get $row price]"
puts "date: [dict get $row date]"
puts "time: [dict get $row time]"
puts "change: [dict get $row change]"
puts "col1: [dict get $row col1]"
puts "high: [dict get $row high]"
puts "low: [dict get $row low]"
puts "col2: [dict get $row col2]"
puts "========================================\n"
}
}
$curlyql destroy
if {[package vcompare $tcl_patchLevel "8.6"] < 0} {
# Only needed pre-8.6
package require Trf ; # Wrapper to zlib
package require zlibtcl ; # Zlib usage. No commands, access through Trf
set ::zipfile::decode::native_zip_functs 0
} else {
set ::zipfile::decode::native_zip_functs 1
}
deflate {
go $fd(fileloc)
nbytes $fd(csize)
- return [zip -mode decompress -nowrap 1 -- [getval]]
+ if {$::zipfile::decode::native_zip_functs} {
+ return [zlib inflate [getval]]
+ } else {
+ return [zip -mode decompress -nowrap 1 -- [getval]]
+ }
}
default {
Error "Unable to handle file \"$src\" compressed with method \"$fd(cm)\"" \
package require tclmpi 1.0
# initialize TclMPI
::tclmpi::init
set comm tclmpi::comm_world
set size [::tclmpi::comm_size $comm]
set rank [::tclmpi::comm_rank $comm]
puts "hello world, this is rank $rank of $size"
# close out TclMPI
::tclmpi::finalize
exit 0
if {$tcl_interactive} {
package require tclreadline
proc ::tclreadline::prompt1 {} {
global env
if {[catch {set pwd [pwd]} tmp]} {
set pwd "unable to get pwd"
}
if [info exists env(HOME)] {
regsub $env(HOME) $pwd "~" pwd
}
if [info exists env(USER)] {
set user $env(USER)
} else {
set user tclsh
}
return "$user@[lindex [split [info hostname] "."] 0]:$pwd% "
}
::tclreadline::Loop
}