/* 

 * tclScan.c --

 *

 *	This file contains the implementation of the "scan" command.

 *

 * Copyright (c) 1998 by Scriptics Corporation.

 *

 * See the file "license.terms" for information on usage and redistribution

 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.

 *

 * RCS: @(#) $Id: tclScan.c,v 1.12.2.2 2005/10/23 22:01:30 msofer Exp $

 */

#include "tclInt.h"

/*

 * For strtoll() and strtoull() declarations on some platforms...

 */

#include "tclPort.h"

/*

 * Flag values used by Tcl_ScanObjCmd.

 */

#define SCAN_NOSKIP	0x1		  /* Don't skip blanks. */

#define SCAN_SUPPRESS	0x2		  /* Suppress assignment. */

#define SCAN_UNSIGNED	0x4		  /* Read an unsigned value. */

#define SCAN_WIDTH	0x8		  /* A width value was supplied. */

#define SCAN_SIGNOK	0x10		  /* A +/- character is allowed. */

#define SCAN_NODIGITS	0x20		  /* No digits have been scanned. */

#define SCAN_NOZERO	0x40		  /* No zero digits have been scanned. */

#define SCAN_XOK	0x80		  /* An 'x' is allowed. */

#define SCAN_PTOK	0x100		  /* Decimal point is allowed. */

#define SCAN_EXPOK	0x200		  /* An exponent is allowed. */

#define SCAN_LONGER	0x400		  /* Asked for a wide value. */

/*

 * The following structure contains the information associated with

 * a character set.

 */

typedef struct CharSet {

    int exclude;		/* 1 if this is an exclusion set. */

    int nchars;

    Tcl_UniChar *chars;

    int nranges;

    struct Range {

	Tcl_UniChar start;

	Tcl_UniChar end;

    } *ranges;

} CharSet;

/*

 * Declarations for functions used only in this file.

 */

static char *	BuildCharSet _ANSI_ARGS_((CharSet *cset, char *format));

static int	CharInSet _ANSI_ARGS_((CharSet *cset, int ch));

static void	ReleaseCharSet _ANSI_ARGS_((CharSet *cset));

static int	ValidateFormat _ANSI_ARGS_((Tcl_Interp *interp, char *format,

		    int numVars, int *totalVars));

/*

 *----------------------------------------------------------------------

 *

 * BuildCharSet --

 *

 *	This function examines a character set format specification

 *	and builds a CharSet containing the individual characters and

 *	character ranges specified.

 *

 * Results:

 *	Returns the next format position.

 *

 * Side effects:

 *	Initializes the charset.

 *

 *----------------------------------------------------------------------

 */

static char *

BuildCharSet(cset, format)

    CharSet *cset;

    char *format;		/* Points to first char of set. */

{

    Tcl_UniChar ch, start;

    int offset, nranges;

    char *end;

    memset(cset, 0, sizeof(CharSet));

    offset = Tcl_UtfToUniChar(format, &ch);

    if (ch == '^') {

	cset->exclude = 1;

	format += offset;

	offset = Tcl_UtfToUniChar(format, &ch);

    }

    end = format + offset;

    /*

     * Find the close bracket so we can overallocate the set.

     */

    if (ch == ']') {

	end += Tcl_UtfToUniChar(end, &ch);

    }

    nranges = 0;

    while (ch != ']') {

	if (ch == '-') {

	    nranges++;

	}

	end += Tcl_UtfToUniChar(end, &ch);

    }

    cset->chars = (Tcl_UniChar *) ckalloc(sizeof(Tcl_UniChar)

	    * (end - format - 1));

    if (nranges > 0) {

	cset->ranges = (struct Range *) ckalloc(sizeof(struct Range)*nranges);

    } else {

	cset->ranges = NULL;

    }

    /*

     * Now build the character set.

     */

    cset->nchars = cset->nranges = 0;

    format += Tcl_UtfToUniChar(format, &ch);

    start = ch;

    if (ch == ']' || ch == '-') {

	cset->chars[cset->nchars++] = ch;

	format += Tcl_UtfToUniChar(format, &ch);

    }

    while (ch != ']') {

	if (*format == '-') {

	    /*

	     * This may be the first character of a range, so don't add

	     * it yet.

	     */

	    start = ch;

	} else if (ch == '-') {

	    /*

	     * Check to see if this is the last character in the set, in which

	     * case it is not a range and we should add the previous character

	     * as well as the dash.

	     */

	    if (*format == ']') {

		cset->chars[cset->nchars++] = start;

		cset->chars[cset->nchars++] = ch;

	    } else {

		format += Tcl_UtfToUniChar(format, &ch);

		/*

		 * Check to see if the range is in reverse order.

		 */

		if (start < ch) {

		    cset->ranges[cset->nranges].start = start;

		    cset->ranges[cset->nranges].end = ch;

		} else {

		    cset->ranges[cset->nranges].start = ch;

		    cset->ranges[cset->nranges].end = start;

		}		    

		cset->nranges++;

	    }

	} else {

	    cset->chars[cset->nchars++] = ch;

	}

	format += Tcl_UtfToUniChar(format, &ch);

    }

    return format;

}

/*

 *----------------------------------------------------------------------

 *

 * CharInSet --

 *

 *	Check to see if a character matches the given set.

 *

 * Results:

 *	Returns non-zero if the character matches the given set.

 *

 * Side effects:

 *	None.

 *

 *----------------------------------------------------------------------

 */

static int

CharInSet(cset, c)

    CharSet *cset;

    int c;			/* Character to test, passed as int because

				 * of non-ANSI prototypes. */

{

    Tcl_UniChar ch = (Tcl_UniChar) c;

    int i, match = 0;

    for (i = 0; i < cset->nchars; i++) {

	if (cset->chars[i] == ch) {

	    match = 1;

	    break;

	}

    }

    if (!match) {

	for (i = 0; i < cset->nranges; i++) {

	    if ((cset->ranges[i].start <= ch)

		    && (ch <= cset->ranges[i].end)) {

		match = 1;

		break;

	    }

	}

    }

    return (cset->exclude ? !match : match);    

}

/*

 *----------------------------------------------------------------------

 *

 * ReleaseCharSet --

 *

 *	Free the storage associated with a character set.

 *

 * Results:

 *	None.

 *

 * Side effects:

 *	None.

 *

 *----------------------------------------------------------------------

 */

static void

ReleaseCharSet(cset)

    CharSet *cset;

{

    ckfree((char *)cset->chars);

    if (cset->ranges) {

	ckfree((char *)cset->ranges);

    }

}

/*

 *----------------------------------------------------------------------

 *

 * ValidateFormat --

 *

 *	Parse the format string and verify that it is properly formed

 *	and that there are exactly enough variables on the command line.

 *

 * Results:

 *	A standard Tcl result.

 *

 * Side effects:

 *	May place an error in the interpreter result.

 *

 *----------------------------------------------------------------------

 */

static int

ValidateFormat(interp, format, numVars, totalSubs)

    Tcl_Interp *interp;		/* Current interpreter. */

    char *format;		/* The format string. */

    int numVars;		/* The number of variables passed to the

				 * scan command. */

    int *totalSubs;		/* The number of variables that will be

				 * required. */

{

#define STATIC_LIST_SIZE 16

    int gotXpg, gotSequential, value, i, flags;

    char *end;

    Tcl_UniChar ch;

    int staticAssign[STATIC_LIST_SIZE];

    int *nassign = staticAssign;

    int objIndex, xpgSize, nspace = STATIC_LIST_SIZE;

    char buf[TCL_UTF_MAX+1];

    /*

     * Initialize an array that records the number of times a variable

     * is assigned to by the format string.  We use this to detect if

     * a variable is multiply assigned or left unassigned.

     */

    if (numVars > nspace) {

	nassign = (int*)ckalloc(sizeof(int) * numVars);

	nspace = numVars;

    }

    for (i = 0; i < nspace; i++) {

	nassign[i] = 0;

    }

    xpgSize = objIndex = gotXpg = gotSequential = 0;

    while (*format != '\0') {

	format += Tcl_UtfToUniChar(format, &ch);

	flags = 0;

	if (ch != '%') {

	    continue;

	}

	format += Tcl_UtfToUniChar(format, &ch);

	if (ch == '%') {

	    continue;

	}

	if (ch == '*') {

	    flags |= SCAN_SUPPRESS;

	    format += Tcl_UtfToUniChar(format, &ch);

	    goto xpgCheckDone;

	}

	if ((ch < 0x80) && isdigit(UCHAR(ch))) { /* INTL: "C" locale. */

	    /*

	     * Check for an XPG3-style %n$ specification.  Note: there

	     * must not be a mixture of XPG3 specs and non-XPG3 specs

	     * in the same format string.

	     */

	    value = strtoul(format-1, &end, 10); /* INTL: "C" locale. */

	    if (*end != '$') {

		goto notXpg;

	    }

	    format = end+1;

	    format += Tcl_UtfToUniChar(format, &ch);

	    gotXpg = 1;

	    if (gotSequential) {

		goto mixedXPG;

	    }

	    objIndex = value - 1;

	    if ((objIndex < 0) || (numVars && (objIndex >= numVars))) {

		goto badIndex;

	    } else if (numVars == 0) {

		/*

		 * In the case where no vars are specified, the user can

		 * specify %9999$ legally, so we have to consider special

		 * rules for growing the assign array.  'value' is

		 * guaranteed to be > 0.

		 */

		xpgSize = (xpgSize > value) ? xpgSize : value;

	    }

	    goto xpgCheckDone;

	}

	notXpg:

	gotSequential = 1;

	if (gotXpg) {

	    mixedXPG:

	    Tcl_SetResult(interp,

		    "cannot mix \"%\" and \"%n$\" conversion specifiers",

		    TCL_STATIC);

	    goto error;

	}

	xpgCheckDone:

	/*

	 * Parse any width specifier.

	 */

	if ((ch < 0x80) && isdigit(UCHAR(ch))) { /* INTL: "C" locale. */

	    value = strtoul(format-1, &format, 10); /* INTL: "C" locale. */

	    flags |= SCAN_WIDTH;

	    format += Tcl_UtfToUniChar(format, &ch);

	}

	/*

	 * Handle any size specifier.

	 */

	switch (ch) {

	case 'l':

	case 'L':

	    flags |= SCAN_LONGER;

	case 'h':

	    format += Tcl_UtfToUniChar(format, &ch);

	}

	if (!(flags & SCAN_SUPPRESS) && numVars && (objIndex >= numVars)) {

	    goto badIndex;

	}

	/*

	 * Handle the various field types.

	 */

	switch (ch) {

	    case 'c':

                if (flags & SCAN_WIDTH) {

		    Tcl_SetResult(interp,

			    "field width may not be specified in %c conversion",

			    TCL_STATIC);

		    goto error;

                }

		/*

		 * Fall through!

		 */

	    case 'n':

	    case 's':

		if (flags & SCAN_LONGER) {

		invalidLonger:

		    buf[Tcl_UniCharToUtf(ch, buf)] = '\0';

		    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),

			   "'l' modifier may not be specified in %", buf,

			   " conversion", NULL);

		    goto error;

		}

		/*

		 * Fall through!

		 */

	    case 'd':

	    case 'e':

	    case 'f':

	    case 'g':

	    case 'i':

	    case 'o':

	    case 'u':

	    case 'x':

 		break;

		/*

		 * Bracket terms need special checking

		 */

	    case '[':

		if (flags & SCAN_LONGER) {

		    goto invalidLonger;

		}

		if (*format == '\0') {

		    goto badSet;

		}

		format += Tcl_UtfToUniChar(format, &ch);

		if (ch == '^') {

		    if (*format == '\0') {

			goto badSet;

		    }

		    format += Tcl_UtfToUniChar(format, &ch);

		}

		if (ch == ']') {

		    if (*format == '\0') {

			goto badSet;

		    }

		    format += Tcl_UtfToUniChar(format, &ch);

		}

		while (ch != ']') {

		    if (*format == '\0') {

			goto badSet;

		    }

		    format += Tcl_UtfToUniChar(format, &ch);

		}

		break;

	    badSet:

		Tcl_SetResult(interp, "unmatched [ in format string",

			TCL_STATIC);

		goto error;

	    default:

	    {

		char buf[TCL_UTF_MAX+1];

		buf[Tcl_UniCharToUtf(ch, buf)] = '\0';

		Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),

			"bad scan conversion character \"", buf, "\"", NULL);

		goto error;

	    }

	}

	if (!(flags & SCAN_SUPPRESS)) {

	    if (objIndex >= nspace) {

		/*

		 * Expand the nassign buffer.  If we are using XPG specifiers,

		 * make sure that we grow to a large enough size.  xpgSize is

		 * guaranteed to be at least one larger than objIndex.

		 */

		value = nspace;

		if (xpgSize) {

		    nspace = xpgSize;

		} else {

		    nspace += STATIC_LIST_SIZE;

		}

		if (nassign == staticAssign) {

		    nassign = (void *)ckalloc(nspace * sizeof(int));

		    for (i = 0; i < STATIC_LIST_SIZE; ++i) {

			nassign[i] = staticAssign[i];

		    }

		} else {

		    nassign = (void *)ckrealloc((void *)nassign,

			    nspace * sizeof(int));

		}

		for (i = value; i < nspace; i++) {

		    nassign[i] = 0;

		}

	    }

	    nassign[objIndex]++;

	    objIndex++;

	}

    }

    /*

     * Verify that all of the variable were assigned exactly once.

     */

    if (numVars == 0) {

	if (xpgSize) {

	    numVars = xpgSize;

	} else {

	    numVars = objIndex;

	}

    }

    if (totalSubs) {

	*totalSubs = numVars;

    }

    for (i = 0; i < numVars; i++) {

	if (nassign[i] > 1) {

	    Tcl_SetResult(interp, "variable is assigned by multiple \"%n$\" conversion specifiers", TCL_STATIC);

	    goto error;

	} else if (!xpgSize && (nassign[i] == 0)) {

	    /*

	     * If the space is empty, and xpgSize is 0 (means XPG wasn't

	     * used, and/or numVars != 0), then too many vars were given

	     */

	    Tcl_SetResult(interp, "variable is not assigned by any conversion specifiers", TCL_STATIC);

	    goto error;

	}

    }

    if (nassign != staticAssign) {

	ckfree((char *)nassign);

    }

    return TCL_OK;

    badIndex: