home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / tcl / tclX6.5c / src / tclXdup.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-12-19  |  7.9 KB  |  267 lines
  1. /*
  2.  * tclXdup.c
  3.  *
  4.  * Extended Tcl dup command.
  5.  *-----------------------------------------------------------------------------
  6.  * Copyright 1992 Karl Lehenbauer and Mark Diekhans.
  7.  *
  8.  * Permission to use, copy, modify, and distribute this software and its
  9.  * documentation for any purpose and without fee is hereby granted, provided
  10.  * that the above copyright notice appear in all copies.  Karl Lehenbauer and
  11.  * Mark Diekhans make no representations about the suitability of this
  12.  * software for any purpose.  It is provided "as is" without express or
  13.  * implied warranty.
  14.  *-----------------------------------------------------------------------------
  15.  * $Id: tclXdup.c,v 2.0 1992/10/16 04:50:36 markd Rel $
  16.  *-----------------------------------------------------------------------------
  17.  */
  18.  
  19. #include "tclExtdInt.h"
  20.  
  21. /*
  22.  * Prototypes of internal functions.
  23.  */
  24. OpenFile *
  25. DoNormalDup _ANSI_ARGS_((Tcl_Interp *interp,
  26.                          OpenFile   *oldFilePtr));
  27.  
  28. OpenFile *
  29. DoSpecialDup _ANSI_ARGS_((Tcl_Interp *interp,
  30.                           OpenFile   *oldFilePtr,
  31.                           char       *newHandleName));
  32.  
  33.  
  34. /*
  35.  *-----------------------------------------------------------------------------
  36.  *
  37.  * DoNormalDup --
  38.  *   Process a normal dup command (i.e. the new file is not specified).
  39.  *
  40.  * Parameters:
  41.  *   o interp (I) - If an error occures, the error message is in result,
  42.  *     otherwise the file handle is in result.
  43.  *   o oldFilePtr (I) - Tcl file control block for the file to dup.
  44.  * Returns:
  45.  *   A pointer to the open file structure for the new file, or NULL if an
  46.  * error occured.
  47.  *-----------------------------------------------------------------------------
  48.  */
  49. static OpenFile *
  50. DoNormalDup (interp, oldFilePtr)
  51.     Tcl_Interp *interp;
  52.     OpenFile   *oldFilePtr;
  53. {
  54.     Interp   *iPtr = (Interp *) interp;
  55.     int       newFileId;
  56.     FILE     *newFileCbPtr;
  57.     char     *mode;
  58.  
  59.     newFileId = dup (fileno (oldFilePtr->f));
  60.     if (newFileId < 0)
  61.         goto unixError;
  62.  
  63.     if (Tcl_SetupFileEntry (interp, newFileId,
  64.                             oldFilePtr->readable,
  65.                             oldFilePtr->writable) != TCL_OK)
  66.         return NULL;
  67.  
  68.     sprintf (interp->result, "file%d", newFileId);
  69.     return iPtr->filePtrArray [newFileId];
  70.  
  71. unixError:
  72.     interp->result = Tcl_UnixError (interp);
  73.     return NULL;;
  74. }
  75.  
  76. /*
  77.  *-----------------------------------------------------------------------------
  78.  *
  79.  * DoSpecialDup --
  80.  *   Process a special dup command.  This is the case were the file is
  81.  *   dup-ed to stdin, stdout or stderr.  The new file may or be open or
  82.  *   closed
  83.  * Parameters:
  84.  *   o interp (I) - If an error occures, the error message is in result,
  85.  *     otherwise nothing is returned.
  86.  *   o oldFilePtr (I) - Tcl file control block for the file to dup.
  87.  *   o newFileHandle (I) - The handle name for the new file.
  88.  * Returns:
  89.  *   A pointer to the open file structure for the new file, or NULL if an
  90.  * error occured.
  91.  *-----------------------------------------------------------------------------
  92.  */
  93. static OpenFile *
  94. DoSpecialDup (interp, oldFilePtr, newHandleName)
  95.     Tcl_Interp *interp;
  96.     OpenFile   *oldFilePtr;
  97.     char       *newHandleName;
  98. {
  99.     Interp   *iPtr = (Interp *) interp;
  100.     int       newFileId;
  101.     FILE     *newFileCbPtr;
  102.     OpenFile *newFilePtr;
  103.  
  104.     /*
  105.      * Duplicate the old file to the specified file id.
  106.      */
  107.     newFileId = Tcl_ConvertFileHandle (interp, newHandleName);
  108.     if (newFileId < 0)
  109.         return NULL;
  110.     if (newFileId > 2) {
  111.         Tcl_AppendResult (interp, "target handle must be one of stdin, ",
  112.                           "stdout, stderr, file0, file1, or file2: got \"",
  113.                           newHandleName, "\"", (char *) NULL);
  114.         return NULL;
  115.     }
  116.     switch (newFileId) {
  117.         case 0: 
  118.             newFileCbPtr = stdin;
  119.             break;
  120.         case 1: 
  121.             newFileCbPtr = stdout;
  122.             break;
  123.         case 2: 
  124.             newFileCbPtr = stderr;
  125.             break;
  126.     }
  127.  
  128.     /*
  129.      * If the specified id is not open, set up a stdio file descriptor.
  130.      */
  131.     TclMakeFileTable (iPtr, newFileId);
  132.     if (iPtr->filePtrArray [newFileId] == NULL) {
  133.         char *mode;
  134.  
  135.         /*
  136.          * Set up a stdio FILE control block for the new file.
  137.          */
  138.         if (oldFilePtr->readable && oldFilePtr->writable) {
  139.             mode = "r+";
  140.         } else if (oldFilePtr->writable) {
  141.             mode = "w";
  142.         } else {
  143.             mode = "r";
  144.         }
  145.         if (freopen ("/dev/null", mode, newFileCbPtr) == NULL)
  146.             goto unixError;
  147.     }
  148.     
  149.     /*
  150.      * This functionallity may be obtained with dup2 on most systems.  Being
  151.      * open is optional.
  152.      */
  153.     close (newFileId);
  154.     if (fcntl (fileno (oldFilePtr->f), F_DUPFD, newFileId) < 0)
  155.         goto unixError;
  156.  
  157.     /*
  158.      * Set up a Tcl OpenFile structure for the new file handle.
  159.      */
  160.     newFilePtr = iPtr->filePtrArray [fileno (newFileCbPtr)];
  161.     if (newFilePtr == NULL) {
  162.         newFilePtr = (OpenFile*) ckalloc (sizeof (OpenFile));
  163.         iPtr->filePtrArray [fileno (newFileCbPtr)] = newFilePtr;
  164.     }
  165.     newFilePtr->f        = newFileCbPtr;
  166.     newFilePtr->f2       = NULL;
  167.     newFilePtr->readable = oldFilePtr->readable;
  168.     newFilePtr->writable = oldFilePtr->writable;
  169.     newFilePtr->numPids  = 0;
  170.     newFilePtr->pidPtr   = NULL;
  171.     newFilePtr->errorId  = -1;
  172.  
  173.     return newFilePtr;
  174.  
  175. unixError:
  176.     iPtr->result = Tcl_UnixError (interp);
  177.     return NULL;
  178. }
  179.  
  180. /*
  181.  *-----------------------------------------------------------------------------
  182.  *
  183.  * Tcl_DupCmd --
  184.  *     Implements the dup TCL command:
  185.  *         dup filehandle [stdhandle]
  186.  *
  187.  * Results:
  188.  *      Returns TCL_OK and interp->result containing a filehandle
  189.  *      if the requested file or pipe was successfully duplicated.
  190.  *
  191.  *      Return TCL_ERROR and interp->result containing an
  192.  *      explanation of what went wrong if an error occured.
  193.  *
  194.  * Side effects:
  195.  *      Locates and creates an entry in the handles table
  196.  *
  197.  *-----------------------------------------------------------------------------
  198.  */
  199. int
  200. Tcl_DupCmd (clientData, interp, argc, argv)
  201.     ClientData  clientData;
  202.     Tcl_Interp *interp;
  203.     int         argc;
  204.     char      **argv;
  205. {
  206.     OpenFile *oldFilePtr, *newFilePtr;
  207.     long      seekOffset = -1;
  208.  
  209.     if ((argc < 2) || (argc > 3)) {
  210.         Tcl_AppendResult (interp, tclXWrongArgs, argv[0], 
  211.                           " filehandle [stdhandle]", (char *) NULL);
  212.         return TCL_ERROR;
  213.     }
  214.  
  215.     if (TclGetOpenFile(interp, argv[1], &oldFilePtr) != TCL_OK)
  216.     return TCL_ERROR;
  217.     if (oldFilePtr->numPids > 0) { /*??????*/
  218.         Tcl_AppendResult (interp, "can not `dup' a pipeline", (char *) NULL);
  219.         return TCL_ERROR;
  220.     }
  221.  
  222.     /*
  223.      * If writable, flush out the buffer.  If readable, remember were we are
  224.      * so the we can set it up for the next stdio read to come from the same
  225.      * place.  The location is only recorded if the file is a reqular file,
  226.      * since you cann't seek on other types of files.
  227.      */
  228.     if (oldFilePtr->writable) {
  229.         if (fflush (oldFilePtr->f) != 0)
  230.             goto unixError;
  231.     }
  232.     if (oldFilePtr->readable) {
  233.         struct stat statBuf;
  234.         
  235.         if (fstat (fileno (oldFilePtr->f), &statBuf) < 0)
  236.             goto unixError;
  237.         if ((statBuf.st_mode & S_IFMT) == S_IFREG) {
  238.             seekOffset = ftell (oldFilePtr->f);
  239.             if (seekOffset < 0)
  240.                 goto unixError;
  241.         }
  242.     }
  243.  
  244.     /*
  245.      * Process the dup depending on if dup-ing to a new file or a target
  246.      * file handle.
  247.      */
  248.     if (argc == 2)
  249.         newFilePtr = DoNormalDup (interp, oldFilePtr);
  250.     else
  251.         newFilePtr = DoSpecialDup (interp, oldFilePtr, argv [2]);
  252.  
  253.     if (newFilePtr == NULL)
  254.         return TCL_ERROR;
  255.  
  256.     if (seekOffset >= 0) {
  257.         if (fseek (newFilePtr->f, seekOffset, SEEK_SET) != 0)
  258.             goto unixError;
  259.     }
  260.     return TCL_OK;
  261.  
  262. unixError:
  263.     Tcl_ResetResult (interp);
  264.     interp->result = Tcl_UnixError (interp);
  265.     return TCL_ERROR;
  266. }
  267.