home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / misc / volume25 / sybperl / part01 / sybperl.c < prev   
Encoding:
C/C++ Source or Header  |  1991-11-11  |  15.2 KB  |  662 lines
  1. static char SccsId[] = "@(#)sybperl.c    1.5    9/9/91";
  2. /************************************************************************/
  3. /*    Copyright 1991 by Michael Peppler and ITF Management SA     */
  4. /*                                    */
  5. /*    Full ownership of this software, and all rights pertaining to     */
  6. /*    the for-profit distribution of this software, are retained by     */
  7. /*    Michael Peppler and ITF Management SA.  You are permitted to     */
  8. /*    use this software without fee.  This software is provided "as     */
  9. /*    is" without express or implied warranty.  You may redistribute     */
  10. /*    this software, provided that this copyright notice is retained,    */
  11. /*    and that the software is not distributed for profit.  If you     */
  12. /*    wish to use this software in a profit-making venture, you must     */
  13. /*    first license this code and its underlying technology from     */
  14. /*    ITF Management SA.                         */
  15. /*                                    */
  16. /*    Bottom line: you can have this software, you can use it, you     */
  17. /*    can give it away.  You just can't sell any or all parts of it     */
  18. /*    without prior permission from Harris Corporation.         */
  19. /************************************************************************/
  20.  
  21. /* sybase.c
  22.  *
  23.  * Call Sybase DB-Library functions from Perl.
  24.  * Written by Michael Peppler (mpeppler@itf.ch)
  25.  * ITF Management SA, 13 rue de la Fontaine
  26.  * CH-1204 Geneva, Switzerland
  27.  * Tel: (+4122) 312 1311 Fax: (+4122) 312 1322
  28.  */
  29.  
  30.  
  31. /* 
  32.  * The Perl/Sybase savestr() conflict.
  33.  * Both Perl and Sybase DB-Library have a function called savestr(). 
  34.  * This creates a problem when calling dbcmd() and dbuse(). There are 
  35.  * several ways to work around this, one of which is to #define 
  36.  * BROKEN_DBCMD, which enables some code that I've written to simulate 
  37.  * dbcmd() locally. See Makefile and BUGS for details.
  38.  */
  39. #include "EXTERN.h"
  40. #include "perl.h"
  41. #undef MAX
  42. #undef MIN
  43.  
  44. #if !defined(VERSION3)
  45. #define str_2static(s)        str_2mortal(s)
  46. #endif
  47.  
  48. #include <sybfront.h>
  49. #include <sybdb.h>
  50. #include <syberror.h>
  51.  
  52. #include "patchlevel.h"
  53.  
  54. extern int wantarray;
  55.  
  56. char *savestr();
  57.  
  58.  
  59. /* 
  60.  * The variables that the Sybase routines set, and that you may want 
  61.  * to test in your Perl script. These variables are READ-ONLY.
  62.  */
  63. static enum uservars
  64. {
  65.     UV_SUCCEED,            /* Returns SUCCEED */
  66.     UV_FAIL,            /* Returns FAIL */
  67.     UV_NO_MORE_ROWS,        /* Returns NO_MORE_ROWS */
  68.     UV_NO_MORE_RESULTS,        /* Returns NO_MORE_RESULTS */
  69.     UV_ComputeId,        /* Returns the compute id of the row (in dbnextrow()) */
  70.     UV_SybperlVer,        /* Returns Sybperl Version/Patchlevel */
  71. };
  72.  
  73. /* 
  74.  * User subroutines that we have implemented. I've found that I can do 
  75.  * all the stuff I want to with this subset of DB-Library. Let me know 
  76.  * if you implement further routines.
  77.  * The names are self-explanatory.
  78.  */
  79. static enum usersubs
  80. {
  81.     US_dblogin,            /* This also performs a dbopen()  */
  82.     US_dbopen,
  83.     US_dbclose,
  84.     US_dbcmd,
  85.     US_dbsqlexec,
  86.     US_dbresults,
  87.     US_dbnextrow,
  88.     US_dbcancel,
  89.     US_dbcanquery,
  90.     US_dbexit,
  91.     US_dbuse,
  92. };
  93.  
  94. #define MAX_DBPROCS 25        /* Change this if you really want your perl script to talk to */
  95.                 /* more than 25 dataserver connections at a time ...*/
  96.  
  97. static LOGINREC *login;
  98. static DBPROCESS *dbproc[MAX_DBPROCS];
  99. static int exitCalled = 0;    /* Set to 1 if dbexit() has been called. */
  100. static int ComputeId;
  101.  
  102. static int usersub();
  103. static int userset();
  104. static int userval();
  105. static int err_handler(), msg_handler();
  106.  
  107. int userinit()
  108. {
  109.     init_sybase();
  110. }
  111.  
  112. int
  113. init_sybase()
  114. {
  115.     struct ufuncs uf;
  116.     char *filename = "sybase.c";
  117.  
  118.     if (dbinit() == FAIL)    /* initialize dblibrary */
  119.     exit(ERREXIT);
  120. /*
  121.  * Install the user-supplied error-handling and message-handling routines.
  122.  * They are defined at the bottom of this source file.
  123.  */
  124.     dberrhandle(err_handler);
  125.     dbmsghandle(msg_handler);
  126.     
  127.     uf.uf_set = userset;
  128.     uf.uf_val = userval;
  129.  
  130. #define MAGICVAR(name, ix) uf.uf_index = ix, magicname(name, &uf, sizeof uf)
  131.  
  132.     MAGICVAR("SUCCEED",    UV_SUCCEED);
  133.     MAGICVAR("FAIL",UV_FAIL);
  134.     MAGICVAR("NO_MORE_ROWS",    UV_NO_MORE_ROWS);
  135.     MAGICVAR("NO_MORE_RESULTS",    UV_NO_MORE_RESULTS);
  136.     MAGICVAR("ComputeId",    UV_ComputeId);
  137.     MAGICVAR("SybperlVer",    UV_SybperlVer);
  138.  
  139.     make_usub("dblogin",    US_dblogin,    usersub, filename);
  140.     make_usub("dbopen",        US_dbopen,    usersub, filename);
  141.     make_usub("dbclose",    US_dbclose,    usersub, filename);
  142.     make_usub("dbcmd",        US_dbcmd,    usersub, filename);
  143.     make_usub("dbsqlexec",    US_dbsqlexec,    usersub, filename);
  144.     make_usub("dbresults",    US_dbresults,    usersub, filename);
  145.     make_usub("dbnextrow",    US_dbnextrow,    usersub, filename);
  146.     make_usub("dbcancel",    US_dbcancel,    usersub, filename);
  147.     make_usub("dbcanquery",    US_dbcanquery,    usersub, filename);
  148.     make_usub("dbexit",    US_dbexit,    usersub, filename);
  149.     make_usub("dbuse",    US_dbuse,    usersub, filename);
  150.  
  151. }
  152.  
  153. static int
  154. usersub(ix, sp, items)
  155. int ix;
  156. register int sp;
  157. register int items;
  158. {
  159.     STR **st = stack->ary_array + sp;
  160.     ARRAY *ary = stack;    
  161.     register int i;
  162.     register STR *Str;        /* used in str_get and str_gnum macros */
  163.     int inx = -1;        /* Index into dbproc[] array. Passed as first parameter to nearly all &dbxxx() calls */
  164.  
  165.     if(exitCalled)
  166.     fatal("&dbexit() has been called. Access to Sybase impossible.");
  167.  
  168.     switch (ix)
  169.     {
  170.       case US_dblogin:
  171.     if (items > 2)
  172.         fatal("Usage: &dblogin([user[,pwd]])");
  173.     if (login)
  174.         fatal("&dblogin() called twice.");
  175.     else
  176.     {
  177.         int retval;
  178.  
  179.         login = dblogin();
  180.         if(items)
  181.         {
  182.         DBSETLUSER(login, (char *)str_get(st[1]));
  183.         if(items > 1)
  184.             DBSETLPWD(login, (char *)str_get(st[2]));
  185.         }
  186.  
  187.         dbproc[0] = dbopen(login, NULL);
  188.         str_numset(st[0], (double) 0);
  189.     }
  190.     break;
  191.       case US_dbopen:
  192.     if (items != 0)
  193.         fatal("Usage: $dbproc = &dbopen;");
  194.     else
  195.     {
  196.         int j;
  197.  
  198.         for(j = 0; j < MAX_DBPROCS; ++j)
  199.         if(dbproc[j] == NULL)
  200.             break;
  201.         if(j == MAX_DBPROCS)
  202.         fatal("&dbopen: No more dbprocs available.");
  203.         dbproc[j] = dbopen(login, NULL);
  204.         str_numset(st[0], (double) j);
  205.     }
  206.     break;
  207.       case US_dbclose:
  208.     if (items != 1)
  209.         fatal("Usage: $ret = &dbclose($dbproc);");
  210.     else
  211.     {
  212.         inx = getDbProc(st[1]);
  213.  
  214.         dbclose(dbproc[inx]);
  215.         dbproc[inx] = (DBPROCESS *)NULL;
  216.     }
  217.     break;
  218.       case US_dbcancel:
  219.     if (items != 1)
  220.         fatal("Usage: &dbcancel($dbproc)");
  221.     else
  222.     {
  223.         int retval;
  224. #if defined(BROKEN_DBCMD)
  225.         DBSTRING *ptr;
  226.         DBSTRING *old;
  227. #endif
  228.         inx = getDbProc(st[1]);
  229.  
  230.         retval = dbcancel(dbproc[inx]);
  231.         str_numset(st[0], (double) retval);
  232. #if defined(BROKEN_DBCMD)
  233.         ptr = dbproc[inx]->dbcmdbuf;
  234.         while(ptr)
  235.         {
  236.         old = ptr;
  237.         ptr = ptr->strnext;
  238.         free(old->strtext);
  239.         free(old);
  240.         }
  241.         dbproc[inx]->dbcmdbuf = NULL;
  242. #endif
  243.     }
  244.     break;
  245.  
  246.       case US_dbcanquery:
  247.     if (items != 1)
  248.         fatal("Usage: &dbcanquery($dbproc)");
  249.     else
  250.     {
  251.         int retval;
  252.         inx = getDbProc(st[1]);
  253.  
  254.         retval = dbcanquery(dbproc[inx]);
  255.         str_numset(st[0], (double) retval);
  256.     }
  257.     break;
  258.  
  259.       case US_dbexit:
  260.     if (items != 0)
  261.         fatal("Usage: &dbexit()");
  262.     else
  263.     {
  264.         dbexit(dbproc[0]);
  265.         exitCalled++;
  266.         str_numset(st[0], (double) 1);
  267.     }
  268.     break;
  269.  
  270.       case US_dbuse:
  271.     if (items != 2)
  272.         fatal("Usage: &dbuse($dbproc, $database)");
  273.     else
  274.     {
  275. #if defined(BROKEN_DBCMD)
  276.         /* 
  277.          * Why doesn't this $@#! dbuse() call not work from within 
  278.          * Perl????? (So we emulate it here, but I sure can't 
  279.          * guarantee anything about portability to future versions 
  280.          * of DB-Library!
  281.          */
  282.         DBSTRING *new;
  283.         DBSTRING *sav;
  284.         char *strdup();
  285.         char buff[256];
  286.         int ret;
  287.  
  288.         inx = getDbProc(st[1]);
  289.  
  290.         strcpy(buff, "use ");
  291.         strcat(buff, (char *)str_get(st[2]));
  292.         sav = dbproc[inx]->dbcmdbuf;
  293.  
  294.         new = (DBSTRING *)calloc(1,sizeof(DBSTRING));
  295.         new->strtext = (BYTE *)strdup((char *)buff);
  296.         new->strtotlen = strlen(new->strtext)+1;
  297.         dbproc[inx]->dbcmdbuf = new;
  298.  
  299.         ret = dbsqlexec(dbproc[inx]);
  300.         ret = dbresults(dbproc[inx]);
  301.         while((ret = dbnextrow(dbproc[inx])) != NO_MORE_ROWS)
  302.         ;
  303.  
  304.         free(new->strtext);
  305.         free(new);
  306.         
  307.         dbproc[inx]->dbcmdbuf = sav;
  308.         str_numset(st[0], (double) SUCCEED);
  309. #else
  310.         int retval;
  311.         char str[255];
  312.         strcpy(str, (char *)str_get(st[2]));
  313.         inx = getDbProc(st[1]);
  314.  
  315.         retval = dbuse(dbproc[inx], str);
  316.         str_numset(st[0], (double) retval);
  317. #endif
  318.     }
  319.     break;
  320.  
  321.       case US_dbsqlexec:
  322.     if (items != 1)
  323.         fatal("Usage: &dbsqlexec($dbproc)");
  324.     else
  325.     {
  326.         int retval;
  327.         inx = getDbProc(st[1]);
  328.  
  329.         retval = dbsqlexec(dbproc[inx]);
  330.         str_numset(st[0], (double) retval);
  331.     }
  332.     break;
  333.  
  334.       case US_dbresults:
  335.     if (items != 1)
  336.         fatal("Usage: &dbresults($dbproc)");
  337.     else
  338.     {
  339.         int retval;
  340.         inx = getDbProc(st[1]);
  341.  
  342.         retval = dbresults(dbproc[inx]);
  343.         str_numset(st[0], (double) retval);
  344. #if defined(BROKEN_DBCMD)
  345.         if(retval==NO_MORE_RESULTS)
  346.         {
  347.         DBSTRING *ptr = dbproc[inx]->dbcmdbuf;
  348.         DBSTRING *old;
  349.  
  350.         while(ptr)
  351.         {
  352.             old = ptr;
  353.             ptr = ptr->strnext;
  354.             free(old->strtext);
  355.             free(old);
  356.         }
  357.         dbproc[inx]->dbcmdbuf = NULL;
  358.         }
  359. #endif
  360.     }
  361.     break;
  362.  
  363.       case US_dbcmd:
  364.     if (items != 2)
  365.         fatal("Usage: &dbcmd($dbproc, $str)");
  366.     else
  367.     {
  368.         int retval;
  369. #if defined(BROKEN_DBCMD)
  370.         DBSTRING *ptr;
  371.         DBSTRING *new, *old;
  372.         char *strdup();
  373. #endif
  374.         inx = getDbProc(st[1]);
  375.         
  376. #if defined(BROKEN_DBCMD)
  377.         ptr = dbproc[inx]->dbcmdbuf;
  378.  
  379.         new = (DBSTRING *)calloc(1,sizeof(DBSTRING));
  380.         new->strtext = (BYTE *)strdup((char *)str_get(st[2]));
  381.         new->strtotlen = strlen(new->strtext)+1;
  382.         if(!ptr)
  383.         dbproc[inx]->dbcmdbuf = new;
  384.         else
  385.         {
  386.         while(ptr->strnext)
  387.             ptr = ptr->strnext;
  388.         ptr->strnext = new;
  389.         }
  390. #else
  391.         retval = dbcmd(dbproc[inx], (char *)str_get(st[2]));
  392. #endif
  393.         str_numset(st[0], (double) retval);
  394.     }
  395.     break;
  396.  
  397.     case US_dbnextrow:
  398.     if (items != 1)
  399.         fatal("Usage: @arr = &dbnextrow($dbproc)");
  400.     else
  401.     {
  402.         int retval;
  403.         inx = getDbProc(st[1]);
  404.  
  405.         --sp;        /* otherwise you get an empty element at the beginning of the results array! */
  406.  
  407.         retval = dbnextrow(dbproc[inx]);
  408.         if(retval == REG_ROW)
  409.         {
  410.             char buff[1024], *p;
  411.         BYTE *data;
  412.         int col, type, numcols = dbnumcols(dbproc[inx]);
  413.         int len;
  414.         DBFLT8 tmp;
  415.  
  416.         ComputeId = 0;
  417.  
  418.         for(col = 1, buff[0] = 0; col <= numcols; ++col)
  419.         {
  420.             type = dbcoltype(dbproc[inx], col);
  421.             len = dbdatlen(dbproc[inx],col);
  422.             data = (BYTE *)dbdata(dbproc[inx],col);
  423.             if(!data && !len)
  424.             {
  425.             strcpy(buff,"NULL");
  426.             }
  427.             else
  428.             {
  429.             switch(type)
  430.             {
  431.               case SYBCHAR:
  432.                 strncpy(buff,data,len);
  433.                 buff[len] = 0;
  434.                 break;
  435.               case SYBINT1:
  436.               case SYBBIT: /* a bit is at least a byte long... */
  437.                 sprintf(buff,"%u",*(unsigned char *)data);
  438.                 break;
  439.               case SYBINT2:
  440.                 sprintf(buff,"%d",*(short *)data);
  441.                 break;
  442.               case SYBINT4:
  443.                 sprintf(buff,"%d",*(long *)data);
  444.                 break;
  445.               case SYBFLT8:
  446.                 sprintf(buff,"%.6f",*(double *)data);
  447.                 break;
  448.               case SYBMONEY:
  449.                 dbconvert(dbproc[inx], SYBMONEY, data,-1,SYBFLT8,&tmp,-1);
  450.                 sprintf(buff,"%.6f",tmp);
  451.                 break;
  452.               case SYBDATETIME:
  453.                 dbconvert(dbproc[inx], SYBDATETIME, data,-1,SYBCHAR,buff,-1);
  454.                 break;
  455.               default:
  456.                 /* ignored at the moment... */
  457.                 break;
  458.             }
  459.             }
  460.             (void)astore(ary,++sp,str_2static(str_make(buff,0)));
  461.         }
  462.         }
  463.         if (retval > 0)
  464.         {
  465.             char buff[1024], *p;
  466.         BYTE *data;
  467.         int col, type, numcols;
  468.         int len;
  469.         DBFLT8 tmp;
  470.  
  471.         ComputeId = retval;
  472.         numcols = dbnumalts(dbproc[inx], ComputeId);
  473.  
  474.         for(col = 1, buff[0] = 0; col <= numcols; ++col)
  475.         {
  476.             type = dbalttype(dbproc[inx], ComputeId, col);
  477.             len = dbadlen(dbproc[inx], ComputeId, col);
  478.             data = (BYTE *)dbadata(dbproc[inx], ComputeId, col);
  479.             if(!data && !len)
  480.             {
  481.             strcpy(buff,"NULL");
  482.             }
  483.             else
  484.             {
  485.             switch(type)
  486.             {
  487.               case SYBCHAR:
  488.                 strncpy(buff,data,len);
  489.                 buff[len] = 0;
  490.                 break;
  491.               case SYBINT1:
  492.               case SYBBIT: /* a bit is at least a byte long... */
  493.                 sprintf(buff,"%d",*(char *)data);
  494.                 break;
  495.               case SYBINT2:
  496.                 sprintf(buff,"%d",*(short *)data);
  497.                 break;
  498.               case SYBINT4:
  499.                 sprintf(buff,"%d",*(long *)data);
  500.                 break;
  501.               case SYBFLT8:
  502.                 sprintf(buff,"%.6f",*(double *)data);
  503.                 break;
  504.               case SYBMONEY:
  505.                 dbconvert(dbproc[inx], SYBMONEY, data,-1,SYBFLT8,&tmp,-1);
  506.                 sprintf(buff,"%.6f",tmp);
  507.                 break;
  508.               case SYBDATETIME:
  509.                 dbconvert(dbproc[inx], SYBDATETIME, data,-1,SYBCHAR,buff,-1);
  510.                 break;
  511.               default:
  512.                 /* ignored at the moment... */
  513.                 break;
  514.             }
  515.             }
  516.             (void)astore(ary,++sp,str_2static(str_make(buff,0)));
  517.         }
  518.         }        
  519. #if defined(BROKEN_DBCMD)
  520.         /* 
  521.          * We can't rely on dbcmd(),dbresults() etc. to clean up 
  522.          * the dbcmdbuf linked list, so we have to it ourselves...
  523.          */
  524.         if(retval == NO_MORE_ROWS && !DBMORECMDS(dbproc[inx]))
  525.         {
  526.         DBSTRING *ptr = dbproc[inx]->dbcmdbuf;
  527.         DBSTRING *new, *old;
  528.  
  529.         while(ptr)
  530.         {
  531.             old = ptr;
  532.             ptr = ptr->strnext;
  533.             free(old->strtext);
  534.             free(old);
  535.         }
  536.         dbproc[inx]->dbcmdbuf = NULL;
  537.         }
  538. #endif
  539.     }
  540.     break;
  541.  
  542.     default:
  543.     fatal("Unimplemented user-defined subroutine");
  544.     }
  545.     return sp;
  546. }
  547.  
  548. /* 
  549.  * Return the value of a userdefined variable. These variables are all 
  550.  * READ-ONLY in Perl.
  551.  */
  552. static int
  553. userval(ix, str)
  554. int ix;
  555. STR *str;
  556. {
  557.     char buff[24];
  558.     
  559.     switch (ix)
  560.     {
  561.       case UV_SUCCEED:
  562.     str_numset(str, (double)SUCCEED);
  563.     break;
  564.       case UV_FAIL:
  565.     str_numset(str, (double)FAIL);
  566.     break;
  567.       case UV_NO_MORE_ROWS:
  568.     str_numset(str, (double)NO_MORE_ROWS);
  569.     break;
  570.       case UV_NO_MORE_RESULTS:
  571.     str_numset(str, (double)NO_MORE_RESULTS);
  572.     break;
  573.       case UV_ComputeId:
  574.     str_numset(str, (double)ComputeId);
  575.     break;
  576.       case UV_SybperlVer:
  577.     sprintf(buff, "%d.%3.3d", VERSION, PATCHLEVEL);
  578.     str_set(str, buff);
  579.     break;
  580.     }
  581.     return 0;
  582. }
  583.  
  584. static int
  585. userset(ix, str)        /* Not used. None of these variables are user-settable */
  586. int ix;
  587. STR *str;
  588. {
  589.     return 0;
  590. }
  591.  
  592.  
  593. /*ARGSUSED*/
  594. static int err_handler(dbprocl, severity, dberr, oserr, dberrstring, oserrstr)
  595.     DBPROCESS *dbprocl;
  596.     int severity;
  597.     int dberr;
  598.     int oserr;
  599.     char *dberrstring;
  600.     char *oserrstr;
  601. {
  602.     if ((dbprocl == NULL) || (DBDEAD(dbprocl)))
  603.     return(INT_EXIT);
  604.     else 
  605.     {
  606.     fprintf(stderr,"DB-Library error:\n\t%s\n", dberrstring);
  607.     
  608.     if (oserr != DBNOERR)
  609.         fprintf(stderr,"Operating-system error:\n\t%s\n", oserrstr);
  610.     
  611.     return(INT_CANCEL);
  612.     }
  613. }
  614.  
  615. /*ARGSUSED*/
  616.  
  617. static int msg_handler(dbprocl, msgno, msgstate, severity, msgtext, srvname, procname, Line)
  618.     DBPROCESS *dbprocl;
  619.     DBINT msgno;
  620.     int msgstate;
  621.     int severity;
  622.     char *msgtext;
  623.     char *srvname;
  624.     char *procname;
  625.     DBUSMALLINT Line;
  626. {
  627.     if(msgno != 5701)        /* Ignore 'Changed database context' messages */
  628.     {
  629.     fprintf (stderr,"Msg %ld, Level %d, State %d\n", 
  630.          msgno, severity, msgstate);
  631.     if (strlen(srvname) > 0)
  632.         fprintf (stderr,"Server '%s', ", srvname);
  633.     if (strlen(procname) > 0)
  634.         fprintf (stderr,"Procedure '%s', ", procname);
  635.     if (Line > 0)
  636.         fprintf (stderr,"Line %d", Line);
  637.     
  638.     fprintf(stderr,"\n\t%s\n", msgtext);
  639.     }
  640.     
  641.     if(severity)
  642.     exit(-1);
  643.     
  644.     return(0);
  645. }
  646.  
  647. /* 
  648.  * Get the index into the dbproc[] array from a Perl STR datatype. 
  649.  * Check that the index is reasonably valid...
  650.  */
  651. int getDbProc(Str)
  652.     STR *Str;
  653. {
  654.     int ix = (int)str_gnum(Str);
  655.  
  656.     if(ix < 0 || ix >= MAX_DBPROCS)
  657.     fatal("$dbproc parameter is out of range.");
  658.     return ix;
  659. }
  660.     
  661.  
  662.