home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 October / usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso / misc / volume43 / sybperl / part02 / sybperl.c
Encoding:
C/C++ Source or Header  |  1994-06-27  |  83.1 KB  |  3,401 lines
  1. static char SccsId[] = "@(#)sybperl.c    1.31    6/8/94";
  2. /************************************************************************/
  3. /*    Copyright (c) 1991, 1992, 1993, 1994                */
  4. /*        Michael Peppler and ITF Management SA                 */
  5. /*      Portions Copyright (c) 1993 Commercial Dynamics Pty Ltd         */
  6. /*                                    */
  7. /* You may copy this under the terms of the GNU General Public License, */
  8. /* or the Artistic License, copies of which should have accompanied    */
  9. /* your Perl kit.                            */
  10. /************************************************************************/
  11.  
  12. /* sybperl.c
  13.  *
  14.  * Call Sybase DB-Library functions from Perl.
  15.  * Written by Michael Peppler (mpeppler@itf.ch)
  16.  * ITF Management SA, 13 rue de la Fontaine
  17.  * CH-1204 Geneva, Switzerland
  18.  * Tel: (+4122) 312 1311 Fax: (+4122) 312 1322
  19.  */
  20.  
  21.  
  22. #include "EXTERN.h"
  23. #include "perl.h"
  24. #undef MAX
  25. #undef MIN
  26.  
  27. #if defined(VERSION3)
  28. #define str_2mortal(s)        str_2static(s)
  29. #endif
  30.  
  31. #include <sybfront.h>
  32. #include <sybdb.h>
  33. #include <syberror.h>
  34.  
  35. #include "patchlevel.h"
  36.  
  37. extern int wantarray;
  38.  
  39. #if DBLIBVS >= 461
  40. static void new_mny4tochar();  /* forward declaration */
  41. static void new_mnytochar();   /* forward declaration */
  42. #endif
  43.  
  44. /* 
  45.  * The variables that the Sybase routines set, and that you may want 
  46.  * to test in your Perl script. These variables are READ-ONLY.
  47.  */
  48. enum uservars
  49. {
  50.     UV_SUCCEED,            /* Returns SUCCEED */
  51.     UV_FAIL,            /* Returns FAIL */
  52.     UV_NO_MORE_ROWS,        /* Returns NO_MORE_ROWS */
  53.     UV_NO_MORE_RESULTS,        /* Returns NO_MORE_RESULTS */
  54.     UV_ComputeId,        /* Returns the compute id of the row (in dbnextrow()) */
  55.     UV_SybperlVer,        /* Returns Sybperl Version/Patchlevel */
  56.     UV_DBstatus,        /* The status value of the last dbnextrow() call */
  57.     /* The following enum definitions are also for Sybase OpenClient R4.6.1
  58.      * read-only perl variable synthesis.  See above for format ...
  59.      */
  60. #if DBLIBVS >= 461
  61.     UV_STDEXIT,
  62.     UV_ERREXIT,
  63.     UV_INT_EXIT,
  64.     UV_INT_CONTINUE,
  65.     UV_INT_CANCEL,
  66.     UV_INT_TIMEOUT,
  67.     UV_MORE_ROWS,
  68.     UV_REG_ROW,
  69.     UV_BUF_FULL,
  70.     UV_NO_MORE_PARAMS,
  71.     UV_DBSAVE,
  72.     UV_DBNOSAVE,
  73.     UV_DBNOERR,
  74.     UV_DB_PASSTHRU_MORE,
  75.     UV_DB_PASSTHRU_EOM,
  76.     UV_DBNOPROC,
  77.     UV_EXCEPTION,
  78.     UV_EXSIGNAL,
  79.     UV_EXSCREENIO,
  80.     UV_EXDBLIB,
  81.     UV_EXFORMS,
  82.     UV_EXCLIPBOARD,
  83.     UV_EXLOOKUP,
  84.     UV_EXINFO,
  85.     UV_EXUSER,
  86.     UV_EXNONFATAL,
  87.     UV_EXCONVERSION,
  88.     UV_EXSERVER,
  89.     UV_EXTIME,
  90.     UV_EXPROGRAM,
  91.     UV_EXRESOURCE,
  92.     UV_EXCOMM,
  93.     UV_EXFATAL,
  94.     UV_EXCONSISTENCY,
  95. #endif
  96.     UV_DB_IN,
  97.     UV_DB_OUT,
  98.     UV_BCPMAXERRS,
  99.     UV_BCPFIRST,
  100.     UV_BCPLAST,
  101.     UV_BCPBATCH,
  102.     UV_DBTRUE,
  103.     UV_DBFALSE,
  104. #if defined(PACKAGE_BUG)
  105.     UV_PACKAGE_BUG,
  106. #endif
  107.     UV_dbNullIsUndef,
  108.     UV_dbKeepNumeric,
  109.     UV_dbBin0x,
  110. };
  111.  
  112. /* 
  113.  * User subroutines that we have implemented. I've found that I can do 
  114.  * all the stuff I want to with this subset of DB-Library. Let me know 
  115.  * if you implement further routines.
  116.  * The names are self-explanatory.
  117.  */
  118. enum usersubs
  119. {
  120.     US_dblogin,            /* This also performs the first dbopen()  */
  121.     US_dbopen,
  122.     US_dbclose,
  123.     US_dbcmd,
  124.     US_dbsqlexec,
  125.     US_dbresults,
  126.     US_dbnextrow,
  127.     US_dbcancel,
  128.     US_dbcanquery,
  129.     US_dbexit,
  130.     US_dbuse,
  131. #ifdef HAS_CALLBACK
  132.     US_dberrhandle,
  133.     US_dbmsghandle,
  134. #endif
  135.     US_dbstrcpy,
  136.     US_DBMORECMDS,
  137.     US_DBCMDROW,
  138.     US_DBROWS,
  139.     US_DBCOUNT,
  140.     US_DBCURCMD,
  141.     US_dbhasretstat,
  142.     US_dbretstatus,
  143.     US_dbretdata,
  144.     US_dbwritetext,
  145.     US_dbcoltype,
  146.     US_dbcolname,
  147.     US_dbcollen,
  148.     US_dbnumcols,
  149.     US_dbfreebuf,
  150.     US_dbsetopt,
  151. #if DBLIBVS >= 420
  152.     US_dbsafestr,
  153.     US_dbrecftos,
  154. #if DBLIBVS >= 461
  155.     US_dbmny4add,
  156.     US_dbmny4cmp,
  157.     US_dbmny4divide,
  158.     US_dbmny4minus,
  159.     US_dbmny4mul,
  160.     US_dbmny4sub,
  161.     US_dbmny4zero,
  162.     US_dbmnyadd,
  163.     US_dbmnycmp,
  164.     US_dbmnydivide,
  165.     US_dbmnyminus,
  166.     US_dbmnymul,
  167.     US_dbmnysub,
  168.     US_dbmnyzero,
  169.     US_dbmnydec,
  170.     US_dbmnydown,
  171.     US_dbmnyinc,
  172.     US_dbmnyinit,
  173.     US_dbmnymaxneg,
  174.     US_dbmnymaxpos,
  175.     US_dbmnyndigit,
  176.     US_dbmnyscale,
  177.     US_DBSETLCHARSET,
  178.     US_DBSETLNATLANG,
  179. #endif
  180. #endif
  181.     US_BCP_SETL,
  182. #if DBLIBVS >= 461
  183.     US_bcp_getl,
  184. #endif
  185.     US_bcp_init,
  186.     US_bcp_meminit,
  187.     US_bcp_sendrow,
  188.     US_bcp_batch,
  189.     US_bcp_done,
  190.     US_bcp_control,
  191.     US_bcp_columns,
  192.     US_bcp_colfmt,
  193.     US_bcp_collen,
  194.     US_bcp_exec,
  195.     US_bcp_readfmt,
  196.     US_bcp_writefmt,
  197. };
  198.  
  199. #ifndef MAX_DBPROCS
  200. #define MAX_DBPROCS 25        /* Change this if you really want your perl script to talk to */
  201.                 /* more than 25 dataserver connections at a time ...*/
  202. #endif
  203.  
  204.  
  205.  /* some info that needs to be maintained on a per DBPROCESS basis. */
  206. struct dbProcInfo
  207. {
  208.     DBPROCESS *dbproc;
  209.     BYTE **colPtr;
  210. };
  211.  
  212. static LOGINREC *login;
  213. static struct dbProcInfo dbProc[MAX_DBPROCS];
  214. static int exitCalled = 0;    /* Set to 1 if dbexit() has been called. */
  215. static int ComputeId;
  216. static int DBstatus;        /* Set by dbnextrow() */
  217. static int dbNullIsUndef;
  218. static int dbKeepNumeric;
  219. static int dbBin0x;
  220.  
  221. /* Stack pointer for the error routines.  This is set to the stack pointer
  222.    when entering into the sybase subroutines.  Error and message
  223.    handling needs this.  */
  224.  
  225. static int perl_sp;
  226.  
  227. /* Current error handler name. */
  228.  
  229. static char *err_handler_sub;
  230.  
  231. /* Current message handler subroutine name */
  232.  
  233. static char *msg_handler_sub;
  234.  
  235. /* Macro to access the stack.  This is necessary since error handlers may
  236.    call perl routines and thus the stack may change.  I hope most compilers
  237.    will optimize this reasonably. */
  238.  
  239. #define STACK(SP) (stack->ary_array + (SP))
  240.  
  241.  
  242. static int usersub();
  243. static int userset();
  244. static int userval();
  245. static int err_handler(), msg_handler();
  246. static int getDbProc();
  247. static char scriptName[32];
  248.  
  249. int
  250. userinit()
  251. {
  252.     char *p;
  253.     int len;
  254.  
  255.     if(!(p = strrchr(origfilename, '/')))
  256.     p = origfilename;
  257.     else
  258.     ++p;
  259.     if((len = strlen(p)) > 30)
  260.     len = 30;
  261.     strncpy(scriptName, p, len);
  262.     
  263.     init_sybase();
  264. }
  265.  
  266. int
  267. init_sybase()
  268. {
  269.     struct ufuncs uf;
  270.     char *filename = "sybase.c";
  271.  
  272.     if (dbinit() == FAIL)    /* initialize dblibrary */
  273.     exit(ERREXIT);
  274. /*
  275.  * Install the user-supplied error-handling and message-handling routines.
  276.  * They are defined at the bottom of this source file.
  277.  */
  278.     dberrhandle(err_handler);
  279.     dbmsghandle(msg_handler);
  280.  
  281.     if(MAX_DBPROCS > 25)
  282.     dbsetmaxprocs(MAX_DBPROCS);
  283.     
  284.     login = dblogin();
  285.     DBSETLAPP(login, scriptName);
  286.     
  287.     uf.uf_set = userset;
  288.     uf.uf_val = userval;
  289.  
  290. #define MAGICVAR(name, ix) uf.uf_index = ix, magicname(name, &uf, sizeof uf)
  291.  
  292.     MAGICVAR("SUCCEED",    UV_SUCCEED);
  293.     MAGICVAR("FAIL",UV_FAIL);
  294.     MAGICVAR("NO_MORE_ROWS",    UV_NO_MORE_ROWS);
  295.     MAGICVAR("NO_MORE_RESULTS",    UV_NO_MORE_RESULTS);
  296.     MAGICVAR("ComputeId",    UV_ComputeId);
  297.     MAGICVAR("SybperlVer",    UV_SybperlVer);
  298.     MAGICVAR("DBstatus",    UV_DBstatus);
  299. #if DBLIBVS >= 461
  300.     MAGICVAR("STDEXIT",          UV_STDEXIT);
  301.     MAGICVAR("ERREXIT",          UV_ERREXIT);
  302.     MAGICVAR("INT_EXIT",         UV_INT_EXIT);
  303.     MAGICVAR("INT_CONTINUE",     UV_INT_CONTINUE);
  304.     MAGICVAR("INT_CANCEL",       UV_INT_CANCEL);
  305.     MAGICVAR("INT_TIMEOUT",      UV_INT_TIMEOUT);
  306.     MAGICVAR("MORE_ROWS",        UV_MORE_ROWS);
  307.     MAGICVAR("REG_ROW",          UV_REG_ROW);
  308.     MAGICVAR("BUF_FULL",         UV_BUF_FULL);
  309.     MAGICVAR("NO_MORE_PARAMS",   UV_NO_MORE_PARAMS);
  310.     MAGICVAR("DBSAVE",           UV_DBSAVE);
  311.     MAGICVAR("DBNOSAVE",         UV_DBNOSAVE);
  312.     MAGICVAR("DBNOERR",          UV_DBNOERR);
  313.     MAGICVAR("DB_PASSTHRU_MORE", UV_DB_PASSTHRU_MORE);
  314.     MAGICVAR("DB_PASSTHRU_EOM",  UV_DB_PASSTHRU_EOM);
  315.     MAGICVAR("DBNOPROC",         UV_DBNOPROC);
  316.     MAGICVAR("EXCEPTION",        UV_EXCEPTION);
  317.     MAGICVAR("EXSIGNAL",         UV_EXSIGNAL);
  318.     MAGICVAR("EXSCREENIO",       UV_EXSCREENIO);
  319.     MAGICVAR("EXDBLIB",          UV_EXDBLIB);
  320.     MAGICVAR("EXFORMS",          UV_EXFORMS);
  321.     MAGICVAR("EXCLIPBOARD",      UV_EXCLIPBOARD);
  322.     MAGICVAR("EXLOOKUP",         UV_EXLOOKUP);
  323.     MAGICVAR("EXINFO",           UV_EXINFO);
  324.     MAGICVAR("EXUSER",           UV_EXUSER);
  325.     MAGICVAR("EXNONFATAL",       UV_EXNONFATAL);
  326.     MAGICVAR("EXCONVERSION",     UV_EXCONVERSION);
  327.     MAGICVAR("EXSERVER",         UV_EXSERVER);
  328.     MAGICVAR("EXTIME",           UV_EXTIME);
  329.     MAGICVAR("EXPROGRAM",        UV_EXPROGRAM);
  330.     MAGICVAR("EXRESOURCE",       UV_EXRESOURCE);
  331.     MAGICVAR("EXCOMM",           UV_EXCOMM);
  332.     MAGICVAR("EXFATAL",          UV_EXFATAL);
  333.     MAGICVAR("EXCONSISTENCY",    UV_EXCONSISTENCY);
  334. #endif
  335.     MAGICVAR("DB_IN",          UV_DB_IN);
  336.     MAGICVAR("DB_OUT",           UV_DB_OUT);
  337.     MAGICVAR("BCPMAXERRS",       UV_BCPMAXERRS);
  338.     MAGICVAR("BCPFIRST",         UV_BCPFIRST);
  339.     MAGICVAR("BCPLAST",          UV_BCPLAST);
  340.     MAGICVAR("BCPBATCH",         UV_BCPBATCH);
  341.     MAGICVAR("DBTRUE",           UV_DBTRUE);
  342.     MAGICVAR("DBFALSE",          UV_DBFALSE);
  343. #if defined(PACKAGE_BUG)
  344.     MAGICVAR("SybPackageBug",    UV_PACKAGE_BUG);
  345. #endif
  346.     MAGICVAR("dbNullIsUndef",   UV_dbNullIsUndef);
  347.     MAGICVAR("dbKeepNumeric",   UV_dbKeepNumeric);
  348.     MAGICVAR("dbBin0x",         UV_dbBin0x);
  349.  
  350. #if defined(PACKAGE_BUG)    
  351.     make_usub("dbLOGIN",    US_dblogin,    usersub, filename);
  352.     make_usub("dbOPEN",        US_dbopen,    usersub, filename);
  353.     make_usub("dbCLOSE",    US_dbclose,    usersub, filename);
  354.     make_usub("dbCMD",        US_dbcmd,    usersub, filename);
  355.     make_usub("dbSQLEXEC",    US_dbsqlexec,    usersub, filename);
  356.     make_usub("dbRESULTS",    US_dbresults,    usersub, filename);
  357.     make_usub("dbNEXTROW",    US_dbnextrow,    usersub, filename);
  358.     make_usub("dbCANCEL",    US_dbcancel,    usersub, filename);
  359.     make_usub("dbCANQUERY",    US_dbcanquery,    usersub, filename);
  360.     make_usub("dbEXIT",    US_dbexit,    usersub, filename);
  361.     make_usub("dbUSE",    US_dbuse,    usersub, filename);
  362. #ifdef HAS_CALLBACK
  363.     make_usub("dbERRHANDLE", US_dberrhandle, usersub, filename);
  364.     make_usub("dbMSGHANDLE", US_dbmsghandle, usersub, filename);
  365. #endif
  366.     make_usub("dbSTRCPY", US_dbstrcpy, usersub, filename);
  367.     make_usub("dbCURCMD", US_DBCURCMD, usersub, filename);
  368.     make_usub("dbMORECMDS", US_DBMORECMDS, usersub, filename);
  369.     make_usub("dbCMDROW", US_DBCMDROW, usersub, filename);
  370.     make_usub("dbROWS", US_DBROWS, usersub, filename);
  371.     make_usub("dbCOUNT", US_DBCOUNT, usersub, filename);
  372.     make_usub("dbHASRETSTAT", US_dbhasretstat, usersub, filename);
  373.     make_usub("dbRETSTATUS", US_dbretstatus, usersub, filename);
  374.     make_usub("dbRETDATA",   US_dbretdata, usersub, filename);    
  375.     make_usub("dbWRITETEXT", US_dbwritetext, usersub, filename);
  376.     make_usub("dbCOLTYPE",   US_dbcoltype, usersub, filename);
  377.     make_usub("dbCOLNAME",   US_dbcolname, usersub, filename);
  378.     make_usub("dbCOLLEN",    US_dbcollen, usersub, filename);
  379.     make_usub("dbNUMCOLS",   US_dbnumcols, usersub, filename);
  380.     make_usub("dbFREEBUF",   US_dbfreebuf, usersub, filename);
  381.     make_usub("dbSETOPT",    US_dbsetopt, usersub, filename);
  382. #if DBLIBVS >= 420
  383.     make_usub("dbSAFESTR",       US_dbsafestr,    usersub, filename);
  384.     make_usub("dbRECFTOS",       US_dbrecftos,    usersub, filename);
  385. #if DBLIBVS >= 461
  386.     make_usub("dbMNY4ADD",       US_dbmny4add,    usersub, filename);
  387.     make_usub("dbMNY4CMP",       US_dbmny4cmp,    usersub, filename);
  388.     make_usub("dbMNY4DIVIDE",    US_dbmny4divide, usersub, filename);
  389.     make_usub("dbMNY4MINUS",     US_dbmny4minus,  usersub, filename);
  390.     make_usub("dbMNY4MUL",       US_dbmny4mul,    usersub, filename);
  391.     make_usub("dbMNY4SUB",       US_dbmny4sub,    usersub, filename);
  392.     make_usub("dbMNY4ZERO",      US_dbmny4zero,   usersub, filename);
  393.     make_usub("dbMNYADD",        US_dbmnyadd,     usersub, filename);
  394.     make_usub("dbMNYCMP",        US_dbmnycmp,     usersub, filename);
  395.     make_usub("dbMNYDIVIDE",     US_dbmnydivide,  usersub, filename);
  396.     make_usub("dbMNYMINUS",      US_dbmnyminus,   usersub, filename);
  397.     make_usub("dbMNYMUL",        US_dbmnymul,     usersub, filename);
  398.     make_usub("dbMNYSUB",        US_dbmnysub,     usersub, filename);
  399.     make_usub("dbMNYZERO",       US_dbmnyzero,    usersub, filename);
  400.     make_usub("dbMNYDEC",        US_dbmnydec,     usersub, filename);
  401.     make_usub("dbMNYDOWN",       US_dbmnydown,    usersub, filename);
  402.     make_usub("dbMNYINC",        US_dbmnyinc,     usersub, filename);
  403.     make_usub("dbMNYINIT",       US_dbmnyinit,    usersub, filename);
  404.     make_usub("dbMNYMAXNEG",     US_dbmnymaxneg,  usersub, filename);
  405.     make_usub("dbMNYMAXPOS",     US_dbmnymaxpos,  usersub, filename);
  406.     make_usub("dbMNYNDIGIT",     US_dbmnyndigit,  usersub, filename);
  407.     make_usub("dbMNYSCALE",      US_dbmnyscale,   usersub, filename);
  408.     make_usub("bcp_GETL",        US_bcp_getl,     usersub, filename);
  409.     make_usub("dbSETLCHARSET",        US_DBSETLCHARSET,     usersub, filename);
  410.     make_usub("dbSETLNATLANG",        US_DBSETLNATLANG,     usersub, filename);
  411. #endif
  412. #endif
  413.     make_usub("bcp_SETL",        US_BCP_SETL,     usersub, filename);
  414.     make_usub("bcp_INIT",        US_bcp_init,     usersub, filename);
  415.     make_usub("bcp_MEMINIT",     US_bcp_meminit,  usersub, filename);
  416.     make_usub("bcp_SENDROW",     US_bcp_sendrow,  usersub, filename);
  417.     make_usub("bcp_BATCH",       US_bcp_batch,    usersub, filename);
  418.     make_usub("bcp_DONE",        US_bcp_done,     usersub, filename);
  419.     make_usub("bcp_CONTROL",     US_bcp_control,  usersub, filename);
  420.     make_usub("bcp_COLUMNS",     US_bcp_columns,  usersub, filename);
  421.     make_usub("bcp_COLFMT",      US_bcp_colfmt,   usersub, filename);
  422.     make_usub("bcp_COLLEN",      US_bcp_collen,   usersub, filename);
  423.     make_usub("bcp_EXEC",        US_bcp_exec,     usersub, filename);
  424.     make_usub("bcp_READFMT",     US_bcp_readfmt,  usersub, filename);
  425.     make_usub("bcp_WRITEFMT",    US_bcp_writefmt, usersub, filename);
  426. #else
  427.     make_usub("dblogin",    US_dblogin,    usersub, filename);
  428.     make_usub("dbopen",        US_dbopen,    usersub, filename);
  429.     make_usub("dbclose",    US_dbclose,    usersub, filename);
  430.     make_usub("dbcmd",        US_dbcmd,    usersub, filename);
  431.     make_usub("dbsqlexec",    US_dbsqlexec,    usersub, filename);
  432.     make_usub("dbresults",    US_dbresults,    usersub, filename);
  433.     make_usub("dbnextrow",    US_dbnextrow,    usersub, filename);
  434.     make_usub("dbcancel",    US_dbcancel,    usersub, filename);
  435.     make_usub("dbcanquery",    US_dbcanquery,    usersub, filename);
  436.     make_usub("dbexit",    US_dbexit,    usersub, filename);
  437.     make_usub("dbuse",    US_dbuse,    usersub, filename);
  438. #ifdef HAS_CALLBACK
  439.     make_usub("dberrhandle", US_dberrhandle, usersub, filename);
  440.     make_usub("dbmsghandle", US_dbmsghandle, usersub, filename);
  441. #endif
  442.     make_usub("dbstrcpy", US_dbstrcpy, usersub, filename);
  443.     make_usub("DBCURCMD", US_DBCURCMD, usersub, filename);
  444.     make_usub("DBMORECMDS", US_DBMORECMDS, usersub, filename);
  445.     make_usub("DBCMDROW", US_DBCMDROW, usersub, filename);
  446.     make_usub("DBROWS", US_DBROWS, usersub, filename);
  447.     make_usub("DBCOUNT", US_DBCOUNT, usersub, filename);
  448.     make_usub("dbhasretstat", US_dbhasretstat, usersub, filename);
  449.     make_usub("dbretstatus", US_dbretstatus, usersub, filename);
  450.     make_usub("dbretdata", US_dbretdata, usersub, filename);
  451.     make_usub("dbwritetext", US_dbwritetext, usersub, filename);
  452.     make_usub("dbcoltype",   US_dbcoltype, usersub, filename);
  453.     make_usub("dbcolname",   US_dbcolname, usersub, filename);
  454.     make_usub("dbcollen",    US_dbcollen, usersub, filename);
  455.     make_usub("dbnumcols",   US_dbnumcols, usersub, filename);
  456.     make_usub("dbfreebuf",   US_dbfreebuf, usersub, filename);
  457.     make_usub("dbsetopt",    US_dbsetopt, usersub, filename);
  458. #if DBLIBVS >= 420
  459.     make_usub("dbsafestr",       US_dbsafestr,    usersub, filename);
  460.     make_usub("dbrecftos",       US_dbrecftos,    usersub, filename);
  461. #if DBLIBVS >= 461
  462.     make_usub("dbmny4add",       US_dbmny4add,    usersub, filename);
  463.     make_usub("dbmny4cmp",       US_dbmny4cmp,    usersub, filename);
  464.     make_usub("dbmny4divide",    US_dbmny4divide, usersub, filename);
  465.     make_usub("dbmny4minus",     US_dbmny4minus,  usersub, filename);
  466.     make_usub("dbmny4mul",       US_dbmny4mul,    usersub, filename);
  467.     make_usub("dbmny4sub",       US_dbmny4sub,    usersub, filename);
  468.     make_usub("dbmny4zero",      US_dbmny4zero,   usersub, filename);
  469.     make_usub("dbmnyadd",        US_dbmnyadd,     usersub, filename);
  470.     make_usub("dbmnycmp",        US_dbmnycmp,     usersub, filename);
  471.     make_usub("dbmnydivide",     US_dbmnydivide,  usersub, filename);
  472.     make_usub("dbmnyminus",      US_dbmnyminus,   usersub, filename);
  473.     make_usub("dbmnymul",        US_dbmnymul,     usersub, filename);
  474.     make_usub("dbmnysub",        US_dbmnysub,     usersub, filename);
  475.     make_usub("dbmnyzero",       US_dbmnyzero,    usersub, filename);
  476.     make_usub("dbmnydec",        US_dbmnydec,     usersub, filename);
  477.     make_usub("dbmnydown",       US_dbmnydown,    usersub, filename);
  478.     make_usub("dbmnyinc",        US_dbmnyinc,     usersub, filename);
  479.     make_usub("dbmnyinit",       US_dbmnyinit,    usersub, filename);
  480.     make_usub("dbmnymaxneg",     US_dbmnymaxneg,  usersub, filename);
  481.     make_usub("dbmnymaxpos",     US_dbmnymaxpos,  usersub, filename);
  482.     make_usub("dbmnyndigit",     US_dbmnyndigit,  usersub, filename);
  483.     make_usub("dbmnyscale",      US_dbmnyscale,   usersub, filename);
  484.     make_usub("bcp_getl",        US_bcp_getl,     usersub, filename);
  485.     make_usub("DBSETLCHARSET",        US_DBSETLCHARSET,     usersub, filename);
  486.     make_usub("DBSETLNATLANG",        US_DBSETLNATLANG,     usersub, filename);
  487. #endif
  488. #endif
  489.     make_usub("BCP_SETL",        US_BCP_SETL,     usersub, filename);
  490.     make_usub("bcp_init",        US_bcp_init,     usersub, filename);
  491.     make_usub("bcp_meminit",     US_bcp_meminit,  usersub, filename);
  492.     make_usub("bcp_sendrow",     US_bcp_sendrow,  usersub, filename);
  493.     make_usub("bcp_batch",       US_bcp_batch,    usersub, filename);
  494.     make_usub("bcp_done",        US_bcp_done,     usersub, filename);
  495.     make_usub("bcp_control",     US_bcp_control,  usersub, filename);
  496.     make_usub("bcp_columns",     US_bcp_columns,  usersub, filename);
  497.     make_usub("bcp_colfmt",      US_bcp_colfmt,   usersub, filename);
  498.     make_usub("bcp_collen",      US_bcp_collen,   usersub, filename);
  499.     make_usub("bcp_exec",        US_bcp_exec,     usersub, filename);
  500.     make_usub("bcp_readfmt",     US_bcp_readfmt,  usersub, filename);
  501.     make_usub("bcp_writefmt",    US_bcp_writefmt, usersub, filename);
  502. #endif
  503. }
  504.  
  505. static int
  506. usersub(ix, sp, items)
  507. int ix;
  508. register int sp;
  509. register int items;
  510. {
  511.     ARRAY *ary = stack;
  512.     STR *Str;        /* used in str_get and str_gnum macros */
  513.     static int first = 1;    /* set to 0 once a call to dblogin/dbopen */
  514.                 /* has been made */
  515.     int inx = -1;    /* Index into dbProc[] array. Passed as */
  516.                 /* first parameter to nearly all &dbxxx() calls */
  517.  
  518.     if(exitCalled)
  519.     fatal("&dbexit() has been called. Access to Sybase impossible.");
  520.  
  521.     perl_sp = sp + items;    /* Save the stack pointer - */
  522.                 /* required in the case where */
  523.                 /* callbacks are used. */
  524.  
  525.     /* 
  526.      * We're calling some dblib function, but &dblogin has not been 
  527.      * called. Two actions are possible: either fail the call, or call 
  528.      * dbopen with the default info. The second option is enabled
  529.      * AUTO_LOGIN is defined. This saves a couple of keystrokes, but it can
  530.      * only be used if you are in a trusted environment.
  531.      */
  532.     if(first && (ix != US_dblogin) &&
  533.        (ix != US_dbmsghandle) && (ix != US_dberrhandle) && (ix != US_BCP_SETL)
  534. #if DBLIBVS >= 420
  535.        && (ix != US_dbrecftos)
  536. #endif
  537.        )
  538.     {        /* You can call &dbmsghandle/errhandle before calling &dblogin */
  539. #ifdef AUTO_LOGIN
  540.     dbProc[0].dbproc = dbopen(login, NULL);
  541.     first = 0;
  542. #else
  543.     fatal("&dblogin has not been called yet!");
  544. #endif
  545.     }
  546.     
  547.     switch (ix)
  548.     {
  549.       case US_dblogin:
  550.     if (items > 3)
  551.         fatal("Usage: &dblogin([user[,pwd[,server]]])");
  552.     else
  553.     {
  554.         int j = 0;
  555.         char *server = NULL, *user = NULL, *pwd = NULL;
  556.  
  557.         /* Reset the password and user fields in the LOGINREC.
  558.            Otherwise, calling &dblogin with a null password/username
  559.            after calling it with a non-null field will result in
  560.            the non-null value being used... (1.011) */
  561.            
  562.         DBSETLPWD(login, NULL);
  563.         DBSETLUSER(login, NULL);
  564.         
  565.         switch(items)
  566.         {
  567.           case 3:
  568.         if(STACK(sp)[3] != &str_undef)
  569.         {
  570.             server = (char *)str_get(STACK(sp)[3]);
  571.             if(!server || !strlen(server))
  572.             server = NULL;
  573.         }
  574.           case 2:
  575.         if(STACK(sp)[2] != &str_undef)
  576.         {
  577.             pwd = (char *)str_get(STACK(sp)[2]);
  578.             if(pwd && strlen(pwd))
  579.             DBSETLPWD(login, pwd);
  580.         }
  581.           case 1:
  582.         if(STACK(sp)[1] != &str_undef)
  583.         {
  584.             user = (char *)str_get(STACK(sp)[1]);
  585.             if(user && strlen(user))
  586.             DBSETLUSER(login, user);
  587.         }
  588.         }
  589.  
  590.         for(j = 0; j < MAX_DBPROCS; ++j)
  591.         if(dbProc[j].dbproc == NULL)
  592.             break;
  593.         if(j == MAX_DBPROCS)
  594.         fatal ("&dblogin: No more dbprocs available.");
  595.         if((dbProc[j].dbproc = dbopen(login, server)) == NULL)
  596.         j = -1;
  597.  
  598.         first = 0;
  599.         str_numset(STACK(sp)[0], (double) j);
  600.     }
  601.     break;
  602.       case US_dbopen:
  603.     if (items > 1)
  604.         fatal("Usage: $dbproc = &dbopen([server]);");
  605.     else
  606.     {
  607.         int j;
  608.         char *server = NULL;
  609.         
  610.         for(j = 0; j < MAX_DBPROCS; ++j)
  611.         if(dbProc[j].dbproc == NULL)
  612.             break;
  613.         if(j == MAX_DBPROCS)
  614.         fatal("&dbopen: No more dbprocs available.");
  615.         if(items == 1)
  616.         server = (char *)str_get(STACK(sp)[1]);
  617.         
  618.         dbProc[j].dbproc = dbopen(login, server);
  619.         str_numset(STACK(sp)[0], (double) j);
  620.     }
  621.     break;
  622.       case US_dbclose:
  623.     if (items > 1)
  624.         fatal("Usage: $ret = &dbclose($dbproc);");
  625.     else
  626.     {
  627.         if(items)
  628.         inx = getDbProc(STACK(sp)[1]);
  629.         else
  630.         inx = 0;
  631.  
  632.         dbclose(dbProc[inx].dbproc);
  633.         dbProc[inx].dbproc = (DBPROCESS *)NULL;
  634.     }
  635.     break;
  636.       case US_dbcancel:
  637.     if (items > 1)
  638.         fatal("Usage: &dbcancel($dbproc)");
  639.     else
  640.     {
  641.         int retval;
  642.  
  643.         if(items)
  644.         inx = getDbProc(STACK(sp)[1]);
  645.         else
  646.         inx = 0;
  647.  
  648.         retval = dbcancel(dbProc[inx].dbproc);
  649.         str_numset(STACK(sp)[0], (double) retval);
  650.     }
  651.     break;
  652.  
  653.       case US_dbcanquery:
  654.     if (items > 1)
  655.         fatal("Usage: &dbcanquery($dbproc)");
  656.     else
  657.     {
  658.         int retval;
  659.  
  660.         if(items)
  661.         inx = getDbProc(STACK(sp)[1]);
  662.         else
  663.         inx = 0;
  664.  
  665.         retval = dbcanquery(dbProc[inx].dbproc);
  666.         str_numset(STACK(sp)[0], (double) retval);
  667.     }
  668.     break;
  669.  
  670.       case US_dbfreebuf:
  671.     if (items > 1)
  672.         fatal("Usage: &dbfreebuf($dbproc)");
  673.     else
  674.     {
  675.         if(items)
  676.         inx = getDbProc(STACK(sp)[1]);
  677.         else
  678.         inx = 0;
  679.  
  680.         dbfreebuf(dbProc[inx].dbproc); 
  681.         str_numset(STACK(sp)[0], 1.0); /* it's a void function, so just */
  682.                        /* return 1 anyway... */
  683.     }
  684.     break;
  685.     
  686.       case US_dbsetopt:
  687.     if (!(items == 3 || items == 4))
  688.         fatal ("Usage: $ret = &dbsetopt($dbproc,$option, $char_param [,$int_param])");
  689.     else
  690.     {
  691.         int inx, option;
  692.         char *charParam;
  693.         int intParam, ret;
  694.         
  695.         inx = getDbProc(STACK(sp)[1]);
  696.         option = (int)str_gnum(STACK(sp)[2]);
  697.         charParam = str_get(STACK(sp)[3]);
  698.         if(items == 4)
  699.         intParam = (int)str_gnum(STACK(sp)[4]);
  700.         else
  701.         intParam = 0;
  702.         ret = dbsetopt (dbProc[inx].dbproc, option, charParam,intParam);
  703.         str_numset(STACK(sp)[0], (double) ret);
  704.     }
  705.     break;
  706.     
  707.       case US_dbexit:
  708.     if (items != 0)
  709.         fatal("Usage: &dbexit()");
  710.     else
  711.     {
  712.         dbexit();
  713.         exitCalled++;
  714.         str_numset(STACK(sp)[0], (double) 1);
  715.     }
  716.     break;
  717.  
  718.       case US_dbuse:
  719.     if (items > 2)
  720.         fatal("Usage: &dbuse($dbproc, $database)");
  721.     else
  722.     {
  723.         int retval, off;
  724.         char str[255];
  725.         
  726.         if(items == 2)
  727.         {
  728.         inx = getDbProc(STACK(sp)[1]);
  729.         off = 2;
  730.         }
  731.         else
  732.         inx = 0, off = 1;
  733.         
  734.         strcpy(str, (char *)str_get(STACK(sp)[off]));
  735.  
  736.  
  737.         retval = dbuse(dbProc[inx].dbproc, str);
  738.         str_numset(STACK(sp)[0], (double) retval);
  739.     }
  740.     break;
  741.  
  742.       case US_dbsqlexec:
  743.     if (items > 1)
  744.         fatal("Usage: &dbsqlexec($dbproc)");
  745.     else
  746.     {
  747.         int retval;
  748.         if(items)
  749.         inx = getDbProc(STACK(sp)[1]);
  750.         else
  751.         inx = 0;
  752.  
  753.         retval = dbsqlexec(dbProc[inx].dbproc);
  754.         str_numset(STACK(sp)[0], (double) retval);
  755.     }
  756.     break;
  757.  
  758.       case US_dbresults:
  759.     if (items > 1)
  760.         fatal("Usage: &dbresults($dbproc)");
  761.     else
  762.     {
  763.         int retval;
  764.  
  765.         if(items)
  766.         inx = getDbProc(STACK(sp)[1]);
  767.         else
  768.         inx = 0;
  769.  
  770.         retval = dbresults(dbProc[inx].dbproc);
  771.         str_numset(STACK(sp)[0], (double) retval);
  772.     }
  773.     break;
  774.  
  775.       case US_dbcmd:
  776.     if (items > 2)
  777.         fatal("Usage: &dbcmd($dbproc, $str)");
  778.     else
  779.     {
  780.         int retval, off;
  781.  
  782.         if(items == 2)
  783.         {
  784.         inx = getDbProc(STACK(sp)[1]);
  785.         off = 2;
  786.         }
  787.         else
  788.         inx = 0, off = 1;
  789.         retval = dbcmd(dbProc[inx].dbproc, (char *)str_get(STACK(sp)[off]));
  790.         str_numset(STACK(sp)[0], (double) retval);
  791.     }
  792.     break;
  793.  
  794.       case US_dbnextrow:
  795.     if (items > 2)
  796.         fatal("Usage: @arr = &dbnextrow([$dbproc [, $returnAssoc]])");
  797.     else
  798.     {
  799.         int retval;
  800.         char buff[260], *p = NULL, *t;
  801.         BYTE *data;
  802.         int col, type, numcols;
  803.         int len;
  804.         int doAssoc = 0;
  805.         DBFLT8 tmp;
  806.         char *colname;
  807.         char cname[64];
  808.         int is_numeric;
  809.         int is_null;
  810. #if DBLIBVS >= 461
  811.         DBMONEY tv_money;
  812. #endif
  813.  
  814.         inx = 0;
  815.         switch(items)
  816.         {
  817.           case 2:
  818.         doAssoc = (int)str_gnum(STACK(sp)[2]);
  819.           case 1:
  820.         inx = getDbProc(STACK(sp)[1]);
  821.         break;
  822.         }
  823.  
  824.         --sp;        /* get rid of space pre-allocation */
  825.  
  826.         DBstatus = retval = dbnextrow(dbProc[inx].dbproc);
  827.         if(retval == REG_ROW)
  828.         {
  829.         ComputeId = 0;
  830.         numcols = dbnumcols(dbProc[inx].dbproc);
  831.         }
  832.         else
  833.         {
  834.         ComputeId = retval;
  835.         numcols = dbnumalts(dbProc[inx].dbproc, ComputeId);
  836.         }
  837.         for(col = 1, buff[0] = 0; col <= numcols; ++col)
  838.         {
  839.         is_numeric = 0;
  840.         is_null = 0;
  841.         colname = NULL;
  842.         if(!ComputeId)
  843.         {
  844.             type = dbcoltype(dbProc[inx].dbproc, col);
  845.             len = dbdatlen(dbProc[inx].dbproc,col);
  846.             data = (BYTE *)dbdata(dbProc[inx].dbproc,col);
  847.             colname = dbcolname(dbProc[inx].dbproc, col);
  848.             if(!colname || !colname[0])
  849.             {
  850.             sprintf(cname, "Col %d", col);
  851.             colname = cname;
  852.             }
  853.         }
  854.         else
  855.         {
  856.             int colid = dbaltcolid(dbProc[inx].dbproc, ComputeId, col);
  857.             type = dbalttype(dbProc[inx].dbproc, ComputeId, col);
  858.             len = dbadlen(dbProc[inx].dbproc, ComputeId, col);
  859.             data = (BYTE *)dbadata(dbProc[inx].dbproc, ComputeId, col);
  860.             if(colid > 0)
  861.             colname = dbcolname(dbProc[inx].dbproc, colid);
  862.             if(!colname || !colname[0])
  863.             {
  864.             sprintf(cname, "Col %d", col);
  865.             colname = cname;
  866.             }
  867.         }
  868.         t = &buff[0];
  869.         if(!data && !len)
  870.             ++is_null;
  871.         else
  872.         {
  873.             switch(type)
  874.             {
  875.               case SYBCHAR:
  876.             strncpy(buff,data,len);
  877.             buff[len] = 0;
  878.             break;
  879.               case SYBTEXT:
  880.               case SYBIMAGE:
  881.             New(902, p, len + 1, char);
  882.             memcpy(p, data, len);
  883.             p[len] = 0;
  884.             t = p;
  885.             break;
  886.               case SYBINT1:
  887.               case SYBBIT: /* a bit is at least a byte long... */
  888.             if(dbKeepNumeric)
  889.             {
  890.                 tmp = *(DBTINYINT *)data;
  891.                 ++is_numeric;
  892.             }
  893.             else
  894.                 sprintf(buff,"%u",*(DBTINYINT *)data);
  895.             break;
  896.               case SYBINT2:
  897.             if(dbKeepNumeric)
  898.             {
  899.                 tmp = *(DBSMALLINT *)data;
  900.                 ++is_numeric;
  901.             }
  902.             else
  903.             sprintf(buff,"%d",*(DBSMALLINT *)data);
  904.             break;
  905.               case SYBINT4:
  906.             if(dbKeepNumeric)
  907.             {
  908.                 tmp = *(DBINT *)data;
  909.                 ++is_numeric;
  910.             }
  911.             else
  912.                 sprintf(buff,"%d",*(DBINT *)data);
  913.             break;
  914.               case SYBFLT8:
  915.             if(dbKeepNumeric)
  916.             {
  917.                 tmp = *(DBFLT8 *)data;
  918.                 ++is_numeric;
  919.             }
  920.             else
  921.                 sprintf(buff,"%.6f",*(DBFLT8 *)data);
  922.             break;
  923. #if   DBLIBVS >= 461
  924.               case SYBMONEY:
  925.             dbconvert(dbProc[inx].dbproc, SYBMONEY, data, len,
  926.                   SYBMONEY, (BYTE*)&tv_money, -1);
  927.             new_mnytochar(dbProc[inx].dbproc, &tv_money, buff);
  928.             break;
  929. #else
  930.               case SYBMONEY:
  931.             dbconvert(dbProc[inx].dbproc, SYBMONEY, data, len,
  932.                   SYBFLT8, &tmp, -1);
  933.             if(dbKeepNumeric)
  934.                 ++is_numeric;
  935.             else
  936.                 sprintf(buff,"%.6f",tmp);
  937.             break;
  938. #endif
  939.               case SYBDATETIME:
  940.             dbconvert(dbProc[inx].dbproc, SYBDATETIME, data, len,
  941.                   SYBCHAR, buff, -1);
  942.             break;
  943.               case SYBBINARY:
  944.             if(dbBin0x)
  945.             {
  946.                 strcpy(buff, "0x");
  947.                 dbconvert(dbProc[inx].dbproc, type, data, len,
  948.                       SYBCHAR, &buff[2], -1);
  949.             }
  950.             else
  951.                 dbconvert(dbProc[inx].dbproc, type, data, len,
  952.                       SYBCHAR, buff, -1);
  953.             break;
  954. #if DBLIBVS >= 420
  955.               case SYBREAL:
  956.             if(dbKeepNumeric)
  957.             {
  958.                 tmp = *(DBREAL *)data;
  959.                 ++is_numeric;
  960.             }
  961.             else
  962.                 sprintf(buff, "%.6f", (double)*(DBREAL *)data);
  963.             break;
  964.               case SYBDATETIME4:
  965.             dbconvert(dbProc[inx].dbproc, SYBDATETIME4, data, len,
  966.                   SYBCHAR, buff, -1);
  967.             break;
  968. #if DBLIBVS >= 461
  969.               case SYBMONEY4:
  970.             dbconvert(dbProc[inx].dbproc, SYBMONEY4, data, len,
  971.                   SYBMONEY, (BYTE*)&tv_money, -1);
  972.             new_mnytochar(dbProc[inx].dbproc, &tv_money, buff);
  973.             break;
  974. #endif
  975. #endif
  976.               default:
  977.             /* 
  978.              * WARNING!
  979.              * 
  980.              * We convert unknown data types to SYBCHAR 
  981.              * without checking to see if the resulting 
  982.              * string will fit in the 'buff' variable. 
  983.              * This isn't very pretty...
  984.              */
  985.             dbconvert(dbProc[inx].dbproc, type, data, len,
  986.                   SYBCHAR, buff, -1);
  987.             break;
  988.             }
  989.         }
  990.         if(doAssoc)
  991.             (void)astore(ary,++sp,str_2mortal(str_make(colname, 0)));
  992.         if(type != SYBIMAGE && type != SYBTEXT)
  993.             len = 0;    /* str_make needs to know the lenght only on binary data */
  994.         if(is_null)
  995.         {
  996.             if(dbNullIsUndef)
  997.             {
  998.             /* we make a copy of str_undef to be on the safe */
  999.             /* side (we don't want somebody modifying it! */
  1000.             (void)astore(ary,++sp,str_mortal(&str_undef));
  1001.             continue; /* whatever follows here (in this iteration) is irrelevant */
  1002.                   /* when NULLs are returned as undef */
  1003.             }
  1004.             else
  1005.             strcpy(buff,"NULL");
  1006.         }
  1007.         if(is_numeric)
  1008.             (void)astore(ary,++sp,str_2mortal(str_nmake(tmp)));
  1009.         else
  1010.             (void)astore(ary,++sp,str_2mortal(str_make(t, len)));
  1011.         /* 
  1012.          * If we've allocated some space to retrieve a 
  1013.          * SYBTEXT field, then free it now.
  1014.          */
  1015.         if(t == p)
  1016.         {
  1017.             Safefree(p);
  1018.             p = NULL;
  1019.         }
  1020.         }
  1021.     }
  1022.     break;
  1023. #ifdef HAS_CALLBACK
  1024.       case US_dberrhandle:
  1025.     if (items > 1)
  1026.         fatal ("Usage: &dberrhandle($handler)");
  1027.     else
  1028.     {
  1029.         char *old = err_handler_sub;
  1030.         if (items == 1)
  1031.         {
  1032.         if (STACK (sp)[1] == &str_undef)
  1033.             err_handler_sub = 0;
  1034.         else
  1035.         {
  1036.             char *sub = (char *) str_get (STACK (sp)[1]);    
  1037.             New (902, err_handler_sub, strlen (sub) + 1, char);
  1038.             strcpy (err_handler_sub, sub);
  1039.         }
  1040.         }
  1041.  
  1042.         if (old)
  1043.         {
  1044.         STACK (sp)[0] = str_2mortal (str_make (old, strlen (old)));
  1045.         if (items == 1)
  1046.             Safefree (old);
  1047.         }
  1048.         else
  1049.         STACK (sp)[0] = &str_undef;
  1050.     }
  1051.     break;
  1052.       case US_dbmsghandle:
  1053.     if (items > 1)
  1054.         fatal ("Usage: &dbmsghandle($handler)");
  1055.     else
  1056.     {
  1057.         char *old = msg_handler_sub;
  1058.         if (items == 1)
  1059.         {
  1060.         if (STACK (sp)[1] == &str_undef)
  1061.             msg_handler_sub = 0;
  1062.         else
  1063.         {
  1064.             char *sub = (char *) str_get (STACK (sp)[1]);    
  1065.             New (902, msg_handler_sub, strlen (sub) + 1, char);
  1066.             strcpy (msg_handler_sub, sub);
  1067.         }
  1068.         }
  1069.  
  1070.         if (old)
  1071.         {
  1072.         STACK (sp)[0] = str_2mortal (str_make (old, strlen (old)));
  1073.         if (items == 1)
  1074.             Safefree (old);
  1075.         }
  1076.         else
  1077.         STACK (sp)[0] = &str_undef;
  1078.     }
  1079.     break;
  1080. #endif                /* HAS_CALLBACK */
  1081.       case US_dbstrcpy:
  1082.     if (items > 1)
  1083.         fatal("Usage: $string = &dbstrcpy($dbproc)");
  1084.     else
  1085.     {
  1086.         int retval, len;
  1087.         char *buff;
  1088.  
  1089.         if(items)
  1090.         inx = getDbProc(STACK(sp)[1]);
  1091.         else
  1092.         inx = 0;
  1093.  
  1094.         if(dbProc[inx].dbproc && (len = dbstrlen(dbProc[inx].dbproc)))
  1095.         {
  1096.         New(902, buff, len+1, char);
  1097.         retval = dbstrcpy(dbProc[inx].dbproc, 0, -1, buff);
  1098.         str_set(STACK(sp)[0], buff);
  1099.         Safefree(buff);
  1100.         }
  1101.         else
  1102.         str_set(STACK(sp)[0], "");
  1103.     }
  1104.     break;
  1105.  
  1106.       case US_DBCURCMD:
  1107.     if (items > 1)
  1108.         fatal("Usage: $num = &DBCURCMD($dbproc)");
  1109.     else
  1110.     {
  1111.         int retval = 0;
  1112.  
  1113.         if(items)
  1114.         inx = getDbProc(STACK(sp)[1]);
  1115.         else
  1116.         inx = 0;
  1117.  
  1118.         if(dbProc[inx].dbproc)
  1119.         retval = DBCURCMD(dbProc[inx].dbproc);
  1120.  
  1121.         str_numset(STACK(sp)[0], (double) retval);
  1122.     }
  1123.     break;
  1124.       case US_DBMORECMDS:
  1125.     if (items > 1)
  1126.         fatal("Usage: $rc = &DBMORECMDS($dbproc)");
  1127.     else
  1128.     {
  1129.         int retval = 0;
  1130.  
  1131.         if(items)
  1132.         inx = getDbProc(STACK(sp)[1]);
  1133.         else
  1134.         inx = 0;
  1135.  
  1136.         if(dbProc[inx].dbproc)
  1137.         retval = DBMORECMDS(dbProc[inx].dbproc);
  1138.  
  1139.         str_numset(STACK(sp)[0], (double) retval);
  1140.     }
  1141.     break;
  1142.       case US_DBCMDROW:
  1143.     if (items > 1)
  1144.         fatal("Usage: $rc = &DBCMDROW($dbproc)");
  1145.     else
  1146.     {
  1147.         int retval = 0;
  1148.  
  1149.         if(items)
  1150.         inx = getDbProc(STACK(sp)[1]);
  1151.         else
  1152.         inx = 0;
  1153.  
  1154.         if(dbProc[inx].dbproc)
  1155.         retval = DBCMDROW(dbProc[inx].dbproc);
  1156.  
  1157.         str_numset(STACK(sp)[0], (double) retval);
  1158.     }
  1159.     break;
  1160.       case US_DBROWS:
  1161.     if (items > 1)
  1162.         fatal("Usage: $rc = &DBROWS($dbproc)");
  1163.     else
  1164.     {
  1165.         int retval = 0;
  1166.  
  1167.         if(items)
  1168.         inx = getDbProc(STACK(sp)[1]);
  1169.         else
  1170.         inx = 0;
  1171.  
  1172.         if(dbProc[inx].dbproc)
  1173.         retval = DBROWS(dbProc[inx].dbproc);
  1174.  
  1175.         str_numset(STACK(sp)[0], (double) retval);
  1176.     }
  1177.     break;
  1178.       case US_DBCOUNT:
  1179.     if (items > 1)
  1180.         fatal("Usage: $ret = &DBCOUNT($dbproc)");
  1181.     else
  1182.     {
  1183.         int retval = 0;
  1184.  
  1185.         if(items)
  1186.         inx = getDbProc(STACK(sp)[1]);
  1187.         else
  1188.         inx = 0;
  1189.  
  1190.         if(dbProc[inx].dbproc)
  1191.         retval = DBCOUNT(dbProc[inx].dbproc);
  1192.  
  1193.         str_numset(STACK(sp)[0], (double) retval);
  1194.     }
  1195.     break;
  1196.       case US_dbhasretstat:
  1197.     if (items > 1)
  1198.         fatal("Usage: $rc = &dbhasretstat($dbproc)");
  1199.     else
  1200.     {
  1201.         int retval = 0;
  1202.  
  1203.         if(items)
  1204.         inx = getDbProc(STACK(sp)[1]);
  1205.         else
  1206.         inx = 0;
  1207.  
  1208.         if(dbProc[inx].dbproc)
  1209.         retval = dbhasretstat(dbProc[inx].dbproc);
  1210.  
  1211.         str_numset(STACK(sp)[0], (double) retval);
  1212.     }
  1213.     break;
  1214.       case US_dbretstatus:
  1215.     if (items > 1)
  1216.         fatal("Usage: $rc = &dbretstatus($dbproc)");
  1217.     else
  1218.     {
  1219.         int retval = 0;
  1220.  
  1221.         if(items)
  1222.         inx = getDbProc(STACK(sp)[1]);
  1223.         else
  1224.         inx = 0;
  1225.  
  1226.         if(dbProc[inx].dbproc)
  1227.         retval = dbretstatus(dbProc[inx].dbproc);
  1228.  
  1229.         str_numset(STACK(sp)[0], (double) retval);
  1230.     }
  1231.     break;
  1232.       case US_dbretdata:
  1233.     if (items > 2)
  1234.         fatal("Usage: @data = &dbretdata($dbproc [, $doAssoc])");
  1235.     else
  1236.     {
  1237.         int numrets;
  1238.         int retval;
  1239.         char buff[260], *p = NULL, *t;
  1240.         BYTE *data;
  1241.         int col, type;
  1242.         int len;
  1243.         int doAssoc = 0;
  1244.         DBFLT8 tmp;
  1245.         char *colname;
  1246.         char cname[64];
  1247.         int is_numeric;
  1248.         int is_null;
  1249. #if DBLIBVS >= 461
  1250.         DBMONEY tv_money;
  1251. #endif
  1252.         
  1253.         if(items == 2)
  1254.         {
  1255.         inx = getDbProc(STACK(sp)[1]);
  1256.         doAssoc = str_gnum(STACK(sp)[2]);
  1257.         }
  1258.         else
  1259.         inx = 0;
  1260.         --sp;        /* get rid of space pre-allocation */
  1261.         
  1262.         if(!(numrets = dbnumrets(dbProc[inx].dbproc)))
  1263.         break;        /* nothing to return! */
  1264.  
  1265.         for(col = 1, buff[0] = 0; col <= numrets; ++col)
  1266.         {
  1267.         is_numeric = 0;
  1268.         is_null = 0;
  1269.         colname = NULL;
  1270.         type = dbrettype(dbProc[inx].dbproc, col);
  1271.         len = dbretlen(dbProc[inx].dbproc,col);
  1272.         data = (BYTE *)dbretdata(dbProc[inx].dbproc,col);
  1273.         colname = dbretname(dbProc[inx].dbproc, col);
  1274.         if(!colname || !colname[0])
  1275.         {
  1276.             sprintf(cname, "Par %d", col);
  1277.             colname = cname;
  1278.         }
  1279.         t = &buff[0];
  1280.         if(!data && !len)
  1281.             ++is_null;
  1282.         else
  1283.         {
  1284.             switch(type)
  1285.             {
  1286.               case SYBCHAR:
  1287.             strncpy(buff,data,len);
  1288.             buff[len] = 0;
  1289.             break;
  1290.               case SYBTEXT:
  1291.               case SYBIMAGE:
  1292.             New(902, p, len + 1, char);
  1293.             memcpy(p, data, len);
  1294.             p[len] = 0;
  1295.             t = p;
  1296.             break;
  1297.               case SYBINT1:
  1298.               case SYBBIT: /* a bit is at least a byte long... */
  1299.             if(dbKeepNumeric)
  1300.             {
  1301.                 tmp = *(DBTINYINT *)data;
  1302.                 ++is_numeric;
  1303.             }
  1304.             else
  1305.                 sprintf(buff,"%u",*(DBTINYINT *)data);
  1306.             break;
  1307.               case SYBINT2:
  1308.             if(dbKeepNumeric)
  1309.             {
  1310.                 tmp = *(DBSMALLINT *)data;
  1311.                 ++is_numeric;
  1312.             }
  1313.             else
  1314.                 sprintf(buff,"%d",*(DBSMALLINT *)data);
  1315.             break;
  1316.               case SYBINT4:
  1317.             if(dbKeepNumeric)
  1318.             {
  1319.                 tmp = *(DBINT *)data;
  1320.                 ++is_numeric;
  1321.             }
  1322.             else
  1323.                 sprintf(buff,"%d",*(DBINT *)data);
  1324.             break;
  1325.               case SYBFLT8:
  1326.             if(dbKeepNumeric)
  1327.             {
  1328.                 tmp = *(DBFLT8 *)data;
  1329.                 ++is_numeric;
  1330.             }
  1331.             else
  1332.                 sprintf(buff,"%.6f",*(DBFLT8 *)data);
  1333.             break;
  1334. #if   DBLIBVS >= 461
  1335.               case SYBMONEY:
  1336.             dbconvert(dbProc[inx].dbproc, SYBMONEY, data, len,
  1337.                   SYBMONEY, (BYTE*)&tv_money, -1);
  1338.             new_mnytochar(dbProc[inx].dbproc, &tv_money, buff);
  1339.             break;
  1340. #else
  1341.               case SYBMONEY:
  1342.             dbconvert(dbProc[inx].dbproc, SYBMONEY, data, len,
  1343.                   SYBFLT8, &tmp, -1);
  1344.             if(dbKeepNumeric)
  1345.                 ++is_numeric;
  1346.             else
  1347.                 sprintf(buff,"%.6f",tmp);
  1348.             break;
  1349. #endif
  1350.               case SYBDATETIME:
  1351.             dbconvert(dbProc[inx].dbproc, SYBDATETIME, data, len,
  1352.                   SYBCHAR, buff, -1);
  1353.             break;
  1354.               case SYBBINARY:
  1355.             if(dbBin0x)
  1356.             {
  1357.                 strcpy(buff, "0x");
  1358.                 dbconvert(dbProc[inx].dbproc, type, data, len,
  1359.                       SYBCHAR, &buff[2], -1);
  1360.             }
  1361.             else
  1362.                 dbconvert(dbProc[inx].dbproc, type, data, len,
  1363.                       SYBCHAR, buff, -1);
  1364.             break;
  1365. #if DBLIBVS >= 420
  1366.               case SYBREAL:
  1367.             if(dbKeepNumeric)
  1368.             {
  1369.                 tmp = *(DBREAL *)data;
  1370.                 ++is_numeric;
  1371.             }
  1372.             else
  1373.                 sprintf(buff, "%.6f", (double)*(DBREAL *)data);
  1374.             break;
  1375.               case SYBDATETIME4:
  1376.             dbconvert(dbProc[inx].dbproc, SYBDATETIME4, data, len,
  1377.                   SYBCHAR, buff, -1);
  1378.             break;
  1379. #if DBLIBVS >= 461
  1380.               case SYBMONEY4:
  1381.             dbconvert(dbProc[inx].dbproc, SYBMONEY4, data, len,
  1382.                   SYBMONEY, (BYTE*)&tv_money, -1);
  1383.             new_mnytochar(dbProc[inx].dbproc, &tv_money, buff);
  1384.             break;
  1385. #endif
  1386. #endif
  1387.               default:
  1388.             /* 
  1389.              * WARNING!
  1390.              * 
  1391.              * We convert unknown data types to SYBCHAR 
  1392.              * without checking to see if the resulting 
  1393.              * string will fit in the 'buff' variable. 
  1394.              * This isn't very pretty...
  1395.              */
  1396.             dbconvert(dbProc[inx].dbproc, type, data, len,
  1397.                   SYBCHAR, buff, -1);
  1398.             break;
  1399.             }
  1400.         }
  1401.         if(doAssoc)
  1402.             (void)astore(ary,++sp,str_2mortal(str_make(colname, 0)));
  1403.         if(type != SYBIMAGE && type != SYBTEXT)
  1404.             len = 0;    /* str_make needs to know the lenght only on binary data */
  1405.         if(is_null)
  1406.         {
  1407.             if(dbNullIsUndef)
  1408.             {
  1409.             (void)astore(ary,++sp,str_mortal(&str_undef));
  1410.             continue; /* skip the rest of the processing */
  1411.                   /* in this iteration */
  1412.             }
  1413.             else
  1414.             strcpy(buff,"NULL");
  1415.         }
  1416.         if(is_numeric)
  1417.             (void)astore(ary,++sp,str_2mortal(str_nmake(tmp)));
  1418.         else
  1419.             (void)astore(ary,++sp,str_2mortal(str_make(t, len)));
  1420.         /* 
  1421.          * If we've allocated some space to retrieve a 
  1422.          * SYBTEXT field, then free it now.
  1423.          */
  1424.         if(t == p)
  1425.         {
  1426.             Safefree(p);
  1427.             p = NULL;
  1428.         }
  1429.         }
  1430.     }
  1431.     break;
  1432. #if DBLIBVS >= 420
  1433.       case US_dbsafestr:
  1434.     if (!(items == 3 || items == 2))
  1435.         fatal ("Usage: $string = &dbsafestr($dbproc,$instring[,$quote_char])");
  1436.     else
  1437.     {
  1438.         int retval, len, quote;
  1439.         char *buff, *instr;
  1440.         
  1441.         inx = getDbProc (STACK (sp)[1]);
  1442.         
  1443.         instr = (char *) str_get (STACK (sp)[2]);
  1444.         if (items != 3)
  1445.         quote = DBBOTH;
  1446.         else
  1447.         {
  1448.         char *quote_char = (char *) str_get (STACK (sp)[3]);
  1449.         if (*quote_char == '\"') /* " (to make hilite.el happy */
  1450.             quote = DBDOUBLE;
  1451.         else if (*quote_char == '\'')
  1452.             quote = DBSINGLE;
  1453.         else
  1454.         { /* invalid  */
  1455.             str_set (STACK (sp)[0], "");
  1456.             break;
  1457.         }
  1458.         }
  1459.         if (dbProc[inx].dbproc && (len = strlen (instr)))
  1460.         {
  1461.         /* twice as much space needed worst case */
  1462.         New (902, buff, len * 2 + 1, char);
  1463.         retval = dbsafestr (dbProc[inx].dbproc, instr, -1, buff, -1, quote);
  1464.                 str_set (STACK (sp)[0], buff);
  1465.                 Safefree (buff);
  1466.         }
  1467.     }
  1468.     break;
  1469. #if DBLIBVS >= 461
  1470.       case US_dbmny4add:
  1471.     if ((items > 3) || (items < 2 ))
  1472.         {
  1473.         fatal("Usage: @arr = &dbmny4add($dbproc, $m1, $m2)");
  1474.         }
  1475.     else
  1476.     {
  1477.         int      retval, off1, off2;
  1478.         DBMONEY4 m1, m2, mresult;
  1479.             DBCHAR   mnybuf[40];
  1480.  
  1481.         if(items == 3)
  1482.         {
  1483.         inx  = getDbProc(STACK(sp)[1]);
  1484.         off1 = 2;
  1485.         off2 = 3;
  1486.         }
  1487.         else
  1488.         {
  1489.         inx  = 0;
  1490.         off1 = 1;
  1491.         off2 = 2;
  1492.             }
  1493.  
  1494.         if (dbconvert(dbProc[inx].dbproc, SYBCHAR,
  1495.               (char *)str_get(STACK(sp)[off1]), (DBINT)-1,
  1496.               SYBMONEY4, (BYTE*)&m1, (DBINT)-1) == -1)
  1497.             {
  1498.            fatal("Invalid dbconvert() for &dbmny4add $m1 parameter");
  1499.             }
  1500.  
  1501.         if (dbconvert(dbProc[inx].dbproc, SYBCHAR,
  1502.               (char *)str_get(STACK(sp)[off2]), (DBINT)-1,
  1503.               SYBMONEY4, (BYTE*)&m2, (DBINT)-1) == -1)
  1504.             {
  1505.            fatal("Invalid dbconvert() for &dbmny4add $m2 parameter");
  1506.             }
  1507.  
  1508.         retval = dbmny4add(dbProc[inx].dbproc, &m1, &m2, &mresult);
  1509.  
  1510.             new_mny4tochar(dbProc[inx].dbproc, &mresult, mnybuf);
  1511.  
  1512.             --sp;  /* readjust to get rid of space preallocation */
  1513.  
  1514.             (void)astore(ary,++sp,str_2mortal(str_nmake((double)retval)));
  1515.         (void)astore(ary,++sp,str_2mortal(str_make(mnybuf, 0)));
  1516.     }
  1517.     break;
  1518.       case US_dbmny4cmp:
  1519.     if ((items > 3) || (items < 2 ))
  1520.         {
  1521.         fatal("Usage: &dbmny4cmp($dbproc, $m1, $m2)");
  1522.         }
  1523.     else
  1524.     {
  1525.         int      retval, off1, off2;
  1526.         DBMONEY4 m1, m2;
  1527.  
  1528.         if(items == 3)
  1529.         {
  1530.         inx  = getDbProc(STACK(sp)[1]);
  1531.         off1 = 2;
  1532.         off2 = 3;
  1533.         }
  1534.         else
  1535.         {
  1536.         inx  = 0;
  1537.         off1 = 1;
  1538.         off2 = 2;
  1539.             }
  1540.  
  1541.         if (dbconvert(dbProc[inx].dbproc, SYBCHAR,
  1542.               (char *)str_get(STACK(sp)[off1]), (DBINT)-1,
  1543.               SYBMONEY4, (BYTE*)&m1, (DBINT)-1) == -1)
  1544.             {
  1545.            fatal("Invalid dbconvert() for &dbmny4cmp $m1 parameter");
  1546.             }
  1547.  
  1548.         if (dbconvert(dbProc[inx].dbproc, SYBCHAR,
  1549.               (char *)str_get(STACK(sp)[off2]), (DBINT)-1,
  1550.               SYBMONEY4, (BYTE*)&m2, (DBINT)-1) == -1)
  1551.             {
  1552.            fatal("Invalid dbconvert() for &dbmny4cmp $m2 parameter");
  1553.             }
  1554.  
  1555.         retval = dbmny4cmp(dbProc[inx].dbproc, &m1, &m2);
  1556.  
  1557.         str_numset(STACK(sp)[0], (double)retval);
  1558.     }
  1559.     break;
  1560.       case US_dbmny4divide:
  1561.     if ((items > 3) || (items < 2 ))
  1562.         {
  1563.         fatal("Usage: @arr = &dbmny4divide($dbproc, $m1, $m2)");
  1564.         }
  1565.     else
  1566.     {
  1567.         int      retval, off1, off2;
  1568.         DBMONEY4 m1, m2, mresult;
  1569.             DBCHAR   mnybuf[40];
  1570.  
  1571.         if(items == 3)
  1572.         {
  1573.         inx  = getDbProc(STACK(sp)[1]);
  1574.         off1 = 2;
  1575.         off2 = 3;
  1576.         }
  1577.         else
  1578.         {
  1579.         inx  = 0;
  1580.         off1 = 1;
  1581.         off2 = 2;
  1582.             }
  1583.  
  1584.         if (dbconvert(dbProc[inx].dbproc, SYBCHAR,
  1585.               (char *)str_get(STACK(sp)[off1]), (DBINT)-1,
  1586.               SYBMONEY4, (BYTE*)&m1, (DBINT)-1) == -1)
  1587.             {
  1588.            fatal("Invalid dbconvert() for &dbmny4divide $m1 parameter");
  1589.             }
  1590.  
  1591.         if (dbconvert(dbProc[inx].dbproc, SYBCHAR,
  1592.               (char *)str_get(STACK(sp)[off2]), (DBINT)-1,
  1593.               SYBMONEY4, (BYTE*)&m2, (DBINT)-1) == -1)
  1594.             {
  1595.            fatal("Invalid dbconvert() for &dbmny4divide $m2 parameter");
  1596.             }
  1597.  
  1598.         retval = dbmny4divide(dbProc[inx].dbproc, &m1, &m2, &mresult);
  1599.  
  1600.             new_mny4tochar(dbProc[inx].dbproc, &mresult, mnybuf);
  1601.  
  1602.             --sp;  /* readjust to get rid of space preallocation */
  1603.  
  1604.             (void)astore(ary,++sp,str_2mortal(str_nmake((double)retval)));
  1605.         (void)astore(ary,++sp,str_2mortal(str_make(mnybuf, 0)));
  1606.     }
  1607.     break;
  1608.       case US_dbmny4minus:
  1609.     if ((items > 2) || (items < 1 ))
  1610.         {
  1611.         fatal("Usage: @arr = &dbmny4minus($dbproc, $m1)");
  1612.         }
  1613.     else
  1614.     {
  1615.         int      retval, off1;
  1616.         DBMONEY4 m1, mresult;
  1617.             DBCHAR   mnybuf[40];
  1618.  
  1619.         if(items == 2)
  1620.         {
  1621.         inx  = getDbProc(STACK(sp)[1]);
  1622.         off1 = 2;
  1623.         }
  1624.         else
  1625.         {
  1626.         inx  = 0;
  1627.         off1 = 1;
  1628.             }
  1629.  
  1630.         if (dbconvert(dbProc[inx].dbproc, SYBCHAR,
  1631.               (char *)str_get(STACK(sp)[off1]), (DBINT)-1,
  1632.               SYBMONEY4, (BYTE*)&m1, (DBINT)-1) == -1)
  1633.             {
  1634.            fatal("Invalid dbconvert() for &dbmny4minus $m1 parameter");
  1635.             }
  1636.  
  1637.         retval = dbmny4minus(dbProc[inx].dbproc, &m1, &mresult);
  1638.  
  1639.             new_mny4tochar(dbProc[inx].dbproc, &mresult, mnybuf);
  1640.  
  1641.             --sp;  /* readjust to get rid of space preallocation */
  1642.  
  1643.             (void)astore(ary,++sp,str_2mortal(str_nmake((double)retval)));
  1644.         (void)astore(ary,++sp,str_2mortal(str_make(mnybuf, 0)));
  1645.     }
  1646.     break;
  1647.       case US_dbmny4mul:
  1648.     if ((items > 3) || (items < 2 ))
  1649.         {
  1650.         fatal("Usage: @arr = &dbmny4mul($dbproc, $m1, $m2)");
  1651.         }
  1652.     else
  1653.     {
  1654.         int      retval, off1, off2;
  1655.         DBMONEY4 m1, m2, mresult;
  1656.             DBMONEY  tv_money;
  1657.             DBCHAR   mnybuf[40];
  1658.  
  1659.         if(items == 3)
  1660.         {
  1661.         inx  = getDbProc(STACK(sp)[1]);
  1662.         off1 = 2;
  1663.         off2 = 3;
  1664.         }
  1665.         else
  1666.         {
  1667.         inx  = 0;
  1668.         off1 = 1;
  1669.         off2 = 2;
  1670.             }
  1671.  
  1672.         if (dbconvert(dbProc[inx].dbproc, SYBCHAR,
  1673.               (char *)str_get(STACK(sp)[off1]), (DBINT)-1,
  1674.               SYBMONEY4, (BYTE*)&m1, (DBINT)-1) == -1)
  1675.             {
  1676.            fatal("Invalid dbconvert() for &dbmny4mul $m1 parameter");
  1677.             }
  1678.  
  1679.         if (dbconvert(dbProc[inx].dbproc, SYBCHAR,
  1680.               (char *)str_get(STACK(sp)[off2]), (DBINT)-1,
  1681.               SYBMONEY4, (BYTE*)&m2, (DBINT)-1) == -1)
  1682.             {
  1683.            fatal("Invalid dbconvert() for &dbmny4mul $m2 parameter");
  1684.             }
  1685.  
  1686.         retval = dbmny4mul(dbProc[inx].dbproc, &m1, &m2, &mresult);
  1687.  
  1688.             new_mny4tochar(dbProc[inx].dbproc, &mresult, mnybuf);
  1689.  
  1690.             --sp;  /* readjust to get rid of space preallocation */
  1691.  
  1692.             (void)astore(ary,++sp,str_2mortal(str_nmake((double)retval)));
  1693.         (void)astore(ary,++sp,str_2mortal(str_make(mnybuf, 0)));
  1694.     }
  1695.     break;
  1696.       case US_dbmny4sub:
  1697.     if ((items > 3) || (items < 2 ))
  1698.         {
  1699.         fatal("Usage: @arr = &dbmny4sub($dbproc, $m1, $m2)");
  1700.         }
  1701.     else
  1702.     {
  1703.         int      retval, off1, off2;
  1704.         DBMONEY4 m1, m2, mresult;
  1705.             DBCHAR   mnybuf[40];
  1706.  
  1707.         if(items == 3)
  1708.         {
  1709.         inx  = getDbProc(STACK(sp)[1]);
  1710.         off1 = 2;
  1711.         off2 = 3;
  1712.         }
  1713.         else
  1714.         {
  1715.         inx  = 0;
  1716.         off1 = 1;
  1717.         off2 = 2;
  1718.             }
  1719.  
  1720.         if (dbconvert(dbProc[inx].dbproc, SYBCHAR,
  1721.               (char *)str_get(STACK(sp)[off1]), (DBINT)-1,
  1722.               SYBMONEY4, (BYTE*)&m1, (DBINT)-1) == -1)
  1723.             {
  1724.            fatal("Invalid dbconvert() for &dbmny4sub $m1 parameter");
  1725.             }
  1726.  
  1727.         if (dbconvert(dbProc[inx].dbproc, SYBCHAR,
  1728.               (char *)str_get(STACK(sp)[off2]), (DBINT)-1,
  1729.               SYBMONEY4, (BYTE*)&m2, (DBINT)-1) == -1)
  1730.             {
  1731.            fatal("Invalid dbconvert() for &dbmny4sub $m2 parameter");
  1732.             }
  1733.  
  1734.         retval = dbmny4sub(dbProc[inx].dbproc, &m1, &m2, &mresult);
  1735.  
  1736.             new_mny4tochar(dbProc[inx].dbproc, &mresult, mnybuf);
  1737.  
  1738.             --sp;  /* readjust to get rid of space preallocation */
  1739.  
  1740.             (void)astore(ary,++sp,str_2mortal(str_nmake((double)retval)));
  1741.         (void)astore(ary,++sp,str_2mortal(str_make(mnybuf, 0)));
  1742.     }
  1743.     break;
  1744.       case US_dbmny4zero:
  1745.     if (items > 1)
  1746.         {
  1747.         fatal("Usage: @arr = &dbmny4zero($dbproc)");
  1748.         }
  1749.     else
  1750.     {
  1751.         int      retval;
  1752.         DBMONEY4 mresult;
  1753.             DBMONEY  tv_money;
  1754.             DBCHAR   mnybuf[40];
  1755.  
  1756.         if(items == 1)
  1757.         {
  1758.         inx = getDbProc(STACK(sp)[1]);
  1759.         }
  1760.         else
  1761.         {
  1762.         inx = 0;
  1763.             }
  1764.  
  1765.         retval = dbmny4zero(dbProc[inx].dbproc, &mresult);
  1766.  
  1767.             new_mny4tochar(dbProc[inx].dbproc, &mresult, mnybuf);
  1768.  
  1769.             --sp;  /* readjust to get rid of space preallocation */
  1770.  
  1771.             (void)astore(ary,++sp,str_2mortal(str_nmake((double)retval)));
  1772.         (void)astore(ary,++sp,str_2mortal(str_make(mnybuf, 0)));
  1773.     }
  1774.     break;
  1775.       case US_dbmnyadd:
  1776.     if ((items > 3) || (items < 2 ))
  1777.         {
  1778.         fatal("Usage: @arr = &dbmnyadd($dbproc, $m1, $m2)");
  1779.         }
  1780.     else
  1781.     {
  1782.         int     retval, off1, off2;
  1783.         DBMONEY m1, m2, mresult;
  1784.             DBCHAR  mnybuf[40];
  1785.  
  1786.         if(items == 3)
  1787.         {
  1788.         inx  = getDbProc(STACK(sp)[1]);
  1789.         off1 = 2;
  1790.         off2 = 3;
  1791.         }
  1792.         else
  1793.         {
  1794.         inx  = 0;
  1795.         off1 = 1;
  1796.         off2 = 2;
  1797.             }
  1798.  
  1799.         if (dbconvert(dbProc[inx].dbproc, SYBCHAR,
  1800.               (char *)str_get(STACK(sp)[off1]), (DBINT)-1,
  1801.               SYBMONEY, (BYTE*)&m1, (DBINT)-1) == -1)
  1802.             {
  1803.            fatal("Invalid dbconvert() for &dbmnyadd $m1 parameter");
  1804.             }
  1805.  
  1806.         if (dbconvert(dbProc[inx].dbproc, SYBCHAR,
  1807.               (char *)str_get(STACK(sp)[off2]), (DBINT)-1,
  1808.               SYBMONEY, (BYTE*)&m2, (DBINT)-1) == -1)
  1809.             {
  1810.            fatal("Invalid dbconvert() for &dbmnyadd $m2 parameter");
  1811.             }
  1812.  
  1813.         retval = dbmnyadd(dbProc[inx].dbproc, &m1, &m2, &mresult);
  1814.  
  1815.             new_mnytochar(dbProc[inx].dbproc, &mresult, mnybuf);
  1816.  
  1817.             --sp;  /* readjust to get rid of space preallocation */
  1818.  
  1819.             (void)astore(ary,++sp,str_2mortal(str_nmake((double)retval)));
  1820.         (void)astore(ary,++sp,str_2mortal(str_make(mnybuf, 0)));
  1821.     }
  1822.     break;
  1823.       case US_dbmnycmp:
  1824.     if ((items > 3) || (items < 2 ))
  1825.         {
  1826.         fatal("Usage: &dbmnycmp($dbproc, $m1, $m2)");
  1827.         }
  1828.     else
  1829.     {
  1830.         int     retval, off1, off2;
  1831.         DBMONEY m1, m2;
  1832.  
  1833.         if(items == 3)
  1834.         {
  1835.         inx  = getDbProc(STACK(sp)[1]);
  1836.         off1 = 2;
  1837.         off2 = 3;
  1838.         }
  1839.         else
  1840.         {
  1841.         inx  = 0;
  1842.         off1 = 1;
  1843.         off2 = 2;
  1844.             }
  1845.  
  1846.         if (dbconvert(dbProc[inx].dbproc, SYBCHAR,
  1847.               (char *)str_get(STACK(sp)[off1]), (DBINT)-1,
  1848.               SYBMONEY, (BYTE*)&m1, (DBINT)-1) == -1)
  1849.             {
  1850.            fatal("Invalid dbconvert() for &dbmnycmp $m1 parameter");
  1851.             }
  1852.  
  1853.         if (dbconvert(dbProc[inx].dbproc, SYBCHAR,
  1854.               (char *)str_get(STACK(sp)[off2]), (DBINT)-1,
  1855.               SYBMONEY, (BYTE*)&m2, (DBINT)-1) == -1)
  1856.             {
  1857.            fatal("Invalid dbconvert() for &dbmnycmp $m2 parameter");
  1858.             }
  1859.  
  1860.         retval = dbmnycmp(dbProc[inx].dbproc, &m1, &m2);
  1861.  
  1862.         str_numset(STACK(sp)[0], (double)retval);
  1863.     }
  1864.     break;
  1865.       case US_dbmnydivide:
  1866.     if ((items > 3) || (items < 2 ))
  1867.         {
  1868.         fatal("Usage: @arr = &dbmnydivide($dbproc, $m1, $m2)");
  1869.         }
  1870.     else
  1871.     {
  1872.         int     retval, off1, off2;
  1873.         DBMONEY m1, m2, mresult;
  1874.             DBCHAR  mnybuf[40];
  1875.  
  1876.         if(items == 3)
  1877.         {
  1878.         inx  = getDbProc(STACK(sp)[1]);
  1879.         off1 = 2;
  1880.         off2 = 3;
  1881.         }
  1882.         else
  1883.         {
  1884.         inx  = 0;
  1885.         off1 = 1;
  1886.         off2 = 2;
  1887.             }
  1888.  
  1889.         if (dbconvert(dbProc[inx].dbproc, SYBCHAR,
  1890.               (char *)str_get(STACK(sp)[off1]), (DBINT)-1,
  1891.               SYBMONEY, (BYTE*)&m1, (DBINT)-1) == -1)
  1892.             {
  1893.            fatal("Invalid dbconvert() for &dbmnydivide $m1 parameter");
  1894.             }
  1895.  
  1896.         if (dbconvert(dbProc[inx].dbproc, SYBCHAR,
  1897.               (char *)str_get(STACK(sp)[off2]), (DBINT)-1,
  1898.               SYBMONEY, (BYTE*)&m2, (DBINT)-1) == -1)
  1899.             {
  1900.            fatal("Invalid dbconvert() for &dbmnydivide $m2 parameter");
  1901.             }
  1902.  
  1903.         retval = dbmnydivide(dbProc[inx].dbproc, &m1, &m2, &mresult);
  1904.  
  1905.             new_mnytochar(dbProc[inx].dbproc, &mresult, mnybuf);
  1906.  
  1907.             --sp;  /* readjust to get rid of space preallocation */
  1908.  
  1909.             (void)astore(ary,++sp,str_2mortal(str_nmake((double)retval)));
  1910.         (void)astore(ary,++sp,str_2mortal(str_make(mnybuf, 0)));
  1911.     }
  1912.     break;
  1913.       case US_dbmnyminus:
  1914.     if ((items > 2) || (items < 1 ))
  1915.         {
  1916.         fatal("Usage: @arr = &dbmnyminus($dbproc, $m1)");
  1917.         }
  1918.     else
  1919.     {
  1920.         int     retval, off1;
  1921.         DBMONEY m1, mresult;
  1922.             DBCHAR  mnybuf[40];
  1923.  
  1924.         if(items == 2)
  1925.         {
  1926.         inx  = getDbProc(STACK(sp)[1]);
  1927.         off1 = 2;
  1928.         }
  1929.         else
  1930.         {
  1931.         inx  = 0;
  1932.         off1 = 1;
  1933.             }
  1934.  
  1935.         if (dbconvert(dbProc[inx].dbproc, SYBCHAR,
  1936.               (char *)str_get(STACK(sp)[off1]), (DBINT)-1,
  1937.               SYBMONEY, (BYTE*)&m1, (DBINT)-1) == -1)
  1938.             {
  1939.            fatal("Invalid dbconvert() for &dbmnyminus $m1 parameter");
  1940.             }
  1941.  
  1942.         retval = dbmnyminus(dbProc[inx].dbproc, &m1, &mresult);
  1943.  
  1944.             new_mnytochar(dbProc[inx].dbproc, &mresult, mnybuf);
  1945.  
  1946.             --sp;  /* readjust to get rid of space preallocation */
  1947.  
  1948.             (void)astore(ary,++sp,str_2mortal(str_nmake((double)retval)));
  1949.         (void)astore(ary,++sp,str_2mortal(str_make(mnybuf, 0)));
  1950.     }
  1951.     break;
  1952.       case US_dbmnymul:
  1953.     if ((items > 3) || (items < 2 ))
  1954.         {
  1955.         fatal("Usage: @arr = &dbmnymul($dbproc, $m1, $m2)");
  1956.         }
  1957.     else
  1958.     {
  1959.         int     retval, off1, off2;
  1960.         DBMONEY m1, m2, mresult;
  1961.             DBCHAR  mnybuf[40];
  1962.  
  1963.         if(items == 3)
  1964.         {
  1965.         inx  = getDbProc(STACK(sp)[1]);
  1966.         off1 = 2;
  1967.         off2 = 3;
  1968.         }
  1969.         else
  1970.         {
  1971.         inx  = 0;
  1972.         off1 = 1;
  1973.         off2 = 2;
  1974.             }
  1975.  
  1976.         if (dbconvert(dbProc[inx].dbproc, SYBCHAR,
  1977.               (char *)str_get(STACK(sp)[off1]), (DBINT)-1,
  1978.               SYBMONEY, (BYTE*)&m1, (DBINT)-1) == -1)
  1979.             {
  1980.            fatal("Invalid dbconvert() for &dbmnymul $m1 parameter");
  1981.             }
  1982.  
  1983.         if (dbconvert(dbProc[inx].dbproc, SYBCHAR,
  1984.               (char *)str_get(STACK(sp)[off2]), (DBINT)-1,
  1985.               SYBMONEY, (BYTE*)&m2, (DBINT)-1) == -1)
  1986.             {
  1987.            fatal("Invalid dbconvert() for &dbmnymul $m2 parameter");
  1988.             }
  1989.  
  1990.         retval = dbmnymul(dbProc[inx].dbproc, &m1, &m2, &mresult);
  1991.  
  1992.             new_mnytochar(dbProc[inx].dbproc, &mresult, mnybuf);
  1993.  
  1994.             --sp;  /* readjust to get rid of space preallocation */
  1995.  
  1996.             (void)astore(ary,++sp,str_2mortal(str_nmake((double)retval)));
  1997.         (void)astore(ary,++sp,str_2mortal(str_make(mnybuf, 0)));
  1998.     }
  1999.     break;
  2000.       case US_dbmnysub:
  2001.     if ((items > 3) || (items < 2 ))
  2002.         {
  2003.         fatal("Usage: @arr = &dbmnysub($dbproc, $m1, $m2)");
  2004.         }
  2005.     else
  2006.     {
  2007.         int     retval, off1, off2;
  2008.         DBMONEY m1, m2, mresult;
  2009.             DBCHAR  mnybuf[40];
  2010.  
  2011.         if(items == 3)
  2012.         {
  2013.         inx  = getDbProc(STACK(sp)[1]);
  2014.         off1 = 2;
  2015.         off2 = 3;
  2016.         }
  2017.         else
  2018.         {
  2019.         inx  = 0;
  2020.         off1 = 1;
  2021.         off2 = 2;
  2022.             }
  2023.  
  2024.         if (dbconvert(dbProc[inx].dbproc, SYBCHAR,
  2025.               (char *)str_get(STACK(sp)[off1]), (DBINT)-1,
  2026.               SYBMONEY, (BYTE*)&m1, (DBINT)-1) == -1)
  2027.             {
  2028.            fatal("Invalid dbconvert() for &dbmnysub $m1 parameter");
  2029.             }
  2030.  
  2031.         if (dbconvert(dbProc[inx].dbproc, SYBCHAR,
  2032.               (char *)str_get(STACK(sp)[off2]), (DBINT)-1,
  2033.               SYBMONEY, (BYTE*)&m2, (DBINT)-1) == -1)
  2034.             {
  2035.            fatal("Invalid dbconvert() for &dbmnysub $m2 parameter");
  2036.             }
  2037.  
  2038.         retval = dbmnysub(dbProc[inx].dbproc, &m1, &m2, &mresult);
  2039.  
  2040.             new_mnytochar(dbProc[inx].dbproc, &mresult, mnybuf);
  2041.  
  2042.             --sp;  /* readjust to get rid of space preallocation */
  2043.  
  2044.             (void)astore(ary,++sp,str_2mortal(str_nmake((double)retval)));
  2045.         (void)astore(ary,++sp,str_2mortal(str_make(mnybuf, 0)));
  2046.     }
  2047.     break;
  2048.       case US_dbmnyzero:
  2049.     if (items > 1)
  2050.         {
  2051.         fatal("Usage: @arr = &dbmnyzero($dbproc)");
  2052.         }
  2053.     else
  2054.     {
  2055.         int     retval;
  2056.         DBMONEY mresult;
  2057.             DBCHAR  mnybuf[40];
  2058.  
  2059.         if(items == 1)
  2060.         {
  2061.         inx = getDbProc(STACK(sp)[1]);
  2062.         }
  2063.         else
  2064.         {
  2065.         inx = 0;
  2066.             }
  2067.  
  2068.         retval = dbmnyzero(dbProc[inx].dbproc, &mresult);
  2069.  
  2070.             new_mnytochar(dbProc[inx].dbproc, &mresult, mnybuf);
  2071.  
  2072.             --sp;  /* readjust to get rid of space preallocation */
  2073.  
  2074.             (void)astore(ary,++sp,str_2mortal(str_nmake((double)retval)));
  2075.         (void)astore(ary,++sp,str_2mortal(str_make(mnybuf, 0)));
  2076.     }
  2077.     break;
  2078.       case US_dbmnydec:
  2079.     if ((items > 2) || (items < 1 ))
  2080.         {
  2081.         fatal("Usage: @arr = &dbmnydec($dbproc, $m1)");
  2082.         }
  2083.     else
  2084.     {
  2085.         int     retval, off1;
  2086.         DBMONEY mresult;
  2087.             DBCHAR  mnybuf[40];
  2088.  
  2089.         if(items == 2)
  2090.         {
  2091.         inx  = getDbProc(STACK(sp)[1]);
  2092.         off1 = 2;
  2093.         }
  2094.         else
  2095.         {
  2096.         inx  = 0;
  2097.         off1 = 1;
  2098.             }
  2099.  
  2100.         if (dbconvert(dbProc[inx].dbproc, SYBCHAR,
  2101.               (char *)str_get(STACK(sp)[off1]), (DBINT)-1,
  2102.               SYBMONEY, (BYTE *)&mresult, (DBINT)-1) == -1)
  2103.             {
  2104.            fatal("Invalid dbconvert() for &dbmnydec $m1 parameter");
  2105.             }
  2106.  
  2107.         retval = dbmnydec(dbProc[inx].dbproc, &mresult);
  2108.  
  2109.             new_mnytochar(dbProc[inx].dbproc, &mresult, mnybuf);
  2110.  
  2111.             --sp;  /* readjust to get rid of space preallocation */
  2112.  
  2113.             (void)astore(ary,++sp,str_2mortal(str_nmake((double)retval)));
  2114.         (void)astore(ary,++sp,str_2mortal(str_make(mnybuf, 0)));
  2115.     }
  2116.     break;
  2117.       case US_dbmnydown:
  2118.     if ((items > 3) || (items < 2 ))
  2119.         {
  2120.         fatal("Usage: @arr = &dbmnydown($dbproc, $m1, $i1)");
  2121.         }
  2122.     else
  2123.     {
  2124.         int     retval, off1, off2;
  2125.         int   i1, iresult = 0;
  2126.         DBMONEY mresult;
  2127.             DBCHAR  mnybuf[40];
  2128.  
  2129.         if(items == 3)
  2130.         {
  2131.         inx  = getDbProc(STACK(sp)[1]);
  2132.         off1 = 2;
  2133.         off2 = 3;
  2134.         }
  2135.         else
  2136.         {
  2137.         inx  = 0;
  2138.         off1 = 1;
  2139.         off2 = 2;
  2140.             }
  2141.  
  2142.         if (dbconvert(dbProc[inx].dbproc, SYBCHAR,
  2143.               (char *)str_get(STACK(sp)[off1]), (DBINT)-1,
  2144.               SYBMONEY, (BYTE*)&mresult, (DBINT)-1) == -1)
  2145.             {
  2146.            fatal("Invalid dbconvert() for &dbmnydown $m1 parameter");
  2147.             }
  2148.  
  2149.         if (dbconvert(dbProc[inx].dbproc, SYBCHAR,
  2150.               (char *)str_get(STACK(sp)[off2]), (DBINT)-1,
  2151.               SYBINT4, (BYTE*)&i1, (DBINT)-1) == -1)
  2152.             {
  2153.            fatal("Invalid dbconvert() for &dbmnydown $i1 parameter");
  2154.             }
  2155.  
  2156.         retval = dbmnydown(dbProc[inx].dbproc, &mresult, i1, &iresult);
  2157.  
  2158.             new_mnytochar(dbProc[inx].dbproc, &mresult, mnybuf);
  2159.  
  2160.             --sp;  /* readjust to get rid of space preallocation */
  2161.  
  2162.             (void)astore(ary,++sp,str_2mortal(str_nmake((double)retval)));
  2163.         (void)astore(ary,++sp,str_2mortal(str_make(mnybuf, 0)));
  2164.             (void)astore(ary,++sp,str_2mortal(str_nmake((double)iresult)));
  2165.     }
  2166.     break;
  2167.       case US_dbmnyinc:
  2168.     if ((items > 2) || (items < 1 ))
  2169.         {
  2170.         fatal("Usage: @arr = &dbmnyinc($dbproc, $m1)");
  2171.         }
  2172.     else
  2173.     {
  2174.         int     retval, off1;
  2175.         DBMONEY mresult;
  2176.             DBCHAR  mnybuf[40];
  2177.  
  2178.         if(items == 2)
  2179.         {
  2180.         inx  = getDbProc(STACK(sp)[1]);
  2181.         off1 = 2;
  2182.         }
  2183.         else
  2184.         {
  2185.         inx  = 0;
  2186.         off1 = 1;
  2187.             }
  2188.  
  2189.         if (dbconvert(dbProc[inx].dbproc, SYBCHAR,
  2190.               (char *)str_get(STACK(sp)[off1]), (DBINT)-1,
  2191.               SYBMONEY, (BYTE*)&mresult, (DBINT)-1) == -1)
  2192.             {
  2193.            fatal("Invalid dbconvert() for &dbmnyinc $m1 parameter");
  2194.             }
  2195.  
  2196.         retval = dbmnyinc(dbProc[inx].dbproc, &mresult);
  2197.  
  2198.             new_mnytochar(dbProc[inx].dbproc, &mresult, mnybuf);
  2199.  
  2200.             --sp;  /* readjust to get rid of space preallocation */
  2201.  
  2202.             (void)astore(ary,++sp,str_2mortal(str_nmake((double)retval)));
  2203.         (void)astore(ary,++sp,str_2mortal(str_make(mnybuf, 0)));
  2204.     }
  2205.     break;
  2206.       case US_dbmnyinit:
  2207.     if ((items > 3) || (items < 2 ))
  2208.         {
  2209.         fatal("Usage: @arr = &dbmnyinit($dbproc, $m1, $i1)");
  2210.         }
  2211.     else
  2212.     {
  2213.         int     retval, off1, off2;
  2214.         DBINT   i1, iresult;
  2215.         DBMONEY mresult;
  2216.         DBBOOL  bresult = (DBBOOL)FALSE;
  2217.             DBCHAR  mnybuf[40];
  2218.  
  2219.         if(items == 3)
  2220.         {
  2221.         inx  = getDbProc(STACK(sp)[1]);
  2222.         off1 = 2;
  2223.         off2 = 3;
  2224.         }
  2225.         else
  2226.         {
  2227.         inx  = 0;
  2228.         off1 = 1;
  2229.         off2 = 2;
  2230.             }
  2231.  
  2232.         if (dbconvert(dbProc[inx].dbproc, SYBCHAR,
  2233.               (char *)str_get(STACK(sp)[off1]), (DBINT)-1,
  2234.               SYBMONEY, (BYTE*)&mresult, (DBINT)-1) == -1)
  2235.             {
  2236.            fatal("Invalid dbconvert() for &dbmnyinit $m1 parameter");
  2237.             }
  2238.  
  2239.         if (dbconvert(dbProc[inx].dbproc, SYBCHAR,
  2240.               (char *)str_get(STACK(sp)[off2]), (DBINT)-1,
  2241.               SYBINT4, (BYTE*)&i1, (DBINT)-1) == -1)
  2242.             {
  2243.            fatal("Invalid dbconvert() for &dbmnyinit $i1 parameter");
  2244.             }
  2245.  
  2246.         retval = dbmnyinit(dbProc[inx].dbproc, &mresult, i1, &bresult);
  2247.  
  2248.             new_mnytochar(dbProc[inx].dbproc, &mresult, mnybuf);
  2249.  
  2250.         iresult = (DBINT)bresult;
  2251.  
  2252.             --sp;  /* readjust to get rid of space preallocation */
  2253.  
  2254.             (void)astore(ary,++sp,str_2mortal(str_nmake((double)retval)));
  2255.         (void)astore(ary,++sp,str_2mortal(str_make(mnybuf, 0)));
  2256.             (void)astore(ary,++sp,str_2mortal(str_nmake((double)iresult)));
  2257.     }
  2258.     break;
  2259.       case US_dbmnymaxneg:
  2260.     if (items > 1)
  2261.         {
  2262.         fatal("Usage: @arr = &dbmnymaxneg($dbproc)");
  2263.         }
  2264.     else
  2265.     {
  2266.         int     retval;
  2267.         DBMONEY mresult;
  2268.             DBCHAR  mnybuf[40];
  2269.  
  2270.         if(items == 1)
  2271.         {
  2272.         inx = getDbProc(STACK(sp)[1]);
  2273.         }
  2274.         else
  2275.         {
  2276.         inx = 0;
  2277.             }
  2278.  
  2279.         retval = dbmnymaxneg(dbProc[inx].dbproc, &mresult);
  2280.  
  2281.             new_mnytochar(dbProc[inx].dbproc, &mresult, mnybuf);
  2282.  
  2283.             --sp;  /* readjust to get rid of space preallocation */
  2284.  
  2285.             (void)astore(ary,++sp,str_2mortal(str_nmake((double)retval)));
  2286.         (void)astore(ary,++sp,str_2mortal(str_make(mnybuf, 0)));
  2287.     }
  2288.     break;
  2289.       case US_dbmnymaxpos:
  2290.     if (items > 1)
  2291.         {
  2292.         fatal("Usage: @arr = &dbmnymaxpos($dbproc)");
  2293.         }
  2294.     else
  2295.     {
  2296.         int     retval;
  2297.         DBMONEY mresult;
  2298.             DBCHAR  mnybuf[40];
  2299.  
  2300.         if(items == 1)
  2301.         {
  2302.         inx = getDbProc(STACK(sp)[1]);
  2303.         }
  2304.         else
  2305.         {
  2306.         inx = 0;
  2307.             }
  2308.  
  2309.         retval = dbmnymaxpos(dbProc[inx].dbproc, &mresult);
  2310.  
  2311.             new_mnytochar(dbProc[inx].dbproc, &mresult, mnybuf);
  2312.  
  2313.             --sp;  /* readjust to get rid of space preallocation */
  2314.  
  2315.             (void)astore(ary,++sp,str_2mortal(str_nmake((double)retval)));
  2316.         (void)astore(ary,++sp,str_2mortal(str_make(mnybuf, 0)));
  2317.     }
  2318.     break;
  2319.       case US_dbmnyndigit:
  2320.     if ((items > 2) || (items < 1 ))
  2321.         {
  2322.         fatal("Usage: @arr = &dbmnyndigit($dbproc, $m1)");
  2323.         }
  2324.     else
  2325.     {
  2326.         int     retval, off1;
  2327.         DBMONEY mresult;
  2328.         DBINT   iresult;
  2329.         DBBOOL  bresult = (DBBOOL)FALSE;
  2330.             DBCHAR  mnybuf[40], dgtbuf[ 10 ];
  2331.  
  2332.         if(items == 2)
  2333.         {
  2334.         inx  = getDbProc(STACK(sp)[1]);
  2335.         off1 = 2;
  2336.         }
  2337.         else
  2338.         {
  2339.         inx  = 0;
  2340.         off1 = 1;
  2341.             }
  2342.  
  2343.         if (dbconvert(dbProc[inx].dbproc, SYBCHAR,
  2344.               (char *)str_get(STACK(sp)[off1]), (DBINT)-1,
  2345.               SYBMONEY, (BYTE*)&mresult, (DBINT)-1) == -1)
  2346.             {
  2347.            fatal("Invalid dbconvert() for &dbmnyndigit $m1 parameter");
  2348.             }
  2349.  
  2350.         retval = dbmnyndigit(dbProc[inx].dbproc, &mresult, dgtbuf, &bresult);
  2351.  
  2352.             new_mnytochar(dbProc[inx].dbproc, &mresult, mnybuf);
  2353.  
  2354.         iresult = (DBINT)bresult;
  2355.  
  2356.             --sp;  /* readjust to get rid of space preallocation */
  2357.  
  2358.             (void)astore(ary,++sp,str_2mortal(str_nmake((double)retval)));
  2359.         (void)astore(ary,++sp,str_2mortal(str_make(mnybuf, 0)));
  2360.         (void)astore(ary,++sp,str_2mortal(str_make(dgtbuf, 0)));
  2361.             (void)astore(ary,++sp,str_2mortal(str_nmake((double)iresult)));
  2362.     }
  2363.     break;
  2364.       case US_dbmnyscale:
  2365.     if ((items > 4) || (items < 3 ))
  2366.         {
  2367.         fatal("Usage: @arr = &dbmnyscale($dbproc, $m1, $i1, $i2)");
  2368.         }
  2369.     else
  2370.     {
  2371.         int     retval, off1, off2, off3;
  2372.         DBINT   i1, i2;
  2373.         DBMONEY mresult;
  2374.             DBCHAR  mnybuf[40];
  2375.  
  2376.         if(items == 4)
  2377.         {
  2378.         inx  = getDbProc(STACK(sp)[1]);
  2379.         off1 = 2;
  2380.         off2 = 3;
  2381.         off3 = 4;
  2382.         }
  2383.         else
  2384.         {
  2385.         inx  = 0;
  2386.         off1 = 1;
  2387.         off2 = 2;
  2388.         off3 = 3;
  2389.             }
  2390.  
  2391.         if (dbconvert(dbProc[inx].dbproc, SYBCHAR,
  2392.               (char *)str_get(STACK(sp)[off1]), (DBINT)-1,
  2393.               SYBMONEY, (BYTE*)&mresult, (DBINT)-1) == -1)
  2394.             {
  2395.            fatal("Invalid dbconvert() for &dbmnyscale $m1 parameter");
  2396.             }
  2397.  
  2398.         if (dbconvert(dbProc[inx].dbproc, SYBCHAR,
  2399.               (char *)str_get(STACK(sp)[off2]), (DBINT)-1,
  2400.               SYBINT4, (BYTE*)&i1, (DBINT)-1) == -1)
  2401.             {
  2402.            fatal("Invalid dbconvert() for &dbmnyscale $i1 parameter");
  2403.             }
  2404.  
  2405.         if (dbconvert(dbProc[inx].dbproc, SYBCHAR,
  2406.               (char *)str_get(STACK(sp)[off3]), (DBINT)-1,
  2407.               SYBINT4, (BYTE*)&i2, (DBINT)-1) == -1)
  2408.             {
  2409.            fatal("Invalid dbconvert() for &dbmnyscale $i2 parameter");
  2410.             }
  2411.  
  2412.         retval = dbmnyscale(dbProc[inx].dbproc, &mresult, i1, i2);
  2413.  
  2414.             new_mnytochar(dbProc[inx].dbproc, &mresult, mnybuf);
  2415.  
  2416.             --sp;  /* readjust to get rid of space preallocation */
  2417.  
  2418.             (void)astore(ary,++sp,str_2mortal(str_nmake((double)retval)));
  2419.         (void)astore(ary,++sp,str_2mortal(str_make(mnybuf, 0)));
  2420.     }
  2421.     break;
  2422.  
  2423.       case US_DBSETLCHARSET:
  2424.     if (items != 1)
  2425.         fatal("Usage: &DBSETLCHARSET(char_set);");
  2426.     else
  2427.     {
  2428.         DBSETLCHARSET(login, (char *)str_get(STACK(sp)[1]));
  2429.         
  2430.         str_numset(STACK(sp)[0], (double) 0);
  2431.     }
  2432.     break;
  2433.     
  2434.       case US_DBSETLNATLANG:
  2435.     if (items != 1)
  2436.         fatal("Usage: &DBSETLNATLANG(language);");
  2437.     else
  2438.     {
  2439.         DBSETLNATLANG(login, (char *)str_get(STACK(sp)[1]));
  2440.         
  2441.         str_numset(STACK(sp)[0], (double) 0);
  2442.     }
  2443.     break;
  2444.     
  2445. #endif /* DBLIBVS >= 461 */
  2446.       case US_dbrecftos:
  2447.     if (items != 1)
  2448.         fatal("Usage: &dbrecftos($filename);");
  2449.     else
  2450.     {
  2451.         dbrecftos((char *)str_get(STACK(sp)[1]));
  2452.         
  2453.         str_numset(STACK(sp)[0], (double) 0);
  2454.     }
  2455.     break;
  2456. #endif /* DBLIBVS >= 420 */
  2457.       case US_dbwritetext:
  2458.         if (items != 5)
  2459.             fatal ("Usage: dbwritetext($dbproc1,$column,$dbproc2,$col,$text");
  2460.     else
  2461.     {
  2462.         int inx2, wcolnum;
  2463.         char *wcolname, *wtext;
  2464.         int ret;
  2465.         
  2466.         inx = getDbProc(STACK(sp)[1]);
  2467.         wcolname = str_get(STACK(sp)[2]);
  2468.         inx2 = getDbProc(STACK(sp)[3]);
  2469.         wcolnum = (int)str_gnum(STACK(sp)[4]);
  2470.         Str = STACK(sp)[5];
  2471.         wtext = str_get(Str);
  2472.         ret = dbwritetext (dbProc[inx].dbproc, wcolname, dbtxptr(dbProc[inx2].dbproc, wcolnum),
  2473.                    DBTXPLEN, dbtxtimestamp(dbProc[inx2].dbproc, wcolnum), 0,
  2474.                    Str->str_len, wtext);
  2475.         str_numset(STACK(sp)[0], (double) ret);
  2476.     }
  2477.         break;
  2478.       case US_dbnumcols:
  2479.     if (items > 1)
  2480.         fatal("Usage: $dbnumcols = &dbnumcols($dbproc);");
  2481.     else
  2482.     {
  2483.         int j;
  2484.  
  2485.         if(items)
  2486.         inx = getDbProc(STACK(sp)[1]);
  2487.         else
  2488.         inx = 0;
  2489.         
  2490.         j = dbnumcols(dbProc[inx].dbproc);
  2491.         str_numset(STACK(sp)[0], (double) j);
  2492.     }
  2493.     break;
  2494.       case US_dbcoltype:
  2495.     if (items > 2 || items < 1)
  2496.         fatal("Usage: $dbcoltype = &dbcoltype($dbproc, columnid);");
  2497.     else
  2498.     {
  2499.         int j, off;
  2500.         
  2501.         if(items)
  2502.         {
  2503.         inx = getDbProc(STACK(sp)[1]);
  2504.         off = 2;
  2505.         }
  2506.         else
  2507.         inx = 0, off = 1;
  2508.         
  2509.         
  2510.         j = dbcoltype(dbProc[inx].dbproc, (int)str_gnum(STACK(sp)[off]));
  2511.         str_numset(STACK(sp)[0], (double) j);
  2512.     }
  2513.     break;
  2514.       case US_dbcolname:
  2515.     if (items > 2 || items < 1)
  2516.         fatal("Usage: $dbcolname = &dbcolname($dbproc, columnid);");
  2517.     else
  2518.     {
  2519.         int j, off;
  2520.         char *colname;
  2521.         
  2522.         if(items)
  2523.         {
  2524.         inx = getDbProc(STACK(sp)[1]);
  2525.         off = 2;
  2526.         }
  2527.         else
  2528.         inx = 0, off = 1;
  2529.         
  2530.         
  2531.         colname = dbcolname(dbProc[inx].dbproc, (int)str_gnum(STACK(sp)[off]));
  2532.         str_set (STACK (sp)[0], colname);
  2533.     }
  2534.     break;
  2535.       case US_dbcollen:
  2536.     if (items > 2)
  2537.         fatal("Usage: $dbcollen = &dbcollen($dbproc, columnid);");
  2538.     else
  2539.     {
  2540.         int j, off;
  2541.         
  2542.         if(items)
  2543.         {
  2544.         inx = getDbProc(STACK(sp)[1]);
  2545.         off = 2;
  2546.         }
  2547.         else
  2548.         inx = 0, off = 1;
  2549.         
  2550.         
  2551.         j = dbcollen(dbProc[inx].dbproc, (int)str_gnum(STACK(sp)[off]));
  2552.         str_numset(STACK(sp)[0], (double) j);
  2553.     }
  2554.     break;
  2555.  
  2556.       case US_BCP_SETL:
  2557.     if (items != 1)
  2558.         fatal("Usage: &BCP_SETL($state);");
  2559.     else
  2560.     {
  2561.         BCP_SETL(login, (int)str_gnum(STACK(sp)[1]));
  2562.         str_numset(STACK(sp)[0], (double) 0);
  2563.     }
  2564.     break;
  2565. #if DBLIBVS >= 461
  2566.       case US_bcp_getl:
  2567.     if (items)
  2568.         fatal("Usage: $state = &bcp_getl();");
  2569.     else
  2570.     {
  2571.         int ret;
  2572.         ret = bcp_getl(login);
  2573.         str_numset(STACK(sp)[0], (double) ret);
  2574.     }
  2575.     break;
  2576. #endif
  2577.       case US_bcp_init:
  2578.     if (items < 4 || items > 5)
  2579.         fatal("Usage: &bcp_init($dbproc, $tblname, $hfile, $errfile, $dir);");
  2580.     else
  2581.     {
  2582.         int j, off;
  2583.         char *hfile;
  2584.         
  2585.         if(items == 5)
  2586.         {
  2587.         inx = getDbProc(STACK(sp)[1]);
  2588.         off = 2;
  2589.         }
  2590.         else
  2591.         inx = 0, off = 1;
  2592.  
  2593.         hfile = str_get(STACK(sp)[off+1]);
  2594.         if((Str = STACK(sp)[off+1]) == &str_undef ||
  2595.            ((hfile = str_get(Str)) && strlen(hfile) == 0))
  2596.         hfile = NULL;
  2597.         j = bcp_init(dbProc[inx].dbproc, str_get(STACK(sp)[off]),
  2598.              hfile,
  2599.              str_get(STACK(sp)[off+2]),
  2600.              (int)str_gnum(STACK(sp)[off+3]));
  2601.         str_numset(STACK(sp)[0], (double) j);
  2602.     }
  2603.     break;
  2604.  
  2605.       case US_bcp_meminit:
  2606.     if (items < 1 || items > 2)
  2607.         fatal("Usage: &bcp_meminit($dbproc, $num_cols);");
  2608.     else
  2609.     {
  2610.         int j, off, numcols;
  2611.         BYTE dummy;
  2612.         
  2613.         if(items == 2)
  2614.         {
  2615.         inx = getDbProc(STACK(sp)[1]);
  2616.         off = 2;
  2617.         }
  2618.         else
  2619.         inx = 0, off = 1;
  2620.         numcols = str_gnum(STACK(sp)[off]);
  2621.         for(j = 1; j <= numcols; ++j)
  2622.         bcp_bind(dbProc[inx].dbproc, &dummy, 0, -1, "", 1, SYBCHAR, j);
  2623.  
  2624.         if(dbProc[inx].colPtr) /* avoid a potential memory leak */
  2625.         Safefree(dbProc[inx].colPtr);
  2626.         New (902, dbProc[inx].colPtr, numcols, BYTE *);
  2627.         
  2628.         str_numset(STACK(sp)[0], (double) j);
  2629.     }
  2630.     break;
  2631.     
  2632.       case US_bcp_sendrow:    /* WARNING: the dbproc param is NOT */
  2633.                 /* optional for this call!!! */
  2634.     if (items < 2)
  2635.         fatal("Usage: &bcp_sendrow($dbproc, LIST);");
  2636.     else
  2637.     {
  2638.         int j, off;
  2639.  
  2640.         inx = getDbProc(STACK(sp)[1]);
  2641.         for(j = 1; j < items; ++j)
  2642.         {
  2643.         Str = STACK(sp)[j+1];
  2644.         if(Str == &str_undef) /* it's a NULL data value */
  2645.             bcp_collen(dbProc[inx].dbproc, 0, j);
  2646.         else
  2647.             bcp_collen(dbProc[inx].dbproc, -1, j);
  2648.         dbProc[inx].colPtr[j] = (BYTE *)str_get(Str);
  2649.         bcp_colptr(dbProc[inx].dbproc, dbProc[inx].colPtr[j], j);
  2650.         }
  2651.         j = bcp_sendrow(dbProc[inx].dbproc);
  2652.         str_numset(STACK(sp)[0], (double) j);
  2653.     }
  2654.     break;
  2655.     
  2656.       case US_bcp_batch:
  2657.     if (items > 1)
  2658.         fatal("Usage: $ret = &bcp_batch($dbproc);");
  2659.     else
  2660.     {
  2661.         int j;
  2662.         
  2663.         if(items)
  2664.         inx = getDbProc(STACK(sp)[1]);
  2665.         else
  2666.         inx = 0;
  2667.         
  2668.         j = bcp_batch(dbProc[inx].dbproc);
  2669.         str_numset(STACK(sp)[0], (double) j);
  2670.     }
  2671.     break;
  2672.         
  2673.       case US_bcp_done:
  2674.     if (items > 1)
  2675.         fatal("Usage: $ret = &bcp_done($dbproc);");
  2676.     else
  2677.     {
  2678.         int j;
  2679.         
  2680.         if(items)
  2681.         inx = getDbProc(STACK(sp)[1]);
  2682.         else
  2683.         inx = 0;
  2684.         if(dbProc[inx].colPtr)
  2685.         {
  2686.         Safefree(dbProc[inx].colPtr);
  2687.         dbProc[inx].colPtr = NULL;
  2688.         }
  2689.         j = bcp_done(dbProc[inx].dbproc);
  2690.         str_numset(STACK(sp)[0], (double) j);
  2691.     }
  2692.     break;
  2693.  
  2694.       case US_bcp_control:
  2695.     if (items < 2 || items > 3)
  2696.         fatal("Usage: $ret = &bcp_control($dbproc, $field, $value);");
  2697.     else
  2698.     {
  2699.         int j, off;
  2700.  
  2701.         if(items == 3)
  2702.         {
  2703.         inx = getDbProc(STACK(sp)[1]);
  2704.         off = 2;
  2705.         }
  2706.         else
  2707.         inx = 0, off = 1;
  2708.         j = bcp_control(dbProc[inx].dbproc, (int)str_gnum(STACK(sp)[off]),
  2709.                 (int)str_gnum(STACK(sp)[off+1]));
  2710.         str_numset(STACK(sp)[0], (double) j);
  2711.     }
  2712.     break;
  2713.         
  2714.       case US_bcp_columns:
  2715.     if (items < 1 || items > 2)
  2716.         fatal("Usage: $ret = &bcp_columns($dbproc, $host_colcount);");
  2717.     else
  2718.     {
  2719.         int j, off;
  2720.  
  2721.         if(items == 2)
  2722.         {
  2723.         inx = getDbProc(STACK(sp)[1]);
  2724.         off = 2;
  2725.         }
  2726.         else
  2727.         inx = 0, off = 1;
  2728.         j = bcp_columns(dbProc[inx].dbproc, (int)str_gnum(STACK(sp)[off]));
  2729.         str_numset(STACK(sp)[0], (double) j);
  2730.     }
  2731.     break;
  2732.         
  2733.       case US_bcp_colfmt:
  2734.     if (items < 7 || items > 8)
  2735.         fatal("Usage: $ret = &bcp_colfmt($dbproc, $host_colnum, $host_type, $host_prefixlen, $host_collen, $host_term, $host_termlen, $table_colnum);");
  2736.     else
  2737.     {
  2738.         int j, off;
  2739.         char *host_term;
  2740.  
  2741.         if(items == 8)
  2742.         {
  2743.         inx = getDbProc(STACK(sp)[1]);
  2744.         off = 2;
  2745.         }
  2746.         else
  2747.         inx = 0, off = 1;
  2748.  
  2749.         if(STACK(sp)[off+4] == &str_undef)
  2750.         host_term = NULL;
  2751.         else
  2752.         host_term = str_get(STACK(sp)[off+4]);
  2753.         
  2754.         j = bcp_colfmt(dbProc[inx].dbproc, (int)str_gnum(STACK(sp)[off]),
  2755.                (int)str_gnum(STACK(sp)[off+1]),
  2756.                (int)str_gnum(STACK(sp)[off+2]),
  2757.                (int)str_gnum(STACK(sp)[off+3]),
  2758.                host_term,
  2759.                (int)str_gnum(STACK(sp)[off+5]),
  2760.                (int)str_gnum(STACK(sp)[off+6]));
  2761.         str_numset(STACK(sp)[0], (double) j);
  2762.     }
  2763.     break;
  2764.         
  2765.       case US_bcp_collen:
  2766.     if (items < 2 || items > 3)
  2767.         fatal("Usage: $ret = &bcp_collen($dbproc, $varlen, $table_column);");
  2768.     else
  2769.     {
  2770.         int j, off;
  2771.  
  2772.         if(items == 3)
  2773.         {
  2774.         inx = getDbProc(STACK(sp)[1]);
  2775.         off = 2;
  2776.         }
  2777.         else
  2778.         inx = 0, off = 1;
  2779.         j = bcp_collen(dbProc[inx].dbproc, (int)str_gnum(STACK(sp)[off]),
  2780.                (int)str_gnum(STACK(sp)[off+1]));
  2781.         str_numset(STACK(sp)[0], (double) j);
  2782.     }
  2783.     break;
  2784.     
  2785.       case US_bcp_exec:
  2786.     if (items > 1)
  2787.         fatal("Usage: ($ret, $rows_copied) = &bcp_exec($dbproc);");
  2788.     else
  2789.     {
  2790.         int j;
  2791.         DBINT rows;
  2792.  
  2793.         if(items == 1)
  2794.         inx = getDbProc(STACK(sp)[1]);
  2795.         else
  2796.         inx = 0;
  2797.         j = bcp_exec(dbProc[inx].dbproc, &rows);
  2798.         
  2799.             --sp;  /* readjust to get rid of space preallocation */
  2800.  
  2801.             (void)astore(ary,++sp,str_2mortal(str_nmake((double)j)));
  2802.         (void)astore(ary,++sp,str_2mortal(str_nmake((double)rows)));
  2803.     }
  2804.     break;
  2805.         
  2806.       case US_bcp_readfmt:
  2807.     if (items < 1 || items > 2)
  2808.         fatal("Usage: $ret = &bcp_readfmt($dbproc, $filename);");
  2809.     else
  2810.     {
  2811.         int j, off;
  2812.  
  2813.         if(items == 2)
  2814.         {
  2815.         inx = getDbProc(STACK(sp)[1]);
  2816.         off = 2;
  2817.         }
  2818.         else
  2819.         inx = 0, off = 1;
  2820.         j = bcp_readfmt(dbProc[inx].dbproc, str_get(STACK(sp)[off]));
  2821.         str_numset(STACK(sp)[0], (double) j);
  2822.     }
  2823.     break;
  2824.     
  2825.       case US_bcp_writefmt:
  2826.     if (items < 1 || items > 2)
  2827.         fatal("Usage: $ret = &bcp_writefmt($dbproc, $filename);");
  2828.     else
  2829.     {
  2830.         int j, off;
  2831.  
  2832.         if(items == 2)
  2833.         {
  2834.         inx = getDbProc(STACK(sp)[1]);
  2835.         off = 2;
  2836.         }
  2837.         else
  2838.         inx = 0, off = 1;
  2839.         j = bcp_writefmt(dbProc[inx].dbproc, str_get(STACK(sp)[off]));
  2840.         str_numset(STACK(sp)[0], (double) j);
  2841.     }
  2842.     break;
  2843.     
  2844.       default:
  2845.     fatal("Unimplemented user-defined subroutine");
  2846.     }
  2847.     return sp;
  2848. }
  2849.  
  2850. /* 
  2851.  * Return the value of a userdefined variable. These variables are nearly all
  2852.  * READ-ONLY.
  2853.  */
  2854. static int
  2855. userval(ix, str)
  2856. int ix;
  2857. STR *str;
  2858. {
  2859.     char buff[24];
  2860.     
  2861.     switch (ix)
  2862.     {
  2863.       case UV_SUCCEED:
  2864.     str_numset(str, (double)SUCCEED);
  2865.     break;
  2866.       case UV_FAIL:
  2867.     str_numset(str, (double)FAIL);
  2868.     break;
  2869.       case UV_NO_MORE_ROWS:
  2870.     str_numset(str, (double)NO_MORE_ROWS);
  2871.     break;
  2872.       case UV_NO_MORE_RESULTS:
  2873.     str_numset(str, (double)NO_MORE_RESULTS);
  2874.     break;
  2875.       case UV_ComputeId:
  2876.     str_numset(str, (double)ComputeId);
  2877.     break;
  2878.       case UV_SybperlVer:
  2879.     sprintf(buff, "%d.%3.3d", VERSION, PATCHLEVEL);
  2880.     str_set(str, buff);
  2881.     break;
  2882.       case UV_DBstatus:
  2883.     str_numset(str, (double)DBstatus);
  2884.     break;
  2885. #if DBLIBVS >= 461
  2886.       case UV_STDEXIT:
  2887.     str_numset(str, (double)STDEXIT);
  2888.     break;
  2889.       case UV_ERREXIT:
  2890.     str_numset(str, (double)ERREXIT);
  2891.     break;
  2892.       case UV_INT_EXIT:
  2893.     str_numset(str, (double)INT_EXIT);
  2894.     break;
  2895.       case UV_INT_CONTINUE:
  2896.     str_numset(str, (double)INT_CONTINUE);
  2897.     break;
  2898.       case UV_INT_CANCEL:
  2899.     str_numset(str, (double)INT_CANCEL);
  2900.     break;
  2901.       case UV_INT_TIMEOUT:
  2902.     str_numset(str, (double)INT_TIMEOUT);
  2903.     break;
  2904.       case UV_MORE_ROWS:
  2905.     str_numset(str, (double)MORE_ROWS);
  2906.     break;
  2907.       case UV_REG_ROW:
  2908.     str_numset(str, (double)REG_ROW);
  2909.     break;
  2910.       case UV_BUF_FULL:
  2911.     str_numset(str, (double)BUF_FULL);
  2912.     break;
  2913.       case UV_NO_MORE_PARAMS:
  2914.     str_numset(str, (double)NO_MORE_PARAMS);
  2915.     break;
  2916.       case UV_DBSAVE:
  2917.     str_numset(str, (double)DBSAVE);
  2918.     break;
  2919.       case UV_DBNOSAVE:
  2920.     str_numset(str, (double)DBNOSAVE);
  2921.     break;
  2922.       case UV_DBNOERR:
  2923.     str_numset(str, (double)DBNOERR);
  2924.     break;
  2925.       case UV_DB_PASSTHRU_MORE:
  2926.     str_numset(str, (double)DB_PASSTHRU_MORE);
  2927.     break;
  2928.       case UV_DB_PASSTHRU_EOM:
  2929.     str_numset(str, (double)DB_PASSTHRU_EOM);
  2930.     break;
  2931.       case UV_DBNOPROC:
  2932.     str_numset(str, (double)DBNOPROC);
  2933.     break;
  2934.       case UV_EXCEPTION:
  2935.     str_numset(str, (double)EXCEPTION);
  2936.     break;
  2937.       case UV_EXSIGNAL:
  2938.     str_numset(str, (double)EXSIGNAL);
  2939.     break;
  2940.       case UV_EXSCREENIO:
  2941.     str_numset(str, (double)EXSCREENIO);
  2942.     break;
  2943.       case UV_EXDBLIB:
  2944.     str_numset(str, (double)EXDBLIB);
  2945.     break;
  2946.       case UV_EXFORMS:
  2947.     str_numset(str, (double)EXFORMS);
  2948.     break;
  2949.       case UV_EXCLIPBOARD:
  2950.     str_numset(str, (double)EXCLIPBOARD);
  2951.     break;
  2952.       case UV_EXLOOKUP:
  2953.     str_numset(str, (double)EXLOOKUP);
  2954.     break;
  2955.       case UV_EXINFO:
  2956.     str_numset(str, (double)EXINFO);
  2957.     break;
  2958.       case UV_EXUSER:
  2959.     str_numset(str, (double)EXUSER);
  2960.     break;
  2961.       case UV_EXNONFATAL:
  2962.     str_numset(str, (double)EXNONFATAL);
  2963.     break;
  2964.       case UV_EXCONVERSION:
  2965.     str_numset(str, (double)EXCONVERSION);
  2966.     break;
  2967.       case UV_EXSERVER:
  2968.     str_numset(str, (double)EXSERVER);
  2969.     break;
  2970.       case UV_EXTIME:
  2971.     str_numset(str, (double)EXTIME);
  2972.     break;
  2973.       case UV_EXPROGRAM:
  2974.     str_numset(str, (double)EXPROGRAM);
  2975.     break;
  2976.       case UV_EXRESOURCE:
  2977.     str_numset(str, (double)EXRESOURCE);
  2978.     break;
  2979.       case UV_EXCOMM:
  2980.     str_numset(str, (double)EXCOMM);
  2981.     break;
  2982.       case UV_EXFATAL:
  2983.     str_numset(str, (double)EXFATAL);
  2984.     break;
  2985.       case UV_EXCONSISTENCY:
  2986.     str_numset(str, (double)EXCONSISTENCY);
  2987.     break;
  2988. #endif
  2989.       case UV_DB_IN:
  2990.     str_numset(str, (double)DB_IN);
  2991.     break;
  2992.       case UV_DB_OUT:
  2993.     str_numset(str, (double)DB_OUT);
  2994.     break;
  2995.       case UV_BCPMAXERRS:
  2996.     str_numset(str, (double)BCPMAXERRS);
  2997.     break;
  2998.       case UV_BCPFIRST:
  2999.     str_numset(str, (double)BCPFIRST);
  3000.     break;
  3001.       case UV_BCPLAST:
  3002.     str_numset(str, (double)BCPLAST);
  3003.     break;
  3004.       case UV_BCPBATCH:
  3005.     str_numset(str, (double)BCPBATCH);
  3006.     break;
  3007.       case UV_DBTRUE:
  3008.     str_numset(str, (double)TRUE);
  3009.     break;
  3010.       case UV_DBFALSE:
  3011.     str_numset(str, (double)FALSE);
  3012.     break;
  3013. #if defined(PACKAGE_BUG)
  3014.       case UV_PACKAGE_BUG:
  3015.     str_numset(str, 1.0);
  3016.     break;
  3017. #endif
  3018.       case UV_dbNullIsUndef:
  3019.     str_numset(str, (double)dbNullIsUndef);
  3020.     break;
  3021.       case UV_dbKeepNumeric:
  3022.     str_numset(str, (double)dbKeepNumeric);
  3023.     break;
  3024.       case UV_dbBin0x:
  3025.     str_numset(str, (double)dbBin0x);
  3026.     break;
  3027.      }
  3028.     return 0;
  3029. }
  3030.  
  3031. static int
  3032. userset(ix, str)
  3033. int ix;
  3034. STR *str;
  3035. {
  3036.     switch (ix)
  3037.     {
  3038.       case UV_dbNullIsUndef:
  3039.     dbNullIsUndef = str_gnum(str);
  3040.     break;
  3041.       case UV_dbKeepNumeric:
  3042.     dbKeepNumeric = str_gnum(str);
  3043.     break;
  3044.       case UV_dbBin0x:
  3045.     dbBin0x = str_gnum(str);
  3046.     break;
  3047.       default:
  3048. #if defined(USERVAL_SET_FATAL)
  3049.     fatal("sybperl: trying to write to a read-only variable.");
  3050. #else
  3051.     warn("sybperl: trying to write to a read-only variable.");
  3052. #endif
  3053.     break;
  3054.     }
  3055.     return 0;
  3056. }
  3057.  
  3058.  
  3059. /*ARGSUSED*/
  3060. static int err_handler(db, severity, dberr, oserr, dberrstring, oserrstr)
  3061.     DBPROCESS *db;
  3062.     int severity;
  3063.     int dberr;
  3064.     int oserr;
  3065.     char *dberrstring;
  3066.     char *oserrstr;
  3067. {
  3068. #ifdef HAS_CALLBACK
  3069.     /* If we have error handler subroutine, use it. */
  3070.     if (err_handler_sub)
  3071.     {
  3072.     int sp = perl_sp;
  3073.     int j;
  3074.  
  3075.     for(j = 0; j < MAX_DBPROCS; ++j)
  3076.         if(db == dbProc[j].dbproc)
  3077.         break;
  3078.     if(j == MAX_DBPROCS)
  3079.         j = 0;
  3080.     
  3081.     /* Reserve spot for return value. */
  3082.     astore (stack, ++ sp, Nullstr);
  3083.     
  3084.     /* Set up arguments. */
  3085.     astore (stack, ++ sp,
  3086.         str_2mortal (str_nmake ((double) j)));
  3087.     astore (stack, ++ sp, str_2mortal (str_nmake ((double) severity)));
  3088.     astore (stack, ++ sp, str_2mortal (str_nmake ((double) dberr)));
  3089.     astore (stack, ++ sp, str_2mortal (str_nmake ((double) oserr)));
  3090.     if (dberrstring && *dberrstring)
  3091.         astore (stack, ++ sp, str_2mortal (str_make (dberrstring, 0)));
  3092.     else
  3093.         astore (stack, ++ sp, &str_undef);
  3094.     if (oserrstr && *oserrstr)
  3095.         astore (stack, ++ sp, str_2mortal (str_make (oserrstr, 0)));
  3096.     else
  3097.         astore (stack, ++ sp, &str_undef);
  3098.     
  3099.     /* Call it. */
  3100.     sp = callback (err_handler_sub, sp, 0, 1, 6);
  3101.     
  3102.     /* Return whatever it returned. */
  3103.     return (int) str_gnum (STACK (sp)[0]);
  3104.     }
  3105. #endif                /* HAS_CALLBACK */
  3106.     if ((db == NULL) || (DBDEAD(db)))
  3107.     return(INT_EXIT);
  3108.     else 
  3109.     {
  3110.     fprintf(stderr,"DB-Library error:\n\t%s\n", dberrstring);
  3111.     
  3112.     if (oserr != DBNOERR)
  3113.         fprintf(stderr,"Operating-system error:\n\t%s\n", oserrstr);
  3114.     
  3115.     return(INT_CANCEL);
  3116.     }
  3117. }
  3118.  
  3119. /*ARGSUSED*/
  3120.  
  3121. static int msg_handler(db, msgno, msgstate, severity, msgtext, srvname, procname, line)
  3122.     DBPROCESS *db;
  3123.     DBINT msgno;
  3124.     int msgstate;
  3125.     int severity;
  3126.     char *msgtext;
  3127.     char *srvname;
  3128.     char *procname;
  3129.     DBUSMALLINT line;
  3130. {
  3131. #ifdef HAS_CALLBACK
  3132.     /* If we have message handler subroutine, use it. */
  3133.     if (msg_handler_sub)
  3134.     {
  3135.     int sp = perl_sp;
  3136.     int j;
  3137.  
  3138.     for(j = 0; j < MAX_DBPROCS; ++j)
  3139.         if(db == dbProc[j].dbproc)
  3140.         break;
  3141.     if(j == MAX_DBPROCS)
  3142.         j = 0;
  3143.     
  3144.     /* Reserve spot for return value. */
  3145.     astore (stack, ++ sp, Nullstr);
  3146.     
  3147.     /* Set up arguments. */
  3148.     astore (stack, ++ sp,
  3149.         str_2mortal (str_nmake ((double) j)));
  3150.     astore (stack, ++ sp, str_2mortal (str_nmake ((double) msgno)));
  3151.     astore (stack, ++ sp, str_2mortal (str_nmake ((double) msgstate)));
  3152.     astore (stack, ++ sp, str_2mortal (str_nmake ((double) severity)));
  3153.     if (msgtext && *msgtext)
  3154.         astore (stack, ++ sp, str_2mortal (str_make (msgtext, 0)));
  3155.     else
  3156.         astore (stack, ++ sp, &str_undef);
  3157.     if (srvname && *srvname)
  3158.         astore (stack, ++ sp, str_2mortal (str_make (srvname, 0)));
  3159.     else
  3160.         astore (stack, ++ sp, &str_undef);
  3161.     if (procname && *procname)
  3162.         astore (stack, ++ sp, str_2mortal (str_make (procname, 0)));
  3163.     else
  3164.         astore (stack, ++ sp, &str_undef);
  3165.     astore (stack, ++ sp, str_2mortal (str_nmake ((double) line)));
  3166.     
  3167.     /* Call it. */
  3168.     sp = callback (msg_handler_sub, sp, 0, 1, 8);
  3169.     
  3170.     /* Return whatever it returned. */
  3171.     return (int) str_gnum (STACK (sp)[0]);
  3172.     }
  3173. #endif                /* HAS_CALLBACK */
  3174.  
  3175.     /* Don't print any message if severity == 0 */
  3176.     if(!severity)
  3177.     return 0;
  3178.  
  3179.     fprintf (stderr,"Msg %ld, Level %d, State %d\n", 
  3180.          msgno, severity, msgstate);
  3181.     if (strlen(srvname) > 0)
  3182.     fprintf (stderr,"Server '%s', ", srvname);
  3183.     if (strlen(procname) > 0)
  3184.     fprintf (stderr,"Procedure '%s', ", procname);
  3185.     if (line > 0)
  3186.     fprintf (stderr,"Line %d", line);
  3187.     
  3188.     fprintf(stderr,"\n\t%s\n", msgtext);
  3189.     
  3190.     return(0);
  3191. }
  3192.  
  3193. /* 
  3194.  * Get the index into the dbproc[] array from a Perl STR datatype. 
  3195.  * Check that the index is reasonably valid...
  3196.  */
  3197. static int
  3198. getDbProc(Str)
  3199.     STR *Str;
  3200. {
  3201.     int ix;
  3202.  
  3203.     if (Str == &str_undef || !Str->str_nok) /* This may be getting a bit too */
  3204.                         /* close with the internals of */
  3205.                         /* the 'str' workings... */
  3206.     warn("The $dbproc parameter has not been properly initialized - it defaults to 0");
  3207.  
  3208.     ix = (int)str_gnum(Str);
  3209.  
  3210.     if(ix < 0 || ix >= MAX_DBPROCS)
  3211.     fatal("$dbproc parameter is out of range");
  3212.     if(dbProc[ix].dbproc == NULL || DBDEAD(dbProc[ix].dbproc))
  3213.     fatal("$dbproc parameter is NULL or the connection to the server has been closed");
  3214.     return ix;
  3215. }
  3216.  
  3217.  
  3218. #ifdef HAS_CALLBACK
  3219.  
  3220. /* Taken from Perl 4.018 usub/usersub.c. mp. */
  3221.  
  3222. /* Be sure to refetch the stack pointer after calling these routines. */
  3223.  
  3224. int
  3225. callback(subname, sp, gimme, hasargs, numargs)
  3226. char *subname;
  3227. int sp;            /* stack pointer after args are pushed */
  3228. int gimme;        /* called in array or scalar context */
  3229. int hasargs;        /* whether to create a @_ array for routine */
  3230. int numargs;        /* how many args are pushed on the stack */
  3231. {
  3232.     static ARG myarg[3];    /* fake syntax tree node */
  3233.     int arglast[3];
  3234.     
  3235.     arglast[2] = sp;
  3236.     sp -= numargs;
  3237.     arglast[1] = sp--;
  3238.     arglast[0] = sp;
  3239.  
  3240.     if (!myarg[0].arg_ptr.arg_str)
  3241.     myarg[0].arg_ptr.arg_str = str_make("",0);
  3242.  
  3243.     myarg[1].arg_type = A_WORD;
  3244.     myarg[1].arg_ptr.arg_stab = stabent(subname, FALSE);
  3245.  
  3246.     myarg[2].arg_type = hasargs ? A_EXPR : A_NULL;
  3247.  
  3248.     return do_subr(myarg, gimme, arglast);
  3249. }
  3250.  
  3251. #endif                /* HAS_CALLBACK */
  3252.  
  3253.  
  3254. #if DBLIBVS >= 461
  3255.  
  3256. /* The following routines originate from the OpenClient R4.6.1 reference  */
  3257. /* manual, pages 2-165 to 2-168 both inclusive.  It has been subsequently */
  3258. /* modified (slightly) to suit local conditions.                          */
  3259.  
  3260. #define PRECISION 4
  3261.  
  3262. static void new_mny4tochar(dbproc, mny4ptr, buf_ptr)
  3263. DBPROCESS *dbproc;
  3264. DBMONEY4  *mny4ptr;
  3265. DBCHAR    *buf_ptr;
  3266. {
  3267.    DBMONEY local_mny;
  3268.    DBCHAR  value;
  3269.    char    temp_buf[40];
  3270.  
  3271.    int     bytes_written = 0;
  3272.    int     i             = 0;
  3273.    DBBOOL  negative      = (DBBOOL)FALSE;
  3274.    DBBOOL  zero          = (DBBOOL)FALSE;
  3275.  
  3276.    if (dbconvert(dbproc, SYBMONEY4, (BYTE*)mny4ptr, (DBINT)-1,
  3277.                  SYBMONEY, (BYTE*)&local_mny, (DBINT)-1) == -1)
  3278.    {
  3279.       fatal("dbconvert() failed in routine new_mny4tochar()");
  3280.    }
  3281.  
  3282.    if (dbmnyinit(dbproc, &local_mny, 4 - PRECISION, &negative) == FAIL)
  3283.    {
  3284.       fatal("dbmnyinit() failed in routine new_mny4tochar()");
  3285.    }
  3286.  
  3287.    while (zero == FALSE)
  3288.    {
  3289.       if (dbmnyndigit(dbproc, &local_mny, &value, &zero) == FAIL)
  3290.       {
  3291.          fatal("dbmnyndigit() failed in routine new_mny4tochar()");
  3292.       }
  3293.  
  3294.       temp_buf[bytes_written++] = value;
  3295.  
  3296.       if (zero == FALSE)
  3297.       {
  3298.          if (bytes_written == PRECISION)
  3299.          {
  3300.             temp_buf[bytes_written++] = '.';
  3301.          }
  3302.       }
  3303.    }
  3304.  
  3305.    while (bytes_written < PRECISION)
  3306.    {
  3307.       temp_buf[bytes_written++] = '0';
  3308.    }
  3309.  
  3310.    if (bytes_written == PRECISION)
  3311.    {
  3312.       temp_buf[bytes_written++] = '.';
  3313.       temp_buf[bytes_written++] = '0';
  3314.    }
  3315.  
  3316.    if (negative == TRUE)
  3317.    {
  3318.       buf_ptr[i++] = '-';
  3319.    }
  3320.  
  3321.    while (bytes_written--)
  3322.    {
  3323.       buf_ptr[i++] = temp_buf[bytes_written];
  3324.    }
  3325.  
  3326.    buf_ptr[i] = '\0';
  3327.  
  3328.    return;
  3329. }
  3330.  
  3331. static void new_mnytochar(dbproc, mnyptr, buf_ptr)
  3332. DBPROCESS *dbproc;
  3333. DBMONEY   *mnyptr;
  3334. DBCHAR    *buf_ptr;
  3335. {
  3336.    DBMONEY local_mny;
  3337.    DBCHAR  value;
  3338.    char    temp_buf[40];
  3339.  
  3340.    int     bytes_written = 0;
  3341.    int     i             = 0;
  3342.    DBBOOL  negative      = (DBBOOL)FALSE;
  3343.    DBBOOL  zero          = (DBBOOL)FALSE;
  3344.  
  3345.    if (dbmnycopy(dbproc, mnyptr, &local_mny) == FAIL)
  3346.    {
  3347.       fatal("dbmnycopy() failed in routine new_mnytochar()");
  3348.    }
  3349.  
  3350.    if (dbmnyinit(dbproc, &local_mny, 4 - PRECISION, &negative) == FAIL)
  3351.    {
  3352.       fatal("dbmnyinit() failed in routine new_mnytochar()");
  3353.    }
  3354.  
  3355.    while (zero == FALSE)
  3356.    {
  3357.       if (dbmnyndigit(dbproc, &local_mny, &value, &zero) == FAIL)
  3358.       {
  3359.          fatal("dbmnyndigit() failed in routine new_mnytochar()");
  3360.       }
  3361.  
  3362.       temp_buf[bytes_written++] = value;
  3363.  
  3364.       if (zero == FALSE)
  3365.       {
  3366.          if (bytes_written == PRECISION)
  3367.          {
  3368.             temp_buf[bytes_written++] = '.';
  3369.          }
  3370.       }
  3371.    }
  3372.  
  3373.    while (bytes_written < PRECISION)
  3374.    {
  3375.       temp_buf[bytes_written++] = '0';
  3376.    }
  3377.  
  3378.    if (bytes_written == PRECISION)
  3379.    {
  3380.       temp_buf[bytes_written++] = '.';
  3381.       temp_buf[bytes_written++] = '0';
  3382.    }
  3383.  
  3384.    if (negative == TRUE)
  3385.    {
  3386.       buf_ptr[i++] = '-';
  3387.    }
  3388.  
  3389.    while (bytes_written--)
  3390.    {
  3391.       buf_ptr[i++] = temp_buf[bytes_written];
  3392.    }
  3393.  
  3394.    buf_ptr[i] = '\0';
  3395.  
  3396.    return;
  3397. }
  3398.  
  3399. #endif  /* DBLIBVS >= 461 */
  3400.  
  3401.