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