home *** CD-ROM | disk | FTP | other *** search
/ ftp.mactech.com 2010 / ftp.mactech.com.tar / ftp.mactech.com / online / source / c / compilers / Tickle-4.0.sit.hqx / Tickle-4.0 / src / tcl-dbm.c < prev    next >
Text File  |  1993-11-19  |  10KB  |  479 lines
  1.  
  2. /*
  3. ** This source code was written by Tim Endres
  4. ** Email: time@ice.com.
  5. ** USMail: 8840 Main Street, Whitmore Lake, MI  48189
  6. **
  7. ** Some portions of this application utilize sources
  8. ** that are copyrighted by ICE Engineering, Inc., and
  9. ** ICE Engineering retains all rights to those sources.
  10. **
  11. ** Neither ICE Engineering, Inc., nor Tim Endres, 
  12. ** warrants this source code for any reason, and neither
  13. ** party assumes any responsbility for the use of these
  14. ** sources, libraries, or applications. The user of these
  15. ** sources and binaries assumes all responsbilities for
  16. ** any resulting consequences.
  17. */
  18.  
  19.  
  20. #pragma segment TCLDBM
  21.  
  22. #include "tickle.h"
  23. #include "tcl.h"
  24.  
  25. #include "sdbm.h"
  26.  
  27. extern int errno;
  28. extern int macintoshErr;
  29.  
  30. typedef struct {
  31.     DBM        *dbm;
  32.     char    name[32];
  33.     } DBM_NAMED_DB;
  34.  
  35. #define MAX_DBMS    8
  36.  
  37. DBM_NAMED_DB    _dbms_[MAX_DBMS];
  38.  
  39.  
  40. init_tcl_dbm()
  41.     {
  42.     int        i;
  43.     
  44.     for (i=0; i<MAX_DBMS; ++i)
  45.         {
  46.         _dbms_[i].dbm = (DBM *)0;
  47.         _dbms_[i].name[0] = '\0';
  48.         }
  49.     }
  50.  
  51. close_tcl_dbm()
  52.     {
  53.     int        i;
  54.     
  55.     for (i=0; i<MAX_DBMS; ++i)
  56.         {
  57.         if (_dbms_[i].dbm != (DBM *)0)
  58.             dbm_close(_dbms_[i].dbm);
  59.         }
  60.     }
  61.  
  62. int
  63. Cmd_DBMOpen(clientData, interp, argc, argv)
  64.     char        *clientData;
  65.     Tcl_Interp    *interp;
  66.     int            argc;
  67.     char        **argv;
  68.     {
  69.     short    wdRefNum;
  70.     int        index, push_err, myerr;
  71. #pragma unused (clientData)
  72.  
  73.     if (argc != 4)
  74.         {
  75.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  76.             " DBName idxFileName datFileName\"", (char *) NULL);
  77.         return TCL_ERROR;
  78.         }
  79.  
  80.     for (index = 0 ; index < MAX_DBMS ; ++index)
  81.         {
  82.         if (_dbms_[index].dbm == NULL)
  83.             break;
  84.         
  85.         if (strcmp(_dbms_[index].name, argv[1]) == SAMESTR)
  86.             {
  87.             Tcl_AppendResult(interp, "\"", argv[0], "\" duplicate DB name '",
  88.                                     argv[1], "'", (char *) NULL);
  89.             return TCL_ERROR;
  90.             }
  91.         }
  92.  
  93.     if (index >= MAX_DBMS)
  94.         {
  95.         Tcl_AppendResult(interp, "\"", argv[0], "\" max DB's open", (char *) NULL);
  96.         return TCL_ERROR;
  97.         }
  98.     else
  99.         {
  100.         myerr = TclMac_CWDCreateWD(&wdRefNum);
  101.         if (myerr != noErr)
  102.             {
  103.             Tcl_AppendResult(interp, "could not create working directory - ",
  104.                                 Tcl_MacGetError(interp, myerr), NULL);
  105.             return TCL_ERROR;
  106.             }
  107.         
  108.         push_err = TclMac_CWDPushVol();
  109.  
  110.         SetVol(NULL, wdRefNum);
  111.         _dbms_[index].dbm = dbm_x_open(argv[2], argv[3], O_RDWR | O_CREAT, 0666);
  112.         
  113.         if (push_err == noErr)
  114.             TclMac_CWDPopVol();
  115.         
  116.         TclMac_CWDDisposeWD(wdRefNum);
  117.     
  118.         if (_dbms_[index].dbm == (DBM *)0)
  119.             {
  120.             strcpy(_dbms_[index].name, "--CLOSED--");
  121.             Tcl_AppendResult(interp, "\"", argv[0], "\" error opening DB", (char *) NULL);
  122.             return TCL_ERROR;
  123.             }
  124.         else
  125.             {
  126.             strcpy(_dbms_[index].name, argv[1]);
  127.             return TCL_OK;
  128.             }
  129.         }
  130.     }
  131.  
  132. int
  133. Cmd_DBMInsert(clientData, interp, argc, argv)
  134. char        *clientData;
  135. Tcl_Interp    *interp;
  136. int            argc;
  137. char        **argv;
  138. {
  139. int        index;
  140. datum    key, data;
  141. #pragma unused (clientData)
  142.  
  143.     if (argc != 4 && argc != 5)
  144.         {
  145.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  146.             " DBName key data ?replace?\"", (char *) NULL);
  147.         return TCL_ERROR;
  148.         }
  149.  
  150.     for (index = 0 ; index < MAX_DBMS ; ++index)
  151.         {
  152.         if (strcmp(_dbms_[index].name, argv[1]) == SAMESTR)
  153.             break;
  154.         }
  155.  
  156.     if (index >= MAX_DBMS)
  157.         {
  158.         Tcl_AppendResult(interp, "\"", argv[0], "\" DB \"",
  159.                             argv[1], "\" not found", (char *) NULL);
  160.         return TCL_ERROR;
  161.         }
  162.     else
  163.         {
  164.         key.dptr = argv[2];
  165.         key.dsize = strlen(argv[2]);
  166.         data.dptr = argv[3];
  167.         data.dsize = strlen(argv[3]);
  168.         
  169.         if (dbm_store(_dbms_[index].dbm, key, data, (argc == 4 ? DBM_INSERT : DBM_REPLACE)) < 0)
  170.             {
  171.             Tcl_AppendResult(interp, "\"", argv[0], "\" error storing data", (char *) NULL);
  172.             return TCL_ERROR;
  173.             }
  174.         else
  175.             {
  176.             return TCL_OK;
  177.             }
  178.         }
  179.     }
  180.  
  181. int
  182. Cmd_DBMGetKey(clientData, interp, argc, argv)
  183. char        *clientData;
  184. Tcl_Interp    *interp;
  185. int            argc;
  186. char        **argv;
  187. {
  188. int        index;
  189. datum    key, data;
  190. char    *ptr;
  191. #pragma unused (clientData)
  192.  
  193.     if (argc != 3 && argc != 4)
  194.         {
  195.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  196.             " DBName key ?varName?\"", (char *) NULL);
  197.         return TCL_ERROR;
  198.         }
  199.  
  200.     for (index = 0 ; index < MAX_DBMS ; ++index)
  201.         {
  202.         if (strcmp(_dbms_[index].name, argv[1]) == SAMESTR)
  203.             break;
  204.         }
  205.  
  206.     if (index >= MAX_DBMS)
  207.         {
  208.         Tcl_AppendResult(interp, "\"", argv[0], "\" DB \"",
  209.                             argv[1], "\" not found", (char *) NULL);
  210.         return TCL_ERROR;
  211.         }
  212.     else
  213.         {
  214.         key.dptr = argv[2];
  215.         key.dsize = strlen(argv[2]);
  216.         
  217.         data = dbm_fetch(_dbms_[index].dbm, key);
  218.         if (data.dptr == NULL)
  219.             {
  220.             Tcl_AppendResult(interp, "\"", argv[0], "\" key \"", argv[2],
  221.                                 "\" not found", (char *) NULL);
  222.             return TCL_ERROR;
  223.             }
  224.         else
  225.             {
  226.             ptr = malloc(data.dsize + 2);
  227.             if (ptr != NULL)
  228.                 {
  229.                 memcpy(ptr, data.dptr, data.dsize);
  230.                 ptr[data.dsize] = '\0';
  231.                 
  232.                 if (argc == 4)
  233.                     Tcl_SetVar(interp, argv[3], ptr, 0);
  234.                 else
  235.                     Tcl_AppendResult(interp, ptr, (char *) NULL);
  236.                 
  237.                 free(ptr);
  238.                 return TCL_OK;
  239.                 }
  240.             else
  241.                 {
  242.                 Tcl_AppendResult(interp, "\"", argv[0], "data too large to return", (char *) NULL);
  243.                 return TCL_ERROR;
  244.                 }
  245.             }
  246.         }
  247.     }
  248.  
  249. int
  250. Cmd_DBMDelete(clientData, interp, argc, argv)
  251. char        *clientData;
  252. Tcl_Interp    *interp;
  253. int            argc;
  254. char        **argv;
  255. {
  256. int        index;
  257. datum    key;
  258. #pragma unused (clientData)
  259.  
  260.     if (argc != 3)
  261.         {
  262.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  263.             " DBName key\"", (char *) NULL);
  264.         return TCL_ERROR;
  265.         }
  266.  
  267.     for (index = 0 ; index < MAX_DBMS ; ++index)
  268.         {
  269.         if (strcmp(_dbms_[index].name, argv[1]) == SAMESTR)
  270.             break;
  271.         }
  272.  
  273.     if (index >= MAX_DBMS)
  274.         {
  275.         Tcl_AppendResult(interp, "\"", argv[0], "\" DB \"",
  276.                             argv[1], "\" not found", (char *) NULL);
  277.         return TCL_ERROR;
  278.         }
  279.     else
  280.         {
  281.         key.dptr = argv[2];
  282.         key.dsize = strlen(argv[2]);
  283.         
  284.         if (dbm_delete(_dbms_[index].dbm, key) < 0)
  285.             {
  286.             Tcl_AppendResult(interp, "\"", argv[0], "\" key \"", argv[2],
  287.                                 "\" not found", (char *) NULL);
  288.             return TCL_ERROR;
  289.             }
  290.         else
  291.             {
  292.             return TCL_OK;
  293.             }
  294.         }
  295.     }
  296.  
  297. int
  298. Cmd_DBMFirst(clientData, interp, argc, argv)
  299. char        *clientData;
  300. Tcl_Interp    *interp;
  301. int            argc;
  302. char        **argv;
  303. {
  304. int        index;
  305. datum    data;
  306. char    *ptr;
  307. #pragma unused (clientData)
  308.  
  309.     if (argc != 2 && argc != 3)
  310.         {
  311.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  312.             " DBName ?varName?\"", (char *) NULL);
  313.         return TCL_ERROR;
  314.         }
  315.  
  316.     for (index = 0 ; index < MAX_DBMS ; ++index)
  317.         {
  318.         if (strcmp(_dbms_[index].name, argv[1]) == SAMESTR)
  319.             break;
  320.         }
  321.  
  322.     if (index >= MAX_DBMS)
  323.         {
  324.         Tcl_AppendResult(interp, "\"", argv[0], "\" DB \"",
  325.                             argv[1], "\" not found", (char *) NULL);
  326.         return TCL_ERROR;
  327.         }
  328.     else
  329.         {
  330.         data = dbm_firstkey(_dbms_[index].dbm);
  331.         if (data.dptr == NULL)
  332.             {
  333.             Tcl_AppendResult(interp, "\"", argv[0], "\" database has no keys", (char *) NULL);
  334.             return TCL_ERROR;
  335.             }
  336.         else
  337.             {
  338.             ptr = malloc(data.dsize + 2);
  339.             if (ptr != NULL)
  340.                 {
  341.                 memcpy(ptr, data.dptr, data.dsize);
  342.                 ptr[data.dsize] = '\0';
  343.  
  344.                 if (argc == 3)
  345.                     Tcl_SetVar(interp, argv[2], ptr, 0);
  346.                 else
  347.                     Tcl_AppendResult(interp, ptr, (char *) NULL);
  348.  
  349.                 return TCL_OK;
  350.                 }
  351.             else
  352.                 {
  353.                 Tcl_AppendResult(interp, "\"", argv[0], "key too large to return", (char *) NULL);
  354.                 return TCL_ERROR;
  355.                 }
  356.             }
  357.         }
  358.     }
  359.  
  360. int
  361. Cmd_DBMNext(clientData, interp, argc, argv)
  362. char        *clientData;
  363. Tcl_Interp    *interp;
  364. int            argc;
  365. char        **argv;
  366. {
  367. int        index;
  368. datum    data;
  369. char    *ptr;
  370. #pragma unused (clientData)
  371.  
  372.     if (argc != 2 && argc != 3)
  373.         {
  374.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  375.             " DBName ?varName?\"", (char *) NULL);
  376.         return TCL_ERROR;
  377.         }
  378.  
  379.     for (index = 0 ; index < MAX_DBMS ; ++index)
  380.         {
  381.         if (strcmp(_dbms_[index].name, argv[1]) == SAMESTR)
  382.             break;
  383.         }
  384.  
  385.     if (index >= MAX_DBMS)
  386.         {
  387.         Tcl_AppendResult(interp, "\"", argv[0], "\" DB \"",
  388.                             argv[1], "\" not found", (char *) NULL);
  389.         return TCL_ERROR;
  390.         }
  391.     else
  392.         {
  393.         data = dbm_nextkey(_dbms_[index].dbm);
  394.         if (data.dptr == NULL)
  395.             {
  396.             Tcl_AppendResult(interp, "\"", argv[0], "\" no more keys", (char *) NULL);
  397.             return TCL_ERROR;
  398.             }
  399.         else
  400.             {
  401.             ptr = malloc(data.dsize + 2);
  402.             if (ptr != NULL)
  403.                 {
  404.                 memcpy(ptr, data.dptr, data.dsize);
  405.                 ptr[data.dsize] = '\0';
  406.  
  407.                 if (argc == 3)
  408.                     Tcl_SetVar(interp, argv[2], ptr, 0);
  409.                 else
  410.                     Tcl_AppendResult(interp, ptr, (char *) NULL);
  411.  
  412.                 return TCL_OK;
  413.                 }
  414.             else
  415.                 {
  416.                 Tcl_AppendResult(interp, "\"", argv[0], "key too large to return", (char *) NULL);
  417.                 return TCL_ERROR;
  418.                 }
  419.             }
  420.         }
  421.     }
  422.  
  423. int
  424. Cmd_DBMClose(clientData, interp, argc, argv)
  425. char        *clientData;
  426. Tcl_Interp    *interp;
  427. int            argc;
  428. char        **argv;
  429. {
  430. int        index;
  431. #pragma unused (clientData)
  432.  
  433.     if (argc != 2)
  434.         {
  435.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  436.             " DBName\"", (char *) NULL);
  437.         return TCL_ERROR;
  438.         }
  439.  
  440.     for (index = 0 ; index < MAX_DBMS ; ++index)
  441.         {
  442.         if (strcmp(_dbms_[index].name, argv[1]) == SAMESTR)
  443.             break;
  444.         }
  445.  
  446.     if (index >= MAX_DBMS)
  447.         {
  448.         Tcl_AppendResult(interp, "\"", argv[0], "\" DB \"",
  449.                             argv[1], "\" not found", (char *) NULL);
  450.         return TCL_ERROR;
  451.         }
  452.     else
  453.         {
  454.         dbm_close(_dbms_[index].dbm);
  455.         _dbms_[index].dbm = (DBM *)0;
  456.         strcpy(_dbms_[index].name, "--CLOSED--");
  457.         return TCL_OK;
  458.         }
  459.     }
  460.  
  461. Tcl_InitDBM(interp)
  462. Tcl_Interp    *interp;
  463.     {
  464.     Tcl_CreateCommand(interp, "dbm_open", Cmd_DBMOpen,
  465.                         (ClientData)NULL, (void (*)())NULL);
  466.     Tcl_CreateCommand(interp, "dbm_close", Cmd_DBMClose,
  467.                         (ClientData)NULL, (void (*)())NULL);
  468.     Tcl_CreateCommand(interp, "dbm_insert", Cmd_DBMInsert,
  469.                         (ClientData)NULL, (void (*)())NULL);
  470.     Tcl_CreateCommand(interp, "dbm_getkey", Cmd_DBMGetKey,
  471.                         (ClientData)NULL, (void (*)())NULL);
  472.     Tcl_CreateCommand(interp, "dbm_delete", Cmd_DBMDelete,
  473.                         (ClientData)NULL, (void (*)())NULL);
  474.     Tcl_CreateCommand(interp, "dbm_first", Cmd_DBMFirst,
  475.                         (ClientData)NULL, (void (*)())NULL);
  476.     Tcl_CreateCommand(interp, "dbm_next", Cmd_DBMNext,
  477.                         (ClientData)NULL, (void (*)())NULL);
  478.     }
  479.