SajaxTCL

SajaxTCL is a Sajax [L1 ] 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.


 # # # # # # # # # # # # # # # # # # # #  # # # # # # # # # # # # # # # # # # # #
 #                _____________________________________________                 #
 #                        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]
 }