SajaxTCL is a Sajax port in TCL developed and maintained by DcK.
Sajax is an open source tool to make programming websites using the Ajax framework — also known as XMLHTTPRequest or remote scripting — as easy as possible.
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
# _____________________________________________ #
# Espace Win Open Source Project #
# _____ _ _______ _____ _ #
# / ____| (_) |__ __/ ____| | #
# | (___ __ _ _ __ ___ _| | | | | | #
# \___ \ / _` | |/ _` \ \/ / | | | | | #
# ___ ) | (_| | | (_| |> <| | | |____| |____ #
# |_____/ \__,_| |\__,_/_/\_\_| \_____|______| #
# _/ | #
# |__/ #
# _____________________________________________ #
# TCL port of Sajax, the AJAX open source tool #
# http://www.espace-win.info/EWOSP/SajaxTCL #
# #
# Sajax is written & maintained by ModernMethod #
# http://www.modernmethod.com/sajax #
# _____________________________________________ #
# #
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
package provide Sajax 0.12
namespace eval Sajax {}
#Default values
#If you don't use $GET and $POST as GET/POST arrays, edit the _array variables.
array set Sajax {
version 0.12
debug_mode 0
export_list {}
request_type GET
remote_uri {}
failure_redirect {}
js_has_been_shown 0
GET_array GET
POST_array POST
output_function puts
}
proc Sajax::getmyuri {} {
global env
return $env(REQUEST_URI)
}
#Checks if a string is a natural number
proc Sajax::isnatural {string} {
if {([string compare $string ""]) && (![regexp -- \[^0-9\] $string])} {return 1} {return 0}
}
#Checks if a string is a float
proc Sajax::isfloat {string} {
if [catch {expr {double($string)}}] {return 0} {return 1}
}
#Checks if a string is an integer
proc Sajax::isinteger {string} {
if {[Sajax::isnatural $string]} {return 1}
if {[string range $string 0 1] == "- "} {
Sajax::isnatural [string range $string 2 end]
} elseif {[string index $string 0] == "-"} {
Sajax::isnatural [string range $string 1 end]
} {
return 0
}
}
proc Sajax::esc {string} {
regsub -all {\\} $string {\\\\} newstring
regsub -all {\r} $newstring {\\r} newstring
regsub -all {\n} $newstring {\\n} newstring
regsub -all {'} $newstring {\\'} newstring
regsub -all {"} $newstring {\\"} newstring
return $newstring
}
proc Sajax::getjsrepr {var} {
upvar 1 $var data
if {[array exists data]} {
#XXX Arrays with non-numeric indices are not
#permitted according to ECMAScript, yet everyone
#uses them.. We'll use an object.
set js_object "{ "
set i 0
foreach key [array names data] {
if {$i > 0} {append js_object ", "}
if {[Sajax::isnatural $key]} {
append js_object "$key: "
} {
append js_object "\"[Sajax::esc $key]\": "
}
append js_object [Sajax::getjsrepr data($key)]
incr i
}
append js_object " }"
} elseif {[Sajax::isinteger $var]} {
return "parseInt($var)";
} elseif {[Sajax::isfloat $var]} {
return "parseFloat($var)";
} {
#List, string, ...
return "'[Sajax::esc $var]'"
}
}
proc Sajax::inlist {list item} {
foreach listitem $list {
if {$item == $listitem} {return 1}
}
return 0
}
proc Sajax::die {msg} {
global Sajax
$Sajax(output_function) "FATAL ERROR"
error $msg
}
proc Sajax::callproc {proc {procargs ""}} {
if {$procargs == 0} {
$proc
} {
set cmd "$proc "
foreach arg [lindex $procargs 0] {
append cmd "{$arg} "
}
eval $cmd
}
}
proc Sajax::init {} {
global Sajax
set Sajax(remote_uri) [Sajax::getmyuri]
}
proc Sajax::header {header} {
global Sajax
#$Sajax(output_function) header
}
proc Sajax::handleclientrequest {} {
global Sajax
upvar 1 $Sajax(GET_array) GET
upvar 1 $Sajax(POST_array) POST
if {[array exists GET] && [info exists GET(rs)] && $GET(rs) != ""} {
set mode get
}
if {[array exists POST] && [info exists POST(rs)] && $POST(rs) != ""} {
set mode post
}
if {![info exists mode]} {
return
}
if {$mode == "get"} {
#HEADERS
#Bust cache in the head with a date in the past
Sajax::header "Expires: Mon, 26 Jul 1997 05:00:00 GMT"
Sajax::header "Last-Modified: [clock format [unixtime] -format "%a, %d %b %Y %H:%M:%S" -gmt true] GMT"
#Always modified
Sajax::header "Cache-Control: no-cache, must-revalidate"
Sajax::header "Pragma: no-cache"
set procname $GET(rs)
set procargs $GET(rsargs)
} {
set procname $POST(rs)
set procargs $POST(rsargs)
}
#Checks if this function is specified and has been exported
if {![Sajax::inlist $Sajax(export_list) $procname]} {
Sajax::die "$procname is not a callable function"
}
if {[catch {set result [Sajax::callproc $procname $procargs]} message]} {Sajax::die $message}
$Sajax(output_function) "+:var res = [Sajax::getjsrepr $result]; res;"
exit
}
proc Sajax::truefalse {bool} {
if {$bool} {return "true"} {return "false"}
}
proc Sajax::showcommonjs {} {
global Sajax
$Sajax(output_function) [Sajax::getcommonjs]
}
proc Sajax::getcommonjs {} {
global Sajax;
set Sajax(request_type) [string toupper $Sajax(request_type)]
if {($Sajax(request_type) != "GET") && ($Sajax(request_type) != "POST")} {
return "// Invalid type: Sajax(request_type)\n\n"
}
return "
// remote scripting library
// (c) copyright 2005 modernmethod, inc
var sajax_debug_mode = [Sajax::truefalse $Sajax(debug_mode)];
var sajax_request_type = '$Sajax(request_type)';
var sajax_target_id = '';
var sajax_failure_redirect = '$Sajax(failure_redirect)';
function sajax_debug(text) {
if (sajax_debug_mode)
alert(text);
}
function sajax_init_object() {
sajax_debug('sajax_init_object() called..')
var A;
var msxmlhttp = new Array(
'Msxml2.XMLHTTP.5.0',
'Msxml2.XMLHTTP.4.0',
'Msxml2.XMLHTTP.3.0',
'Msxml2.XMLHTTP',
'Microsoft.XMLHTTP');
for (var i = 0; i < msxmlhttp.length; i++) {
try {
A = new ActiveXObject(msxmlhttp\[i\]);
} catch (e) {
A = null;
}
}
if(!A && typeof XMLHttpRequest != 'undefined')
A = new XMLHttpRequest();
if (!A)
sajax_debug('Could not create connection object.');
return A;
}
var sajax_requests = new Array();
function sajax_cancel() {
for (var i = 0; i < sajax_requests.length; i++)
sajax_requests\[i].abort();
}
function sajax_do_call(func_name, args) {
var i, x, n;
var uri;
var post_data;
var target_id;
sajax_debug('in sajax_do_call()..' + sajax_request_type + '/' + sajax_target_id);
target_id = sajax_target_id;
if (typeof(sajax_request_type) == 'undefined' || sajax_request_type == '')
sajax_request_type = 'GET';
uri = '$Sajax(remote_uri)';
if (sajax_request_type == 'GET') {
if (uri.indexOf('?') == -1)
uri += '?rs=' + escape(func_name);
else
uri += '&rs=' + escape(func_name);
uri += '&rst=' + escape(sajax_target_id);
uri += '&rsrnd=' + new Date().getTime();
uri += '&rsargs={'
for (i = 0; i < args.length-1; i++)
uri += '{' + escape(args\[i]) + '} ';
uri += '}';
post_data = null;
}
else if (sajax_request_type == 'POST') {
post_data = 'rs=' + escape(func_name);
post_data += '&rst=' + escape(sajax_target_id);
post_data += '&rsrnd=' + new Date().getTime();
post_data += '&rsargs={'
for (i = 0; i < args.length-1; i++)
post_data += '{' + escape(args\[i]) + '} ';
post_data += '}';
}
else {
alert('Illegal request type: ' + sajax_request_type);
}
x = sajax_init_object();
if (x == null) {
if (sajax_failure_redirect != '') {
location.href = sajax_failure_redirect;
return false;
} else {
sajax_debug('NULL sajax object for user agent: ' + navigator.userAgent);
return false;
}
} else {
x.open(sajax_request_type, uri, true);
// window.open(uri);
sajax_requests\[sajax_requests.length] = x;
if (sajax_request_type == 'POST') {
x.setRequestHeader('Method', 'POST ' + uri + ' HTTP/1.1');
x.setRequestHeader('Content-Type', 'application/x-www-form-urlencoded');
}
x.onreadystatechange = function() {
if (x.readyState != 4)
return;
sajax_debug('received ' + x.responseText);
var status;
var data;
var txt = x.responseText.replace(/^\s*|\s*$/g,'');
status = txt.charAt(0);
data = txt.substring(2);
if (status == '') {
// let's just assume this is a pre-response bailout and let it slide for now
} else if (status == '-')
alert('Error: ' + data);
else {
if (target_id != '')
document.getElementById(target_id).innerHTML = eval(data);
else {
try {
var callback;
var extra_data = false;
if (typeof args\[args.length-1] == 'object') {
callback = args\[args.length-1].callback;
extra_data = args\[args.length-1].extra_data;
} else {
callback = args\[args.length-1];
}
callback(eval(data), extra_data);
} catch (e) {
sajax_debug('Caught error ' + e + ': Could not eval ' + data );
}
}
}
}
}
sajax_debug(func_name + ' uri = ' + uri + '/post = ' + post_data);
x.send(post_data);
sajax_debug(func_name + ' waiting..');
delete x;
return true;
}
"}
proc Sajax::getonestub {proc_name} {
return "
// wrapper for $proc_name
function x_$proc_name () {
sajax_do_call('$proc_name', x_$proc_name.arguments);
}
"
}
proc Sajax::showonestub {proc_name} {
global Sajax
$Sajax(output_function) [Sajax::getonestub $proc_name]
}
proc Sajax::export {procs} {
global Sajax
foreach proc $procs {
lappend Sajax(export_list) $proc
}
}
proc Sajax::getjavascript {} {
global Sajax
if {!$Sajax(js_has_been_shown)} {
append html [Sajax::getcommonjs]
set js_has_been_shown 1
}
foreach proc $Sajax(export_list) {
append html [Sajax::getonestub $proc]
}
return $html
}
proc Sajax::showjavascript {} {
global Sajax
$Sajax(output_function) [Sajax::getjavascript]
}