home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / tcl2-73c.zip / tcl7.3 / tclglob.c < prev    next >
C/C++ Source or Header  |  1994-03-16  |  14KB  |  466 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.  
  124.     if ((stat(dirName, &statBuf) != 0) || !S_ISDIR(statBuf.st_mode)) {
  125.     return TCL_OK;
  126.     }
  127.     Tcl_DStringInit(&newName);
  128.  
  129.     /*
  130.      * First, find the end of the next element in rem, checking
  131.      * along the way for special globbing characters.
  132.      */
  133.  
  134.     gotSpecial = 0;
  135.     openBrace = closeBrace = NULL;
  136.     for (p = rem; ; p++) {
  137.     c = *p;
  138.     if ((c == '\0') || ((openBrace == NULL) && (c == '/'))) {
  139.         break;
  140.     }
  141.     if ((c == '{') && (openBrace == NULL)) {
  142.         openBrace = p;
  143.     }
  144.     if ((c == '}') && (openBrace != NULL) && (closeBrace == NULL)) {
  145.         closeBrace = p;
  146.     }
  147.     if ((c == '*') || (c == '[') || (c == '\\') || (c == '?')) {
  148.         gotSpecial = 1;
  149.     }
  150.     }
  151.  
  152.     /*
  153.      * If there is an open brace in the argument, then make a recursive
  154.      * call for each element between the braces.  In this case, the
  155.      * recursive call to DoGlob uses the same "dir" that we got.
  156.      * If there are several brace-pairs in a single name, we just handle
  157.      * one here, and the others will be handled in recursive calls.
  158.      */
  159.  
  160.     if (openBrace != NULL) {
  161.     char *element;
  162.  
  163.     if (closeBrace == NULL) {
  164.         Tcl_ResetResult(interp);
  165.         interp->result = "unmatched open-brace in file name";
  166.         result = TCL_ERROR;
  167.         goto done;
  168.     }
  169.     Tcl_DStringAppend(&newName, rem, openBrace-rem);
  170.     baseLength = newName.length;
  171.     for (p = openBrace; *p != '}'; ) {
  172.         element = p+1;
  173.         for (p = element; ((*p != '}') && (*p != ',')); p++) {
  174.         /* Empty loop body. */
  175.         }
  176.         Tcl_DStringAppend(&newName, element, p-element);
  177.         Tcl_DStringAppend(&newName, closeBrace+1, -1);
  178.         result = DoGlob(interp, dir, newName.string);
  179.         if (result != TCL_OK) {
  180.         goto done;
  181.         }
  182.         newName.length = baseLength;
  183.     }
  184.     goto done;
  185.     }
  186.  
  187.     /*
  188.      * Start building up the next-level name with dir plus a slash if
  189.      * needed to separate it from the next file name.
  190.      */
  191.  
  192.     Tcl_DStringAppend(&newName, dir, -1);
  193.     if ((dir[0] != 0) && (newName.string[newName.length-1] != '/')) {
  194.     Tcl_DStringAppend(&newName, "/", 1);
  195.     }
  196.     baseLength = newName.length;
  197.  
  198.     /*
  199.      * If there were any pattern-matching characters, then scan through
  200.      * the directory to find all the matching names.
  201.      */
  202.  
  203.     if (gotSpecial) {
  204.     DIR *d;
  205.     struct dirent *entryPtr;
  206.     char savedChar;
  207.  
  208.     d = opendir(dirName);
  209.     if (d == NULL) {
  210.         Tcl_ResetResult(interp);
  211.         Tcl_AppendResult(interp, "couldn't read directory \"",
  212.             dirName, "\": ", Tcl_PosixError(interp), (char *) NULL);
  213.         result = TCL_ERROR;
  214.         goto done;
  215.     }
  216.  
  217.     /*
  218.      * Temporarily store a null into rem so that the pattern string
  219.      * is now null-terminated.
  220.      */
  221.  
  222.     savedChar = *p;
  223.     *p = 0;
  224.  
  225.     while (1) {
  226.         entryPtr = readdir(d);
  227.         if (entryPtr == NULL) {
  228.         break;
  229.         }
  230.  
  231.         /*
  232.          * Don't match names starting with "." unless the "." is
  233.          * present in the pattern.
  234.          */
  235.  
  236.         if ((*entryPtr->d_name == '.') && (*rem != '.')) {
  237.         continue;
  238.         }
  239.         if (Tcl_StringMatch(entryPtr->d_name, rem)) {
  240.         newName.length = baseLength;
  241.         Tcl_DStringAppend(&newName, entryPtr->d_name, -1);
  242.         if (savedChar == 0) {
  243.             Tcl_AppendElement(interp, newName.string);
  244.         } else {
  245.             result = DoGlob(interp, newName.string, p+1);
  246.             if (result != TCL_OK) {
  247.             break;
  248.             }
  249.         }
  250.         }
  251.     }
  252.     closedir(d);
  253.     *p = savedChar;
  254.     goto done;
  255.     }
  256.  
  257.     /*
  258.      * The current element is a simple one with no fancy features.  Add
  259.      * it to the new name.  If there are more elements still to come,
  260.      * then recurse to process them.
  261.      */
  262.  
  263.     Tcl_DStringAppend(&newName, rem, p-rem);
  264.     if (*p != 0) {
  265.     result = DoGlob(interp, newName.string, p+1);
  266.     goto done;
  267.     }
  268.  
  269.     /*
  270.      * There are no more elements in the pattern.  Check to be sure the
  271.      * file actually exists, then add its name to the list being formed
  272.      * in interp-result.
  273.      */
  274.  
  275.     name = newName.string;
  276.     if (*name == 0) {
  277.     name = ".";
  278.     }
  279.     if (access(name, F_OK) != 0) {
  280.     goto done;
  281.     }
  282.     Tcl_AppendElement(interp, name);
  283.  
  284.     done:
  285.     Tcl_DStringFree(&newName);
  286.     return result;
  287. }
  288.  
  289. /*
  290.  *----------------------------------------------------------------------
  291.  *
  292.  * Tcl_TildeSubst --
  293.  *
  294.  *    Given a name starting with a tilde, produce a name where
  295.  *    the tilde and following characters have been replaced by
  296.  *    the home directory location for the named user.
  297.  *
  298.  * Results:
  299.  *    The result is a pointer to a static string containing
  300.  *    the new name.  If there was an error in processing the
  301.  *    tilde, then an error message is left in interp->result
  302.  *    and the return value is NULL.  The result may be stored
  303.  *    in bufferPtr; the caller must call Tcl_DStringFree(bufferPtr)
  304.  *    to free the name.
  305.  *
  306.  * Side effects:
  307.  *    Information may be left in bufferPtr.
  308.  *
  309.  *----------------------------------------------------------------------
  310.  */
  311.  
  312. char *
  313. Tcl_TildeSubst(interp, name, bufferPtr)
  314.     Tcl_Interp *interp;        /* Interpreter in which to store error
  315.                  * message (if necessary). */
  316.     char *name;            /* File name, which may begin with "~/"
  317.                  * (to indicate current user's home directory)
  318.                  * or "~<user>/" (to indicate any user's
  319.                  * home directory). */
  320.     Tcl_DString *bufferPtr;    /* May be used to hold result.  Must not hold
  321.                  * anything at the time of the call, and need
  322.                  * not even be initialized. */
  323. {
  324.     char *dir;
  325.     register char *p;
  326.  
  327.     Tcl_DStringInit(bufferPtr);
  328.     if (name[0] != '~') {
  329.     return name;
  330.     }
  331.  
  332.     if ((name[1] == '/') || (name[1] == '\0')) {
  333.     dir = getenv("HOME");
  334.     if (dir == NULL) {
  335.         Tcl_ResetResult(interp);
  336.         Tcl_AppendResult(interp, "couldn't find HOME environment ",
  337.             "variable to expand \"", name, "\"", (char *) NULL);
  338.         return NULL;
  339.     }
  340.     Tcl_DStringAppend(bufferPtr, dir, -1);
  341.     Tcl_DStringAppend(bufferPtr, name+1, -1);
  342.     } else {
  343.  
  344. #ifndef __OS2__
  345.     struct passwd *pwPtr;
  346.  
  347.     for (p = &name[1]; (*p != 0) && (*p != '/'); p++) {
  348.         /* Null body;  just find end of name. */
  349.     }
  350.     Tcl_DStringAppend(bufferPtr, name+1, p - (name+1));
  351.     pwPtr = getpwnam(bufferPtr->string);
  352.     if (pwPtr == NULL) {
  353.         endpwent();
  354.         Tcl_ResetResult(interp);
  355.         Tcl_AppendResult(interp, "user \"", bufferPtr->string,
  356.             "\" doesn't exist", (char *) NULL);
  357.         return NULL;
  358.     }
  359.     Tcl_DStringFree(bufferPtr);
  360.     Tcl_DStringAppend(bufferPtr, pwPtr->pw_dir, -1);
  361.     Tcl_DStringAppend(bufferPtr, p, -1);
  362.     endpwent();
  363. #endif
  364.     }
  365.     return bufferPtr->string;
  366. }
  367.  
  368. /*
  369.  *----------------------------------------------------------------------
  370.  *
  371.  * Tcl_GlobCmd --
  372.  *
  373.  *    This procedure is invoked to process the "glob" Tcl command.
  374.  *    See the user documentation for details on what it does.
  375.  *
  376.  * Results:
  377.  *    A standard Tcl result.
  378.  *
  379.  * Side effects:
  380.  *    See the user documentation.
  381.  *
  382.  *----------------------------------------------------------------------
  383.  */
  384.  
  385.     /* ARGSUSED */
  386. int
  387. Tcl_GlobCmd(dummy, interp, argc, argv)
  388.     ClientData dummy;            /* Not used. */
  389.     Tcl_Interp *interp;            /* Current interpreter. */
  390.     int argc;                /* Number of arguments. */
  391.     char **argv;            /* Argument strings. */
  392. {
  393. #ifdef FOO__OS2__
  394.   Tcl_AppendResult(interp, argv[0], " not supported under os/2",
  395.            (char *) NULL);
  396.   return TCL_ERROR;
  397. #else
  398.     int i, result, noComplain, firstArg;
  399.  
  400.     if (argc < 2) {
  401.     notEnoughArgs:
  402.     Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  403.         " ?switches? name ?name ...?\"", (char *) NULL);
  404.     return TCL_ERROR;
  405.     }
  406.     noComplain = 0;
  407.     for (firstArg = 1; (firstArg < argc) && (argv[firstArg][0] == '-');
  408.         firstArg++) {
  409.     if (strcmp(argv[firstArg], "-nocomplain") == 0) {
  410.         noComplain = 1;
  411.     } else if (strcmp(argv[firstArg], "--") == 0) {
  412.         firstArg++;
  413.         break;
  414.     } else {
  415.         Tcl_AppendResult(interp, "bad switch \"", argv[firstArg],
  416.             "\": must be -nocomplain or --", (char *) NULL);
  417.         return TCL_ERROR;
  418.     }
  419.     }
  420.     if (firstArg >= argc) {
  421.     goto notEnoughArgs;
  422.     }
  423.  
  424.     for (i = firstArg; i < argc; i++) {
  425.     char *thisName;
  426.     Tcl_DString buffer;
  427.  
  428.     thisName = Tcl_TildeSubst(interp, argv[i], &buffer);
  429.     if (thisName == NULL) {
  430.         return TCL_ERROR;
  431.     }
  432.     if (*thisName == '/') {
  433.         if (thisName[1] == '/') {
  434.         /*
  435.          * This is a special hack for systems like those from Apollo
  436.          * where there is a super-root at "//":  need to treat the
  437.          * double-slash as a single name.
  438.          */
  439.         result = DoGlob(interp, "//", thisName+2);
  440.         } else {
  441.         result = DoGlob(interp, "/", thisName+1);
  442.         }
  443.     } else {
  444.         result = DoGlob(interp, "", thisName);
  445.     }
  446.     Tcl_DStringFree(&buffer);
  447.     if (result != TCL_OK) {
  448.         return result;
  449.     }
  450.     }
  451.     if ((*interp->result == 0) && !noComplain) {
  452.     char *sep = "";
  453.  
  454.     Tcl_AppendResult(interp, "no files matched glob pattern",
  455.         (argc == 2) ? " \"" : "s \"", (char *) NULL);
  456.     for (i = firstArg; i < argc; i++) {
  457.         Tcl_AppendResult(interp, sep, argv[i], (char *) NULL);
  458.         sep = " ";
  459.     }
  460.     Tcl_AppendResult(interp, "\"", (char *) NULL);
  461.     return TCL_ERROR;
  462.     }
  463.     return TCL_OK;
  464. #endif
  465. }
  466.