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