#include "tclInt.h"
typedef struct PkgAvail {
char *version;
char *script;
struct PkgAvail *nextPtr;
} PkgAvail;
typedef struct Package {
char *version;
PkgAvail *availPtr;
} Package;
static int CheckVersion _ANSI_ARGS_((Tcl_Interp *interp,
char *string));
static int ComparePkgVersions _ANSI_ARGS_((char *v1, char *v2,
int *satPtr));
static Package * FindPackage _ANSI_ARGS_((Tcl_Interp *interp,
char *name));
int
Tcl_PkgProvide(interp, name, version)
Tcl_Interp *interp;
char *name;
char *version;
{
Package *pkgPtr;
pkgPtr = FindPackage(interp, name);
if (pkgPtr->version == NULL) {
pkgPtr->version = ckalloc((unsigned) (strlen(version) + 1));
strcpy(pkgPtr->version, version);
return TCL_OK;
}
if (ComparePkgVersions(pkgPtr->version, version, (int *) NULL) == 0) {
return TCL_OK;
}
Tcl_AppendResult(interp, "conflicting versions provided for package \"",
name, "\": ", pkgPtr->version, ", then ", version, (char *) NULL);
return TCL_ERROR;
}
char *
Tcl_PkgRequire(interp, name, version, exact)
Tcl_Interp *interp;
char *name;
char *version;
int exact;
{
Package *pkgPtr;
PkgAvail *availPtr, *bestPtr;
char *script;
int code, satisfies, result, pass;
Tcl_DString command;
for (pass = 1; ; pass++) {
pkgPtr = FindPackage(interp, name);
if (pkgPtr->version != NULL) {
break;
}
bestPtr = NULL;
for (availPtr = pkgPtr->availPtr; availPtr != NULL;
availPtr = availPtr->nextPtr) {
if ((bestPtr != NULL) && (ComparePkgVersions(availPtr->version,
bestPtr->version, (int *) NULL) <= 0)) {
continue;
}
if (version != NULL) {
result = ComparePkgVersions(availPtr->version, version,
&satisfies);
if ((result != 0) && exact) {
continue;
}
if (!satisfies) {
continue;
}
}
bestPtr = availPtr;
}
if (bestPtr != NULL) {
script = bestPtr->script;
Tcl_Preserve((ClientData) script);
code = Tcl_GlobalEval(interp, script);
Tcl_Release((ClientData) script);
if (code != TCL_OK) {
if (code == TCL_ERROR) {
Tcl_AddErrorInfo(interp,
"\n (\"package ifneeded\" script)");
}
return NULL;
}
Tcl_ResetResult(interp);
pkgPtr = FindPackage(interp, name);
break;
}
if (pass > 1) {
break;
}
script = ((Interp *) interp)->packageUnknown;
if (script != NULL) {
Tcl_DStringInit(&command);
Tcl_DStringAppend(&command, script, -1);
Tcl_DStringAppendElement(&command, name);
Tcl_DStringAppend(&command, " ", 1);
Tcl_DStringAppend(&command, (version != NULL) ? version : "{}",
-1);
if (exact) {
Tcl_DStringAppend(&command, " -exact", 7);
}
code = Tcl_GlobalEval(interp, Tcl_DStringValue(&command));
Tcl_DStringFree(&command);
if (code != TCL_OK) {
if (code == TCL_ERROR) {
Tcl_AddErrorInfo(interp,
"\n (\"package unknown\" script)");
}
return NULL;
}
Tcl_ResetResult(interp);
}
}
if (pkgPtr->version == NULL) {
Tcl_AppendResult(interp, "can't find package ", name,
(char *) NULL);
if (version != NULL) {
Tcl_AppendResult(interp, " ", version, (char *) NULL);
}
return NULL;
}
if (version == NULL) {
return pkgPtr->version;
}
result = ComparePkgVersions(pkgPtr->version, version, &satisfies);
if ((satisfies && !exact) || (result == 0)) {
return pkgPtr->version;
}
Tcl_AppendResult(interp, "version conflict for package \"",
name, "\": have ", pkgPtr->version, ", need ", version,
(char *) NULL);
return NULL;
}
int
Tcl_PackageCmd(dummy, interp, argc, argv)
ClientData dummy;
Tcl_Interp *interp;
int argc;
char **argv;
{
Interp *iPtr = (Interp *) interp;
size_t length;
int c, exact, i, satisfies;
PkgAvail *availPtr, *prevPtr;
Package *pkgPtr;
Tcl_HashEntry *hPtr;
Tcl_HashSearch search;
Tcl_HashTable *tablePtr;
char *version;
char buf[30];
if (argc < 2) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
" option ?arg arg ...?\"", (char *) NULL);
return TCL_ERROR;
}
c = argv[1][0];
length = strlen(argv[1]);
if ((c == 'f') && (strncmp(argv[1], "forget", length) == 0)) {
for (i = 2; i < argc; i++) {
hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv[i]);
if (hPtr == NULL) {
return TCL_OK;
}
pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
Tcl_DeleteHashEntry(hPtr);
if (pkgPtr->version != NULL) {
ckfree(pkgPtr->version);
}
while (pkgPtr->availPtr != NULL) {
availPtr = pkgPtr->availPtr;
pkgPtr->availPtr = availPtr->nextPtr;
ckfree(availPtr->version);
Tcl_EventuallyFree((ClientData)availPtr->script, TCL_DYNAMIC);
ckfree((char *) availPtr);
}
ckfree((char *) pkgPtr);
}
} else if ((c == 'i') && (strncmp(argv[1], "ifneeded", length) == 0)) {
if ((argc != 4) && (argc != 5)) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
" ifneeded package version ?script?\"", (char *) NULL);
return TCL_ERROR;
}
if (CheckVersion(interp, argv[3]) != TCL_OK) {
return TCL_ERROR;
}
if (argc == 4) {
hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv[2]);
if (hPtr == NULL) {
return TCL_OK;
}
pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
} else {
pkgPtr = FindPackage(interp, argv[2]);
}
for (availPtr = pkgPtr->availPtr, prevPtr = NULL; availPtr != NULL;
prevPtr = availPtr, availPtr = availPtr->nextPtr) {
if (ComparePkgVersions(availPtr->version, argv[3], (int *) NULL)
== 0) {
if (argc == 4) {
Tcl_SetResult(interp, availPtr->script, TCL_VOLATILE);
return TCL_OK;
}
Tcl_EventuallyFree((ClientData)availPtr->script, TCL_DYNAMIC);
break;
}
}
if (argc == 4) {
return TCL_OK;
}
if (availPtr == NULL) {
availPtr = (PkgAvail *) ckalloc(sizeof(PkgAvail));
availPtr->version = ckalloc((unsigned) (strlen(argv[3]) + 1));
strcpy(availPtr->version, argv[3]);
if (prevPtr == NULL) {
availPtr->nextPtr = pkgPtr->availPtr;
pkgPtr->availPtr = availPtr;
} else {
availPtr->nextPtr = prevPtr->nextPtr;
prevPtr->nextPtr = availPtr;
}
}
availPtr->script = ckalloc((unsigned) (strlen(argv[4]) + 1));
strcpy(availPtr->script, argv[4]);
} else if ((c == 'n') && (strncmp(argv[1], "names", length) == 0)) {
if (argc != 2) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
" names\"", (char *) NULL);
return TCL_ERROR;
}
tablePtr = &iPtr->packageTable;
for (hPtr = Tcl_FirstHashEntry(tablePtr, &search); hPtr != NULL;
hPtr = Tcl_NextHashEntry(&search)) {
pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
if ((pkgPtr->version != NULL) || (pkgPtr->availPtr != NULL)) {
Tcl_AppendElement(interp, Tcl_GetHashKey(tablePtr, hPtr));
}
}
} else if ((c == 'p') && (strncmp(argv[1], "provide", length) == 0)) {
if ((argc != 3) && (argc != 4)) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
" provide package ?version?\"", (char *) NULL);
return TCL_ERROR;
}
if (argc == 3) {
hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv[2]);
if (hPtr != NULL) {
pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
if (pkgPtr->version != NULL) {
Tcl_SetResult(interp, pkgPtr->version, TCL_VOLATILE);
}
}
return TCL_OK;
}
if (CheckVersion(interp, argv[3]) != TCL_OK) {
return TCL_ERROR;
}
return Tcl_PkgProvide(interp, argv[2], argv[3]);
} else if ((c == 'r') && (strncmp(argv[1], "require", length) == 0)) {
if (argc < 3) {
requireSyntax:
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
" require ?-exact? package ?version?\"", (char *) NULL);
return TCL_ERROR;
}
if ((argv[2][0] == '-') && (strcmp(argv[2], "-exact") == 0)) {
exact = 1;
} else {
exact = 0;
}
version = NULL;
if (argc == (4+exact)) {
version = argv[3+exact];
if (CheckVersion(interp, version) != TCL_OK) {
return TCL_ERROR;
}
} else if ((argc != 3) || exact) {
goto requireSyntax;
}
version = Tcl_PkgRequire(interp, argv[2+exact], version, exact);
if (version == NULL) {
return TCL_ERROR;
}
Tcl_SetResult(interp, version, TCL_VOLATILE);
} else if ((c == 'u') && (strncmp(argv[1], "unknown", length) == 0)) {
if (argc == 2) {
if (iPtr->packageUnknown != NULL) {
Tcl_SetResult(interp, iPtr->packageUnknown, TCL_VOLATILE);
}
} else if (argc == 3) {
if (iPtr->packageUnknown != NULL) {
ckfree(iPtr->packageUnknown);
}
if (argv[2][0] == 0) {
iPtr->packageUnknown = NULL;
} else {
iPtr->packageUnknown = (char *) ckalloc((unsigned)
(strlen(argv[2]) + 1));
strcpy(iPtr->packageUnknown, argv[2]);
}
} else {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
" unknown ?command?\"", (char *) NULL);
return TCL_ERROR;
}
} else if ((c == 'v') && (strncmp(argv[1], "vcompare", length) == 0)
&& (length >= 2)) {
if (argc != 4) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
" vcompare version1 version2\"", (char *) NULL);
return TCL_ERROR;
}
if ((CheckVersion(interp, argv[2]) != TCL_OK)
|| (CheckVersion(interp, argv[3]) != TCL_OK)) {
return TCL_ERROR;
}
TclFormatInt(buf, ComparePkgVersions(argv[2], argv[3], (int *) NULL));
Tcl_SetResult(interp, buf, TCL_VOLATILE);
} else if ((c == 'v') && (strncmp(argv[1], "versions", length) == 0)
&& (length >= 2)) {
if (argc != 3) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
" versions package\"", (char *) NULL);
return TCL_ERROR;
}
hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv[2]);
if (hPtr != NULL) {
pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
for (availPtr = pkgPtr->availPtr; availPtr != NULL;
availPtr = availPtr->nextPtr) {
Tcl_AppendElement(interp, availPtr->version);
}
}
} else if ((c == 'v') && (strncmp(argv[1], "vsatisfies", length) == 0)
&& (length >= 2)) {
if (argc != 4) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
" vsatisfies version1 version2\"", (char *) NULL);
return TCL_ERROR;
}
if ((CheckVersion(interp, argv[2]) != TCL_OK)
|| (CheckVersion(interp, argv[3]) != TCL_OK)) {
return TCL_ERROR;
}
ComparePkgVersions(argv[2], argv[3], &satisfies);
TclFormatInt(buf, satisfies);
Tcl_SetResult(interp, buf, TCL_VOLATILE);
} else {
Tcl_AppendResult(interp, "bad option \"", argv[1],
"\": should be forget, ifneeded, names, ",
"provide, require, unknown, vcompare, ",
"versions, or vsatisfies", (char *) NULL);
return TCL_ERROR;
}
return TCL_OK;
}
static Package *
FindPackage(interp, name)
Tcl_Interp *interp;
char *name;
{
Interp *iPtr = (Interp *) interp;
Tcl_HashEntry *hPtr;
int new;
Package *pkgPtr;
hPtr = Tcl_CreateHashEntry(&iPtr->packageTable, name, &new);
if (new) {
pkgPtr = (Package *) ckalloc(sizeof(Package));
pkgPtr->version = NULL;
pkgPtr->availPtr = NULL;
Tcl_SetHashValue(hPtr, pkgPtr);
} else {
pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
}
return pkgPtr;
}
void
TclFreePackageInfo(iPtr)
Interp *iPtr;
{
Package *pkgPtr;
Tcl_HashSearch search;
Tcl_HashEntry *hPtr;
PkgAvail *availPtr;
for (hPtr = Tcl_FirstHashEntry(&iPtr->packageTable, &search);
hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
if (pkgPtr->version != NULL) {
ckfree(pkgPtr->version);
}
while (pkgPtr->availPtr != NULL) {
availPtr = pkgPtr->availPtr;
pkgPtr->availPtr = availPtr->nextPtr;
ckfree(availPtr->version);
Tcl_EventuallyFree((ClientData)availPtr->script, TCL_DYNAMIC);
ckfree((char *) availPtr);
}
ckfree((char *) pkgPtr);
}
Tcl_DeleteHashTable(&iPtr->packageTable);
if (iPtr->packageUnknown != NULL) {
ckfree(iPtr->packageUnknown);
}
}
static int
CheckVersion(interp, string)
Tcl_Interp *interp;
char *string;
{
char *p = string;
if (!isdigit(UCHAR(*p))) {
goto error;
}
for (p++; *p != 0; p++) {
if (!isdigit(UCHAR(*p)) && (*p != '.')) {
goto error;
}
}
if (p[-1] != '.') {
return TCL_OK;
}
error:
Tcl_AppendResult(interp, "expected version number but got \"",
string, "\"", (char *) NULL);
return TCL_ERROR;
}
static int
ComparePkgVersions(v1, v2, satPtr)
char *v1, *v2;
int *satPtr;
{
int thisIsMajor, n1, n2;
thisIsMajor = 1;
while (1) {
n1 = n2 = 0;
while ((*v1 != 0) && (*v1 != '.')) {
n1 = 10*n1 + (*v1 - '0');
v1++;
}
while ((*v2 != 0) && (*v2 != '.')) {
n2 = 10*n2 + (*v2 - '0');
v2++;
}
if (n1 != n2) {
break;
}
if (*v1 != 0) {
v1++;
} else if (*v2 == 0) {
break;
}
if (*v2 != 0) {
v2++;
}
thisIsMajor = 0;
}
if (satPtr != NULL) {
*satPtr = (n1 == n2) || ((n1 > n2) && !thisIsMajor);
}
if (n1 > n2) {
return 1;
} else if (n1 == n2) {
return 0;
} else {
return -1;
}
}