home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / tkisrc04.zip / tcl / os2 / tclGlob.c < prev    next >
C/C++ Source or Header  |  1998-08-07  |  12KB  |  439 lines
  1. /* 
  2.  * tclGlob.c --
  3.  *
  4.  *    This file provides procedures and commands for file name
  5.  *    manipulation, such as tilde expansion and globbing.
  6.  *
  7.  * Copyright (c) 1990-1994 The Regents of the University of California.
  8.  * Copyright (c) 1994 Sun Microsystems, Inc.
  9.  *
  10.  * See the file "license.terms" for information on usage and redistribution
  11.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  12.  */
  13.  
  14. #ifndef lint
  15. static char sccsid[] = "@(#) tclGlob.c 1.44 95/09/11 20:11:56";
  16. #endif /* not lint */
  17.  
  18. #include "tclInt.h"
  19. #include "tclPort.h"
  20.  
  21. /*
  22.  * Declarations for procedures local to this file:
  23.  */
  24.  
  25. static int        DoGlob _ANSI_ARGS_((Tcl_Interp *interp, char *dir,
  26.                 char *rem));
  27.  
  28. /*
  29.  *----------------------------------------------------------------------
  30.  *
  31.  * DoGlob --
  32.  *
  33.  *    This recursive procedure forms the heart of the globbing
  34.  *    code.  It performs a depth-first traversal of the tree
  35.  *    given by the path name to be globbed.
  36.  *
  37.  * Results:
  38.  *    The return value is a standard Tcl result indicating whether
  39.  *    an error occurred in globbing.  After a normal return the
  40.  *    result in interp will be set to hold all of the file names
  41.  *    given by the dir and rem arguments.  After an error the
  42.  *    result in interp will hold an error message.
  43.  *
  44.  * Side effects:
  45.  *    None.
  46.  *
  47.  *----------------------------------------------------------------------
  48.  */
  49.  
  50. static int
  51. DoGlob(interp, dir, rem)
  52.     Tcl_Interp *interp;            /* Interpreter to use for error
  53.                      * reporting (e.g. unmatched brace). */
  54.     char *dir;                /* Name of a directory at which to
  55.                      * start glob expansion.  This name
  56.                      * is fixed: it doesn't contain any
  57.                      * globbing chars. */
  58.     char *rem;                /* Path to glob-expand. */
  59. {
  60.     /*
  61.      * When this procedure is entered, the name to be globbed may
  62.      * already have been partly expanded by ancestor invocations of
  63.      * DoGlob.  The part that's already been expanded is in "dir"
  64.      * (this may initially be empty), and the part still to expand
  65.      * is in "rem".  This procedure expands "rem" one level, making
  66.      * recursive calls to itself if there's still more stuff left
  67.      * in the remainder.
  68.      */
  69.  
  70.     Tcl_DString newName;        /* Holds new name consisting of
  71.                      * dir plus the first part of rem. */
  72.     register char *p;
  73.     register char c;
  74.     char *openBrace, *closeBrace, *name, *dirName;
  75.     int gotSpecial, baseLength;
  76.     int result = TCL_OK;
  77.     struct stat statBuf;
  78.  
  79.     /*
  80.      * Make sure that the directory part of the name really is a
  81.      * directory.  If the directory name is "", use the name "."
  82.      * instead, because some UNIX systems don't treat "" like "."
  83.      * automatically. Keep the "" for use in generating file names,
  84.      * otherwise "glob foo.c" would return "./foo.c".
  85.      */
  86.  
  87.     if (*dir == '\0') {
  88.     dirName = ".";
  89.     } else {
  90.     dirName = dir;
  91.     }
  92.     if ((stat(dirName, &statBuf) != 0) || !S_ISDIR(statBuf.st_mode)) {
  93.     return TCL_OK;
  94.     }
  95.     Tcl_DStringInit(&newName);
  96.  
  97.     /*
  98.      * First, find the end of the next element in rem, checking
  99.      * along the way for special globbing characters.
  100.      */
  101.  
  102.     gotSpecial = 0;
  103.     openBrace = closeBrace = NULL;
  104.     for (p = rem; ; p++) {
  105.     c = *p;
  106.     if ((c == '\0') || ((openBrace == NULL) && (c == '/'))) {
  107.         break;
  108.     }
  109.     if ((c == '{') && (openBrace == NULL)) {
  110.         openBrace = p;
  111.     }
  112.     if ((c == '}') && (openBrace != NULL) && (closeBrace == NULL)) {
  113.         closeBrace = p;
  114.     }
  115.     if ((c == '*') || (c == '[') || (c == '\\') || (c == '?')) {
  116.         gotSpecial = 1;
  117.     }
  118.     }
  119.  
  120.     /*
  121.      * If there is an open brace in the argument, then make a recursive
  122.      * call for each element between the braces.  In this case, the
  123.      * recursive call to DoGlob uses the same "dir" that we got.
  124.      * If there are several brace-pairs in a single name, we just handle
  125.      * one here, and the others will be handled in recursive calls.
  126.      */
  127.  
  128.     if (openBrace != NULL) {
  129.     char *element;
  130.  
  131.     if (closeBrace == NULL) {
  132.         Tcl_ResetResult(interp);
  133.         interp->result = "unmatched open-brace in file name";
  134.         result = TCL_ERROR;
  135.         goto done;
  136.     }
  137.     Tcl_DStringAppend(&newName, rem, openBrace-rem);
  138.     baseLength = newName.length;
  139.     for (p = openBrace; *p != '}'; ) {
  140.         element = p+1;
  141.         for (p = element; ((*p != '}') && (*p != ',')); p++) {
  142.         /* Empty loop body. */
  143.         }
  144.         Tcl_DStringAppend(&newName, element, p-element);
  145.         Tcl_DStringAppend(&newName, closeBrace+1, -1);
  146.         result = DoGlob(interp, dir, newName.string);
  147.         if (result != TCL_OK) {
  148.         goto done;
  149.         }
  150.         newName.length = baseLength;
  151.     }
  152.     goto done;
  153.     }
  154.  
  155.     /*
  156.      * Start building up the next-level name with dir plus a slash if
  157.      * needed to separate it from the next file name.
  158.      */
  159.  
  160.     Tcl_DStringAppend(&newName, dir, -1);
  161.     if ((dir[0] != 0) && (newName.string[newName.length-1] != '/')) {
  162.     Tcl_DStringAppend(&newName, "/", 1);
  163.     }
  164.     baseLength = newName.length;
  165.  
  166.     /*
  167.      * If there were any pattern-matching characters, then scan through
  168.      * the directory to find all the matching names.
  169.      */
  170.  
  171.     if (gotSpecial) {
  172.     DIR *d;
  173.     struct dirent *entryPtr;
  174.     char savedChar;
  175.  
  176.     d = opendir(dirName);
  177.     if (d == NULL) {
  178.         Tcl_ResetResult(interp);
  179.         Tcl_AppendResult(interp, "couldn't read directory \"",
  180.             dirName, "\": ", Tcl_PosixError(interp), (char *) NULL);
  181.         result = TCL_ERROR;
  182.         goto done;
  183.     }
  184.  
  185.     /*
  186.      * Temporarily store a null into rem so that the pattern string
  187.      * is now null-terminated.
  188.      */
  189.  
  190.     savedChar = *p;
  191.     *p = 0;
  192.  
  193.     while (1) {
  194.         entryPtr = readdir(d);
  195.         if (entryPtr == NULL) {
  196.         break;
  197.         }
  198.  
  199.         /*
  200.          * Don't match names starting with "." unless the "." is
  201.          * present in the pattern.
  202.          */
  203.  
  204.         if ((*entryPtr->d_name == '.') && (*rem != '.')) {
  205.         continue;
  206.         }
  207.         if (Tcl_StringMatch(entryPtr->d_name, rem)) {
  208.         newName.length = baseLength;
  209.         Tcl_DStringAppend(&newName, entryPtr->d_name, -1);
  210.         if (savedChar == 0) {
  211.             Tcl_AppendElement(interp, newName.string);
  212.         } else {
  213.             result = DoGlob(interp, newName.string, p+1);
  214.             if (result != TCL_OK) {
  215.             break;
  216.             }
  217.         }
  218.         }
  219.     }
  220.     closedir(d);
  221.     *p = savedChar;
  222.     goto done;
  223.     }
  224.  
  225.     /*
  226.      * The current element is a simple one with no fancy features.  Add
  227.      * it to the new name.  If there are more elements still to come,
  228.      * then recurse to process them.
  229.      */
  230.  
  231.     Tcl_DStringAppend(&newName, rem, p-rem);
  232.     if (*p != 0) {
  233.     result = DoGlob(interp, newName.string, p+1);
  234.     goto done;
  235.     }
  236.  
  237.     /*
  238.      * There are no more elements in the pattern.  Check to be sure the
  239.      * file actually exists, then add its name to the list being formed
  240.      * in interp-result.
  241.      */
  242.  
  243.     name = newName.string;
  244.     if (*name == 0) {
  245.     name = ".";
  246.     }
  247.     if (access(name, F_OK) != 0) {
  248.     goto done;
  249.     }
  250.     Tcl_AppendElement(interp, name);
  251.  
  252.     done:
  253.     Tcl_DStringFree(&newName);
  254.     return result;
  255. }
  256.  
  257. /*
  258.  *----------------------------------------------------------------------
  259.  *
  260.  * Tcl_TildeSubst --
  261.  *
  262.  *    Given a name starting with a tilde, produce a name where
  263.  *    the tilde and following characters have been replaced by
  264.  *    the home directory location for the named user.
  265.  *
  266.  * Results:
  267.  *    The result is a pointer to a static string containing
  268.  *    the new name.  If there was an error in processing the
  269.  *    tilde, then an error message is left in interp->result
  270.  *    and the return value is NULL.  The result may be stored
  271.  *    in bufferPtr; the caller must call Tcl_DStringFree(bufferPtr)
  272.  *    to free the name.
  273.  *
  274.  * Side effects:
  275.  *    Information may be left in bufferPtr.
  276.  *
  277.  *----------------------------------------------------------------------
  278.  */
  279.  
  280. char *
  281. Tcl_TildeSubst(interp, name, bufferPtr)
  282.     Tcl_Interp *interp;        /* Interpreter in which to store error
  283.                  * message (if necessary). */
  284.     char *name;            /* File name, which may begin with "~/"
  285.                  * (to indicate current user's home directory)
  286.                  * or "~<user>/" (to indicate any user's
  287.                  * home directory). */
  288.     Tcl_DString *bufferPtr;    /* May be used to hold result.  Must not hold
  289.                  * anything at the time of the call, and need
  290.                  * not even be initialized. */
  291. {
  292.     char *dir;
  293.     register char *p;
  294.  
  295.     Tcl_DStringInit(bufferPtr);
  296.     if (name[0] != '~') {
  297.     return name;
  298.     }
  299.  
  300.     if ((name[1] == '/') || (name[1] == '\0')) {
  301.     dir = getenv("HOME");
  302.     if (dir == NULL) {
  303.         Tcl_ResetResult(interp);
  304.         Tcl_AppendResult(interp, "couldn't find HOME environment ",
  305.             "variable to expand \"", name, "\"", (char *) NULL);
  306.         return NULL;
  307.     }
  308.     Tcl_DStringAppend(bufferPtr, dir, -1);
  309.     Tcl_DStringAppend(bufferPtr, name+1, -1);
  310.     } else {
  311. #if (defined _Windows) || (defined __EMX__) || (defined __OS2__)
  312.     Tcl_ResetResult(interp);
  313.     Tcl_AppendResult(interp, "user \"", bufferPtr->string,
  314.         "\" doesn't exist", (char *) NULL);
  315.     Tcl_DStringFree(bufferPtr);
  316.     return NULL;
  317. #else
  318.     struct passwd *pwPtr;
  319.  
  320.     for (p = &name[1]; (*p != 0) && (*p != '/'); p++) {
  321.         /* Null body;  just find end of name. */
  322.     }
  323.     Tcl_DStringAppend(bufferPtr, name+1, p - (name+1));
  324.     pwPtr = getpwnam(bufferPtr->string);
  325.     if (pwPtr == NULL) {
  326.         endpwent();
  327.         Tcl_ResetResult(interp);
  328.         Tcl_AppendResult(interp, "user \"", bufferPtr->string,
  329.             "\" doesn't exist", (char *) NULL);
  330.         Tcl_DStringFree(bufferPtr);
  331.         return NULL;
  332.     }
  333.     Tcl_DStringFree(bufferPtr);
  334.     Tcl_DStringAppend(bufferPtr, pwPtr->pw_dir, -1);
  335.     Tcl_DStringAppend(bufferPtr, p, -1);
  336.     endpwent();
  337. #endif
  338.     }
  339.     return bufferPtr->string;
  340. }
  341.  
  342. /*
  343.  *----------------------------------------------------------------------
  344.  *
  345.  * Tcl_GlobCmd --
  346.  *
  347.  *    This procedure is invoked to process the "glob" Tcl command.
  348.  *    See the user documentation for details on what it does.
  349.  *
  350.  * Results:
  351.  *    A standard Tcl result.
  352.  *
  353.  * Side effects:
  354.  *    See the user documentation.
  355.  *
  356.  *----------------------------------------------------------------------
  357.  */
  358.  
  359.     /* ARGSUSED */
  360. int
  361. Tcl_GlobCmd(dummy, interp, argc, argv)
  362.     ClientData dummy;            /* Not used. */
  363.     Tcl_Interp *interp;            /* Current interpreter. */
  364.     int argc;                /* Number of arguments. */
  365.     char **argv;            /* Argument strings. */
  366. {
  367.     int i, result, noComplain, firstArg;
  368.  
  369.     if (argc < 2) {
  370.     notEnoughArgs:
  371.     Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  372.         " ?switches? name ?name ...?\"", (char *) NULL);
  373.     return TCL_ERROR;
  374.     }
  375.     noComplain = 0;
  376.     for (firstArg = 1; (firstArg < argc) && (argv[firstArg][0] == '-');
  377.         firstArg++) {
  378.     if (strcmp(argv[firstArg], "-nocomplain") == 0) {
  379.         noComplain = 1;
  380.     } else if (strcmp(argv[firstArg], "--") == 0) {
  381.         firstArg++;
  382.         break;
  383.     } else {
  384.         Tcl_AppendResult(interp, "bad switch \"", argv[firstArg],
  385.             "\": must be -nocomplain or --", (char *) NULL);
  386.         return TCL_ERROR;
  387.     }
  388.     }
  389.     if (firstArg >= argc) {
  390.     goto notEnoughArgs;
  391.     }
  392.  
  393.     for (i = firstArg; i < argc; i++) {
  394.     char *thisName;
  395.     Tcl_DString buffer;
  396.  
  397.     thisName = Tcl_TildeSubst(interp, argv[i], &buffer);
  398.     if (thisName == NULL) {
  399.         if (noComplain) {
  400.         Tcl_ResetResult(interp);
  401.         continue;
  402.         } else {
  403.         return TCL_ERROR;
  404.         }
  405.     }
  406.     if (*thisName == '/') {
  407.         if (thisName[1] == '/') {
  408.         /*
  409.          * This is a special hack for systems like those from Apollo
  410.          * where there is a super-root at "//":  need to treat the
  411.          * double-slash as a single name.
  412.          */
  413.         result = DoGlob(interp, "//", thisName+2);
  414.         } else {
  415.         result = DoGlob(interp, "/", thisName+1);
  416.         }
  417.     } else {
  418.         result = DoGlob(interp, "", thisName);
  419.     }
  420.     Tcl_DStringFree(&buffer);
  421.     if (result != TCL_OK) {
  422.         return result;
  423.     }
  424.     }
  425.     if ((*interp->result == 0) && !noComplain) {
  426.     char *sep = "";
  427.  
  428.     Tcl_AppendResult(interp, "no files matched glob pattern",
  429.         (argc == 2) ? " \"" : "s \"", (char *) NULL);
  430.     for (i = firstArg; i < argc; i++) {
  431.         Tcl_AppendResult(interp, sep, argv[i], (char *) NULL);
  432.         sep = " ";
  433.     }
  434.     Tcl_AppendResult(interp, "\"", (char *) NULL);
  435.     return TCL_ERROR;
  436.     }
  437.     return TCL_OK;
  438. }
  439.