# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
# _____________________________________________ #
# Espace Win Open Source Project #
# _____ _ _______ _____ _ #
# / ____| (_) |__ __/ ____| | #
# | (___ __ _ _ __ ___ _| | | | | | #
# \___ \ / _` | |/ _` \ \/ / | | | | | #
# ___ ) | (_| | | (_| |> <| | | |____| |____ #
# |_____/ \__,_| |\__,_/_/\_\_| \_____|______| #
# _/ | #
# |__/ #
# _____________________________________________ #
# TCL port of Sajax, the AJAX open source tool #
# http://www.espace-win.org/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 "
urn "
// remote scripting library
// (c) copyright 2005 modernmethod, inc
// (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)';
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..')
sajax_debug('sajax_init_object() called..')
var A;
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();
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;
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';
sajax_request_type = 'GET';
uri = '$Sajax(remote_uri)';
if (sajax_request_type == 'GET') {
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 += '&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={'
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);
// window.open(uri);
sajax_requests\[sajax_requests.length] = x;
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);
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]
}SajaxTCL is a Sajax [1] port in TCL written 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.
Getting started
Home • Recent changes • Help • Create new page • Search • Add comments
• Edit