/*
* tclPkg.c --
*
* This file implements package and version control for Tcl via
* the "package" command and a few C APIs.
*
* Copyright (c) 1996 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
* SCCS: @(#) tclPkg.c 1.7 96/10/12 17:06:01
*/
#include "tclInt.h"
/*
* Each invocation of the "package ifneeded" command creates a structure
* of the following type, which is used to load the package into the
* interpreter if it is requested with a "package require" command.
*/
typedef struct PkgAvail {
* of the package. Malloc'ed and protected
* by Tcl_Preserve and Tcl_Release. */
* the same package. */
} PkgAvail;
/*
* For each package that is known in any way to an interpreter, there
* is one record of the following type. These records are stored in
* the "packageTable" hash table in the interpreter, keyed by
* package name such as "Tk" (no version number).
*/
typedef struct Package {
* interpreter via "package provide"
* (malloc'ed). NULL means the package doesn't
* exist in this interpreter yet. */
* of this package. */
} Package;
/*
* Prototypes for procedures defined in this file:
*/
char *string));
int *satPtr));
char *name));
/*
*----------------------------------------------------------------------
*
* Tcl_PkgProvide --
*
* This procedure is invoked to declare that a particular version
* of a particular package is now present in an interpreter. There
* must not be any other version of this package already
* provided in the interpreter.
*
* Results:
* Normally returns TCL_OK; if there is already another version
* of the package loaded then TCL_ERROR is returned and an error
* message is left in interp->result.
*
* Side effects:
* The interpreter remembers that this package is available,
* so that no other version of the package may be provided for
* the interpreter.
*
*----------------------------------------------------------------------
*/
int
* available. */
char *name; /* Name of package. */
char *version; /* Version string for package. */
{
return TCL_OK;
}
return TCL_OK;
}
return TCL_ERROR;
}
/*
*----------------------------------------------------------------------
*
* Tcl_PkgRequire --
*
* This procedure is called by code that depends on a particular
* version of a particular package. If the package is not already
* provided in the interpreter, this procedure invokes a Tcl script
* to provide it. If the package is already provided, this
* procedure makes sure that the caller's needs don't conflict with
* the version that is present.
*
* Results:
* If successful, returns the version string for the currently
* provided version of the package, which may be different from
* the "version" argument. If the caller's requirements
* cannot be met (e.g. the version requested conflicts with
* a currently provided version, or the required version cannot
* be found, or the script to provide the required version
* generates an error), NULL is returned and an error
* message is left in interp->result.
*
* Side effects:
* The script from some previous "package ifneeded" command may
* be invoked to provide the package.
*
*----------------------------------------------------------------------
*/
char *
* available. */
char *name; /* Name of desired package. */
char *version; /* Version string for desired version;
* NULL means use the latest version
* available. */
int exact; /* Non-zero means that only the particular
* version given is acceptable. Zero means
* use the latest compatible version. */
{
char *script;
/*
* It can take up to three passes to find the package: one pass to
* run the "package unknown" script, one to run the "package ifneeded"
* script for a specific version, and a final pass to lookup the
* package loaded by the "package ifneeded" script.
*/
break;
}
/*
* The package isn't yet present. Search the list of available
* versions and invoke the script for the best available version.
*/
continue;
}
&satisfies);
continue;
}
if (!satisfies) {
continue;
}
}
}
/*
* We found an ifneeded script for the package. Be careful while
* executing it: this could cause reentrancy, so (a) protect the
* script itself from deletion and (b) don't assume that bestPtr
* will still exist when the script completes.
*/
"\n (\"package ifneeded\" script)");
}
return NULL;
}
break;
}
/*
* Package not in the database. If there is a "package unknown"
* command, invoke it (but only on the first pass; after that,
* we should not get here in the first place).
*/
if (pass > 1) {
break;
}
-1);
if (exact) {
}
"\n (\"package unknown\" script)");
}
return NULL;
}
}
}
(char *) NULL);
}
return NULL;
}
/*
* At this point we now that the package is present. Make sure that the
* provided version meets the current requirement.
*/
}
}
(char *) NULL);
return NULL;
}
/*
*----------------------------------------------------------------------
*
* Tcl_PackageCmd --
*
* This procedure is invoked to process the "package" Tcl command.
* See the user documentation for details on what it does.
*
* Results:
* A standard Tcl result.
*
* Side effects:
* See the user documentation.
*
*----------------------------------------------------------------------
*/
/* ARGSUSED */
int
int argc; /* Number of arguments. */
char **argv; /* Argument strings. */
{
char *version;
if (argc < 2) {
" option ?arg arg ...?\"", (char *) NULL);
return TCL_ERROR;
}
c = argv[1][0];
for (i = 2; i < argc; i++) {
return TCL_OK;
}
}
}
}
" ifneeded package version ?script?\"", (char *) NULL);
return TCL_ERROR;
}
return TCL_ERROR;
}
if (argc == 4) {
return TCL_OK;
}
} else {
}
== 0) {
if (argc == 4) {
return TCL_OK;
}
break;
}
}
if (argc == 4) {
return TCL_OK;
}
} else {
}
}
if (argc != 2) {
" names\"", (char *) NULL);
return TCL_ERROR;
}
}
}
" provide package ?version?\"", (char *) NULL);
return TCL_ERROR;
}
if (argc == 3) {
}
}
return TCL_OK;
}
return TCL_ERROR;
}
if (argc < 3) {
" require ?-exact? package ?version?\"", (char *) NULL);
return TCL_ERROR;
}
exact = 1;
} else {
exact = 0;
}
return TCL_ERROR;
}
goto requireSyntax;
}
return TCL_ERROR;
}
if (argc == 2) {
}
} else if (argc == 3) {
}
if (argv[2][0] == 0) {
} else {
}
} else {
" unknown ?command?\"", (char *) NULL);
return TCL_ERROR;
}
&& (length >= 2)) {
if (argc != 4) {
" vcompare version1 version2\"", (char *) NULL);
return TCL_ERROR;
}
return TCL_ERROR;
}
(int *) NULL));
&& (length >= 2)) {
if (argc != 3) {
" versions package\"", (char *) NULL);
return TCL_ERROR;
}
}
}
&& (length >= 2)) {
if (argc != 4) {
" vsatisfies version1 version2\"", (char *) NULL);
return TCL_ERROR;
}
return TCL_ERROR;
}
} else {
"\": should be forget, ifneeded, names, ",
"provide, require, unknown, vcompare, ",
"versions, or vsatisfies", (char *) NULL);
return TCL_ERROR;
}
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* FindPackage --
*
* This procedure finds the Package record for a particular package
* in a particular interpreter, creating a record if one doesn't
* already exist.
*
* Results:
* The return value is a pointer to the Package record for the
* package.
*
* Side effects:
* A new Package record may be created.
*
*----------------------------------------------------------------------
*/
static Package *
char *name; /* Name of package to fine. */
{
int new;
if (new) {
} else {
}
return pkgPtr;
}
/*
*----------------------------------------------------------------------
*
* TclFreePackageInfo --
*
* This procedure is called during interpreter deletion to
* free all of the package-related information for the
* interpreter.
*
* Results:
* None.
*
* Side effects:
* Memory is freed.
*
*----------------------------------------------------------------------
*/
void
{
}
}
}
}
}
/*
*----------------------------------------------------------------------
*
* CheckVersion --
*
* This procedure checks to see whether a version number has
* valid syntax.
*
* Results:
* If string is a properly formed version number the TCL_OK
* is returned. Otherwise TCL_ERROR is returned and an error
* message is left in interp->result.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static int
char *string; /* Supposedly a version number, which is
* groups of decimal digits separated
* by dots. */
{
char *p = string;
goto error;
}
for (p++; *p != 0; p++) {
goto error;
}
}
if (p[-1] != '.') {
return TCL_OK;
}
return TCL_ERROR;
}
/*
*----------------------------------------------------------------------
*
* ComparePkgVersions --
*
* This procedure compares two version numbers.
*
* Results:
* The return value is -1 if v1 is less than v2, 0 if the two
* version numbers are the same, and 1 if v1 is greater than v2.
* If *satPtr is non-NULL, the word it points to is filled in
* with 1 if v2 >= v1 and both numbers have the same major number
* or 0 otherwise.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static int
* number of version numbers). */
int *satPtr; /* If non-null, the word pointed to is
* filled in with a 0/1 value. 1 means
* v1 "satisfies" v2: v1 is greater than
* or equal to v2 and both version numbers
* have the same major number. */
{
/*
* Each iteration of the following loop processes one number from
* each string, terminated by a ".". If those numbers don't match
* then the comparison is over; otherwise, we loop back for the
* next number.
*/
thisIsMajor = 1;
while (1) {
/*
* Parse one decimal number from the front of each string.
*/
v1++;
}
v2++;
}
/*
* Compare and go on to the next version number if the
* current numbers match.
*/
break;
}
if (*v1 != 0) {
v1++;
} else if (*v2 == 0) {
break;
}
if (*v2 != 0) {
v2++;
}
thisIsMajor = 0;
}
}
return 1;
return 0;
} else {
return -1;
}
}