/*
 * The contents of this file are subject to the AOLserver Public License
 * Version 1.1 (the "License"); you may not use this file except in
 * compliance with the License. You may obtain a copy of the License at
 * http://aolserver.com/.
 *
 * Software distributed under the License is distributed on an "AS IS"
 * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
 * the License for the specific language governing rights and limitations
 * under the License.
 *
 * The Original Code is AOLserver Code and related documentation
 * distributed by AOL.
 * 
 * The Initial Developer of the Original Code is America Online,
 * Inc. Portions created by AOL are Copyright (C) 1999 America Online,
 * Inc. All Rights Reserved.
 *
 * Alternatively, the contents of this file may be used under the terms
 * of the GNU General Public License (the "GPL"), in which case the
 * provisions of GPL are applicable instead of those above.  If you wish
 * to allow use of your version of this file only under the terms of the
 * GPL and not to allow others to use your version of this file under the
 * License, indicate your decision by deleting the provisions above and
 * replace them with the notice and other provisions required by the GPL.
 * If you do not delete the provisions above, a recipient may use your
 * version of this file under either the License or the GPL.
 */

/*
 * tclset.c --
 *
 *	Implements the tcl ns_set commands 
 */

static const char *RCSID = "@(#) $Header: /cvsroot/aolserver/aolserver/nsd/tclset.c,v 1.19 2005/08/01 20:27:35 jgdavidson Exp $, compiled: " __DATE__ " " __TIME__;

#include "nsd.h"

/*
 * The following represent the valid combinations of
 * NS_TCL_SET flags
 */
 
#define SET_DYNAMIC 		'd'
#define SET_STATIC    		't'
#define SET_SHARED_DYNAMIC	's'
#define SET_SHARED_STATIC  	'p'

#define IS_DYNAMIC(id)    \
	(*(id) == SET_DYNAMIC || *(id) == SET_SHARED_DYNAMIC)
#define IS_SHARED(id)     \
	(*(id) == SET_SHARED_DYNAMIC || *(id) == SET_SHARED_STATIC)

/*
 * Local functions defined in this file
 */

static int LookupSet(NsInterp *itPtr, char *id, int delete, Ns_Set **setPtr);
static int LookupObjSet(NsInterp *itPtr, Tcl_Obj *idPtr, int delete,
			Ns_Set **setPtr);
static int LookupInterpSet(Tcl_Interp *interp, char *id, int delete,
			   Ns_Set **setPtr);
static int EnterSet(NsInterp *itPtr, Ns_Set *set, int flags);


/*
 *----------------------------------------------------------------------
 *
 * Ns_TclEnterSet --
 *
 *	Give this Tcl interpreter access to an existing Ns_Set.
 *
 * Results:
 *	TCL_OK or TCL_ERROR.
 *
 * Side effects:
 *	A pointer to the Ns_Set is added to the interpreter's list of 
 *	sets; a new handle is generated and appended to interp result.
 *
 *----------------------------------------------------------------------
 */

int
Ns_TclEnterSet(Tcl_Interp *interp, Ns_Set *set, int flags)
{
    NsInterp *itPtr = NsGetInterpData(interp);

    if (itPtr == NULL) {
	Tcl_SetResult(interp, "ns_set not supported", TCL_STATIC);
	return TCL_ERROR;
    }
    return EnterSet(itPtr, set, flags);
}


/*
 *----------------------------------------------------------------------
 *
 * Ns_TclGetSet --
 *
 *	Given a Tcl ns_set handle, return a pointer to the Ns_Set. 
 *
 * Results:
 *	An Ns_Set pointer, or NULL if error. 
 *
 * Side effects:
 *	None. 
 *
 *----------------------------------------------------------------------
 */

Ns_Set *
Ns_TclGetSet(Tcl_Interp *interp, char *id)
{
    Ns_Set *set;

    if (LookupInterpSet(interp, id, 0, &set) != TCL_OK) {
	return NULL;
    }
    return set;
}


/*
 *----------------------------------------------------------------------
 *
 * Ns_TclGetSet2 --
 *
 *	Like Ns_TclGetSet, but sends errors to the tcl interp. 
 *
 * Results:
 *	TCL result. 
 *
 * Side effects:
 *	None. 
 *
 *----------------------------------------------------------------------
 */

int
Ns_TclGetSet2(Tcl_Interp *interp, char *id, Ns_Set **setPtr)
{
    return LookupInterpSet(interp, id, 0, setPtr);
}


/*
 *----------------------------------------------------------------------
 *
 * Ns_TclFreeSet --
 *
 *	Free a set id, and if own by Tcl, the underlying Ns_Set.
 *
 * Results:
 *	NS_OK/NS_ERROR. 
 *
 * Side effects:
 *	Will free the set matching the passed-in set id, and all of 
 *	its associated data. 
 *
 *----------------------------------------------------------------------
 */

int
Ns_TclFreeSet(Tcl_Interp *interp, char *id)
{
    Ns_Set  *set;

    if (LookupInterpSet(interp, id, 1, &set) != TCL_OK) {
	return TCL_ERROR;
    }
    if (IS_DYNAMIC(id)) {
    	Ns_SetFree(set);
    }
    return TCL_OK;
}


/*
 *----------------------------------------------------------------------
 *
 * NsTclSetObjCmd --
 *
 *	Implelments ns_set. 
 *
 * Results:
 *	Tcl result. 
 *
 * Side effects:
 *	See docs. 
 *
 *----------------------------------------------------------------------
 */

int
NsTclSetObjCmd(ClientData arg, Tcl_Interp *interp, int objc, Tcl_Obj **objv)
{
    Ns_Set       *set, *set2Ptr, **sets;
    int           locked, i, flags;
    char         *key, *val, *name, *split;
    Tcl_DString	  ds;
    Tcl_HashTable *tablePtr;
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    NsInterp	  *itPtr = arg;
    Tcl_Obj	  *objPtr;
    static CONST char *opts[] = {
	 "array", "cleanup", "copy", "cput", "create", "delete",
	 "delkey", "find", "free", "get", "icput", "idelete",
	 "idelkey", "ifind", "iget", "isnull", "iunique", "key",
	 "list", "merge", "move", "name", "new", "print", "purge",
	 "put", "size", "split", "truncate", "unique", "update",
	 "value", NULL,
    };
    enum {
	 SArrayIdx, SCleanupIdx, SCopyIdx, SCPutIdx, SCreateidx,
	 SDeleteIdx, SDelkeyIdx, SFindIdx, SFreeIdx, SGetIdx,
	 SICPutIdx, SIDeleteIdx, SIDelkeyIdx, SIFindIdx, SIGetIdx,
	 SIsNullIdx, SIUniqueIdx, SKeyIdx, SListIdx, SMergeIdx,
	 SMoveIdx, sINameIdx, SNewIdx, SPrintIdx, spurgeidx, SPutIdx,
	 SSizeIdx, SSplitIdx, STruncateIdx, SUniqueIdx, SUpdateIdx,
	 SValueIdx
    };
    int opt;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
        return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], opts, "option", 0,
			    &opt) != TCL_OK) {
	return TCL_ERROR;
    }
    if (opt == SCreateidx) {
	opt = SNewIdx;
    }

    switch (opt) {
    case SCleanupIdx:
    	tablePtr = &itPtr->sets;
    	hPtr = Tcl_FirstHashEntry(tablePtr, &search);
    	while (hPtr != NULL) {
    	    key = Tcl_GetHashKey(tablePtr, hPtr);
	    if (IS_DYNAMIC(key)) {
    	       	set = Tcl_GetHashValue(hPtr);
	       	Ns_SetFree(set);
	    }
	    hPtr = Tcl_NextHashEntry(&search);
	}
    	Tcl_DeleteHashTable(tablePtr);
    	Tcl_InitHashTable(tablePtr, TCL_STRING_KEYS);
	break;

    case SListIdx:
	if (objc == 2) {
	    tablePtr = &itPtr->sets;
    	    locked = 0;
	} else if (STREQ(Tcl_GetString(objv[2]), "-shared")) {
	    tablePtr = &itPtr->servPtr->sets.table;
	    locked = 1;
	    Ns_MutexLock(&itPtr->servPtr->sets.lock);
	} else {
	    Tcl_WrongNumArgs(interp, 2, objv, "?-shared?");
	    return TCL_ERROR;
	}
	if (tablePtr != NULL) {
	    hPtr = Tcl_FirstHashEntry(tablePtr, &search);
	    while (hPtr != NULL) {
		Tcl_AppendElement(interp, Tcl_GetHashKey(tablePtr, hPtr));
		hPtr = Tcl_NextHashEntry(&search);
	    }
	}
	if (locked) {
	    Ns_MutexUnlock(&itPtr->servPtr->sets.lock);
	}
	break;

    case SNewIdx:
    case SCopyIdx:
    case SSplitIdx:
	/*
	 * The following commands create new sets.
	 */
	
        flags = NS_TCL_SET_DYNAMIC;
        i = 2;
        if (objc > 2) {
	    char *oflag = Tcl_GetString(objv[2]);
	    if (STREQ(oflag, "-shared") || STREQ(oflag, "-persist")) {
            	flags |= NS_TCL_SET_SHARED;
            	++i;
	    }
        }
	
        switch (opt) {
	case SNewIdx:
	    name = (i < objc) ? Tcl_GetString(objv[i++]) : NULL;
	    set = Ns_SetCreate(name);
	    while (i < objc) {
		key = Tcl_GetString(objv[i++]);
		val = (i < objc) ? Tcl_GetString(objv[i++]) : NULL;
		Ns_SetPut(set, key, val);
	    }
            EnterSet(itPtr, set, flags);
            break;

        case SCopyIdx:
            if (i >= objc) {
		Tcl_WrongNumArgs(interp, 2, objv, "?-shared? setId");
		return TCL_ERROR;
            }
	    if (LookupObjSet(itPtr, objv[i], 0, &set) != TCL_OK) {
                return TCL_ERROR;
            }
            EnterSet(itPtr, Ns_SetCopy(set), flags);
            break;
	
        case SSplitIdx:
	    if ((objc - i) < 1) {
		Tcl_WrongNumArgs(interp, 2, objv, "?-shared? setId ?splitChar");
		return TCL_ERROR;
            }
	    if (LookupObjSet(itPtr, objv[i++], 0, &set) != TCL_OK) {
                return TCL_ERROR;
            }
	    split = (i < objc) ? Tcl_GetString(objv[i]) : ".";
            sets = Ns_SetSplit(set, *split);
            for (i = 0; sets[i] != NULL; i++) {
                EnterSet(itPtr, sets[i], flags);
            }
            ns_free(sets);
            break;
        }
	break;

    default:
        /*
         * All futher commands require a valid set.
         */
	
        if (objc < 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "setId ?args?");
	    return TCL_ERROR;
        }
	if (LookupObjSet(itPtr, objv[2], 0, &set) != TCL_OK) {
            return TCL_ERROR;
        }

	switch (opt) {
	case SArrayIdx:
	case SSizeIdx:
	case sINameIdx:
	case SPrintIdx:
	case SFreeIdx:
	    /*
	     * These commands require only the set.
	     */

	    if (objc != 3) {
		Tcl_WrongNumArgs(interp, 2, objv, "setId");
		return TCL_ERROR;
            }
	    switch (opt) {
	    case SArrayIdx:
		Tcl_DStringInit(&ds);
		for (i = 0; i < Ns_SetSize(set); ++i) {
		    Tcl_DStringAppendElement(&ds, Ns_SetKey(set, i));
		    Tcl_DStringAppendElement(&ds, Ns_SetValue(set, i));
		}
		Tcl_DStringResult(interp, &ds);
		break;

            case SSizeIdx:
		objPtr = Tcl_NewIntObj(Ns_SetSize(set));
		Tcl_SetObjResult(interp, objPtr);
                break;
		
            case sINameIdx:
                Tcl_SetResult(interp, set->name, TCL_VOLATILE);
                break;
		
	    case SPrintIdx:
                Ns_SetPrint(set);
                break;
		
	    case SFreeIdx:
                Ns_TclFreeSet(interp, Tcl_GetString(objv[2]));
                break;
            }
	    break;

	case SFindIdx:
	case SIFindIdx:
	case SGetIdx:
	case SIGetIdx:
	case SDelkeyIdx:
	case SIDelkeyIdx:
	case SUniqueIdx:
	case SIUniqueIdx:
	    /*
	     * These commands require a set and string key.
	     */

            if (objc != 4) {
		Tcl_WrongNumArgs(interp, 2, objv, "setId key");
		return TCL_ERROR;
            }
	    key = Tcl_GetString(objv[3]);
	    switch (opt) {
	    case SFindIdx:
		objPtr = Tcl_NewIntObj(Ns_SetFind(set, key));
		Tcl_SetObjResult(interp, objPtr);
                break;
		
            case SGetIdx:
                Tcl_SetResult(interp, Ns_SetGet(set, key), TCL_VOLATILE);
                break;
		
            case SDeleteIdx:
            case SDelkeyIdx:
                Ns_SetDeleteKey(set, key);
                break;
		
            case SUniqueIdx:
		objPtr = Tcl_NewIntObj(Ns_SetUnique(set, key));
		Tcl_SetObjResult(interp, objPtr);
                break;
		
	    case SIFindIdx:
		objPtr = Tcl_NewIntObj(Ns_SetIFind(set, key));
		Tcl_SetObjResult(interp, objPtr);
                break;

	    case SIGetIdx:
                Tcl_SetResult(interp, Ns_SetIGet(set, key), TCL_VOLATILE);
                break;
		    
	    case SIDeleteIdx:
            case SIDelkeyIdx:
                Ns_SetIDeleteKey(set, key);
                break;
		    
            case SIUniqueIdx:
		objPtr = Tcl_NewIntObj(Ns_SetIUnique(set, key));
		Tcl_SetObjResult(interp, objPtr);
                break;
            }
	    break;

	case SValueIdx:
	case SIsNullIdx:
	case SKeyIdx:
	case SDeleteIdx:
	case STruncateIdx:
	    /*
	     * These commands require a set and key/value index.
	     */

            if (objc != 4) {
		Tcl_WrongNumArgs(interp, 2, objv, "setId index");
		return TCL_ERROR;
            }
            if (Tcl_GetIntFromObj(interp, objv[3], &i) != TCL_OK) {
                return TCL_ERROR;
            }
	    if (i < 0) {
		Tcl_AppendResult(interp, "invalid index \"",
		    Tcl_GetString(objv[3]), "\": must be >= 0", NULL);
                return TCL_ERROR;
            }
            if (i >= Ns_SetSize(set)) {
		Tcl_AppendResult(interp, "invalid index \"",
		    Tcl_GetString(objv[3]),
		    "\": beyond range of set fields", NULL);
                return TCL_ERROR;
            }
            switch (opt) {
	    case SValueIdx:
		val = Ns_SetValue(set, i);
                Tcl_SetResult(interp, val, TCL_VOLATILE);
                break;
		
            case SIsNullIdx:
		val = Ns_SetValue(set, i);
		objPtr = Tcl_NewBooleanObj(val ? 0 : 1);
                Tcl_SetObjResult(interp, objPtr);
                break;
		
	    case SKeyIdx:
		key = Ns_SetKey(set, i);
                Tcl_SetResult(interp, key, TCL_VOLATILE);
                break;
		
	    case SDeleteIdx:
                Ns_SetDelete(set, i);
                break;
		
            case STruncateIdx:
                Ns_SetTrunc(set, i);
                break;
            }
	    break;

	case SPutIdx:
	case SUpdateIdx:
	case SCPutIdx:
	case SICPutIdx:
	    /*
	     * These commands require a set, key, and value.
	     */

            if (objc != 5) {
		Tcl_WrongNumArgs(interp, 2, objv, "setId key value");
		return TCL_ERROR;
            }
	    key = Tcl_GetString(objv[3]);
	    val = Tcl_GetString(objv[4]);
	    switch (opt) {
	    case SUpdateIdx:
                Ns_SetDeleteKey(set, key);
                i = Ns_SetPut(set, key, val);
		break;
		
	    case SICPutIdx:
                i = Ns_SetIFind(set, key);
		if (i < 0) {
		    i = Ns_SetPut(set, key, val);
		}
		break;
		
	    case SCPutIdx:
                i = Ns_SetFind(set, key);
		if (i < 0) {
		    i = Ns_SetPut(set, key, val);
		}
		break;
		
	    case SPutIdx:
		i = Ns_SetPut(set, key, val);
		break;
            }
	    objPtr = Tcl_NewIntObj(i);
	    Tcl_SetObjResult(interp, objPtr);
	    break;

	case SMergeIdx:
	case SMoveIdx:
	    /*
	     * These commands require two sets.
	     */

            if (objc != 4) {
		Tcl_WrongNumArgs(interp, 2, objv, "setTo setFrom");
		return TCL_ERROR;
            }
            if (LookupObjSet(itPtr, objv[3], 0, &set2Ptr) != TCL_OK) {
                return TCL_ERROR;
            }
	    if (opt == SMergeIdx) {
                Ns_SetMerge(set, set2Ptr);
	    } else {
                Ns_SetMove(set, set2Ptr);
	    }
	    Tcl_SetObjResult(interp, objv[2]);
	    break;
	}
    }

    return TCL_OK;
}



/*
 *----------------------------------------------------------------------
 *
 * NsTclParseHeaderCmd --
 *
 *	This wraps Ns_ParseHeader. 
 *
 * Results:
 *	Tcl result. 
 *
 * Side effects:
 *	Parse an HTTP header and add it to an existing set; see 
 *	Ns_ParseHeader. 
 *
 *----------------------------------------------------------------------
 */

int
NsTclParseHeaderCmd(ClientData arg, Tcl_Interp *interp, int argc, char **argv)
{
    NsInterp *itPtr = arg;
    Ns_Set *set;
    Ns_HeaderCaseDisposition disp;

    if (argc != 3 && argc != 4) {
        Tcl_AppendResult(interp, "wrong # of args: should be \"",
            argv[0], " set header ?tolower|toupper|preserve?\"", NULL);
        return TCL_ERROR;
    }
    if (LookupSet(itPtr, argv[1], 0, &set) != TCL_OK) {
        return TCL_ERROR;
    }
    if (argc < 4) {
	disp = ToLower;
    } else if (STREQ(argv[3], "toupper")) {
        disp = ToUpper;
    } else if (STREQ(argv[3], "tolower")) {
        disp = ToLower;
    } else if (STREQ(argv[3], "preserve")) {
        disp = Preserve;
    } else {
        Tcl_AppendResult(interp, "unknown case disposition \"", argv[3],
            "\":  should be toupper, tolower, or preserve", NULL);
        return TCL_ERROR;
    }
    if (Ns_ParseHeader(set, argv[2], disp) != NS_OK) {
        Tcl_AppendResult(interp, "invalid header:  ", argv[2], NULL);
        return TCL_ERROR;
    }
    return TCL_OK;
}


/*
 *----------------------------------------------------------------------
 *
 * EnterSet --
 *
 *	Add an Ns_Set to an interp, creating a new unique id.
 *
 * Results:
 *	TCL_OK or TCL_ERROR.
 *
 * Side effects:
 *      Set will be entered in the shared or private table.
 *
 *----------------------------------------------------------------------
 */

static int
EnterSet(NsInterp *itPtr, Ns_Set *set, int flags)
{
    Tcl_HashTable  *tablePtr;
    Tcl_HashEntry  *hPtr;
    int             new, next;
    unsigned char   type;
    char	    buf[20];

    if (flags & NS_TCL_SET_SHARED) {
	/*
	 * Lock the global mutex and use the shared sets.
	 */
	
	if (flags & NS_TCL_SET_DYNAMIC) {
	    type = SET_SHARED_DYNAMIC;
	} else {
	    type = SET_SHARED_STATIC;
	}
	tablePtr = &itPtr->servPtr->sets.table;
        Ns_MutexLock(&itPtr->servPtr->sets.lock);
    } else {
	tablePtr = &itPtr->sets;
	if (flags & NS_TCL_SET_DYNAMIC) {
	    type = SET_DYNAMIC;
	} else {
            type = SET_STATIC;
	}
    }

    /*
     * Allocate a new set IDs until we find an unused one.
     */
    
    next = tablePtr->numEntries;
    do {
        sprintf(buf, "%c%u", type, next);
	++next;
        hPtr = Tcl_CreateHashEntry(tablePtr, buf, &new);
    } while (!new);
    Tcl_SetHashValue(hPtr, set);
    Tcl_AppendElement(itPtr->interp, buf);

    /*
     * Unlock the global mutex (locked above) if it's a persistent set.
     */
    if (flags & NS_TCL_SET_SHARED) {
        Ns_MutexUnlock(&itPtr->servPtr->sets.lock);
    }
    return TCL_OK;
}


/*
 *----------------------------------------------------------------------
 *
 * LookupSet --
 *
 *	Take a tcl set handle and return a matching Set. This 
 *	takes both persistent and dynamic set handles. 
 *
 * Results:
 *	TCL_OK or TCL_ERROR.
 *
 * Side effects:
 *      If delete is set, then the hash entry will be removed.
 *  	Set will be returned in given setPtr.
 *
 *----------------------------------------------------------------------
 */

static int
LookupObjSet(NsInterp *itPtr, Tcl_Obj *idPtr, int delete, Ns_Set **setPtr)
{
    return LookupSet(itPtr, Tcl_GetString(idPtr), delete, setPtr);
}

static int
LookupInterpSet(Tcl_Interp *interp, char *id, int delete, Ns_Set **setPtr)
{
    NsInterp *itPtr;

    itPtr = NsGetInterpData(interp);
    if (itPtr == NULL) {
	Tcl_SetResult(interp, "ns_set not supported", TCL_STATIC);
	return TCL_ERROR;
    }
    return LookupSet(itPtr, id, delete, setPtr);
}

static int
LookupSet(NsInterp *itPtr, char *id, int delete, Ns_Set **setPtr)
{
    Tcl_HashTable *tablePtr;
    Tcl_HashEntry *hPtr;
    Ns_Set        *set;

    /*
     * If it's a persistent set, use the shared table, otherwise
     * use the private table.
     */
    
    set = NULL;
    if (IS_SHARED(id)) {
    	tablePtr = &itPtr->servPtr->sets.table;
        Ns_MutexLock(&itPtr->servPtr->sets.lock);
    } else {
	tablePtr = &itPtr->sets;
    }
    hPtr = Tcl_FindHashEntry(tablePtr, id);
    if (hPtr != NULL) {
        set = (Ns_Set *) Tcl_GetHashValue(hPtr);
        if (delete) {
            Tcl_DeleteHashEntry(hPtr);
        }
    }
    if (IS_SHARED(id)) {
        Ns_MutexUnlock(&itPtr->servPtr->sets.lock);
    }
    if (set == NULL) {
	Tcl_AppendResult(itPtr->interp, "no such set: ", id, NULL);
	return TCL_ERROR;
    }
    *setPtr = set;
    return TCL_OK;
}
