home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / misc / volume39 / sybperl / part02 / sybperl.c.B < prev   
Encoding:
Text File  |  1993-09-25  |  35.4 KB  |  1,553 lines
  1.       case US_dbmnycmp:
  2.     if ((items > 3) || (items < 2 ))
  3.         {
  4.         fatal("Usage: &dbmnycmp($dbproc, $m1, $m2)");
  5.         }
  6.     else
  7.     {
  8.         int     retval, off1, off2;
  9.         DBMONEY m1, m2;
  10.  
  11.         if(items == 3)
  12.         {
  13.         inx  = getDbProc(STACK(sp)[1]);
  14.         off1 = 2;
  15.         off2 = 3;
  16.         }
  17.         else
  18.         {
  19.         inx  = 0;
  20.         off1 = 1;
  21.         off2 = 2;
  22.             }
  23.  
  24.         if (dbconvert(dbProc[inx].dbproc, SYBCHAR,
  25.               (char *)str_get(STACK(sp)[off1]), (DBINT)-1,
  26.               SYBMONEY, (BYTE*)&m1, (DBINT)-1) == -1)
  27.             {
  28.            fatal("Invalid dbconvert() for &dbmnycmp $m1 parameter");
  29.             }
  30.  
  31.         if (dbconvert(dbProc[inx].dbproc, SYBCHAR,
  32.               (char *)str_get(STACK(sp)[off2]), (DBINT)-1,
  33.               SYBMONEY, (BYTE*)&m2, (DBINT)-1) == -1)
  34.             {
  35.            fatal("Invalid dbconvert() for &dbmnycmp $m2 parameter");
  36.             }
  37.  
  38.         retval = dbmnycmp(dbProc[inx].dbproc, &m1, &m2);
  39.  
  40.         str_numset(STACK(sp)[0], (double)retval);
  41.     }
  42.     break;
  43.       case US_dbmnydivide:
  44.     if ((items > 3) || (items < 2 ))
  45.         {
  46.         fatal("Usage: @arr = &dbmnydivide($dbproc, $m1, $m2)");
  47.         }
  48.     else
  49.     {
  50.         int     retval, off1, off2;
  51.         DBMONEY m1, m2, mresult;
  52.             DBCHAR  mnybuf[40];
  53.  
  54.         if(items == 3)
  55.         {
  56.         inx  = getDbProc(STACK(sp)[1]);
  57.         off1 = 2;
  58.         off2 = 3;
  59.         }
  60.         else
  61.         {
  62.         inx  = 0;
  63.         off1 = 1;
  64.         off2 = 2;
  65.             }
  66.  
  67.         if (dbconvert(dbProc[inx].dbproc, SYBCHAR,
  68.               (char *)str_get(STACK(sp)[off1]), (DBINT)-1,
  69.               SYBMONEY, (BYTE*)&m1, (DBINT)-1) == -1)
  70.             {
  71.            fatal("Invalid dbconvert() for &dbmnydivide $m1 parameter");
  72.             }
  73.  
  74.         if (dbconvert(dbProc[inx].dbproc, SYBCHAR,
  75.               (char *)str_get(STACK(sp)[off2]), (DBINT)-1,
  76.               SYBMONEY, (BYTE*)&m2, (DBINT)-1) == -1)
  77.             {
  78.            fatal("Invalid dbconvert() for &dbmnydivide $m2 parameter");
  79.             }
  80.  
  81.         retval = dbmnydivide(dbProc[inx].dbproc, &m1, &m2, &mresult);
  82.  
  83.             new_mnytochar(dbProc[inx].dbproc, &mresult, mnybuf);
  84.  
  85.             --sp;  /* readjust to get rid of space preallocation */
  86.  
  87.             (void)astore(ary,++sp,str_2mortal(str_nmake((double)retval)));
  88.         (void)astore(ary,++sp,str_2mortal(str_make(mnybuf, 0)));
  89.     }
  90.     break;
  91.       case US_dbmnyminus:
  92.     if ((items > 2) || (items < 1 ))
  93.         {
  94.         fatal("Usage: @arr = &dbmnyminus($dbproc, $m1)");
  95.         }
  96.     else
  97.     {
  98.         int     retval, off1;
  99.         DBMONEY m1, mresult;
  100.             DBCHAR  mnybuf[40];
  101.  
  102.         if(items == 2)
  103.         {
  104.         inx  = getDbProc(STACK(sp)[1]);
  105.         off1 = 2;
  106.         }
  107.         else
  108.         {
  109.         inx  = 0;
  110.         off1 = 1;
  111.             }
  112.  
  113.         if (dbconvert(dbProc[inx].dbproc, SYBCHAR,
  114.               (char *)str_get(STACK(sp)[off1]), (DBINT)-1,
  115.               SYBMONEY, (BYTE*)&m1, (DBINT)-1) == -1)
  116.             {
  117.            fatal("Invalid dbconvert() for &dbmnyminus $m1 parameter");
  118.             }
  119.  
  120.         retval = dbmnyminus(dbProc[inx].dbproc, &m1, &mresult);
  121.  
  122.             new_mnytochar(dbProc[inx].dbproc, &mresult, mnybuf);
  123.  
  124.             --sp;  /* readjust to get rid of space preallocation */
  125.  
  126.             (void)astore(ary,++sp,str_2mortal(str_nmake((double)retval)));
  127.         (void)astore(ary,++sp,str_2mortal(str_make(mnybuf, 0)));
  128.     }
  129.     break;
  130.       case US_dbmnymul:
  131.     if ((items > 3) || (items < 2 ))
  132.         {
  133.         fatal("Usage: @arr = &dbmnymul($dbproc, $m1, $m2)");
  134.         }
  135.     else
  136.     {
  137.         int     retval, off1, off2;
  138.         DBMONEY m1, m2, mresult;
  139.             DBCHAR  mnybuf[40];
  140.  
  141.         if(items == 3)
  142.         {
  143.         inx  = getDbProc(STACK(sp)[1]);
  144.         off1 = 2;
  145.         off2 = 3;
  146.         }
  147.         else
  148.         {
  149.         inx  = 0;
  150.         off1 = 1;
  151.         off2 = 2;
  152.             }
  153.  
  154.         if (dbconvert(dbProc[inx].dbproc, SYBCHAR,
  155.               (char *)str_get(STACK(sp)[off1]), (DBINT)-1,
  156.               SYBMONEY, (BYTE*)&m1, (DBINT)-1) == -1)
  157.             {
  158.            fatal("Invalid dbconvert() for &dbmnymul $m1 parameter");
  159.             }
  160.  
  161.         if (dbconvert(dbProc[inx].dbproc, SYBCHAR,
  162.               (char *)str_get(STACK(sp)[off2]), (DBINT)-1,
  163.               SYBMONEY, (BYTE*)&m2, (DBINT)-1) == -1)
  164.             {
  165.            fatal("Invalid dbconvert() for &dbmnymul $m2 parameter");
  166.             }
  167.  
  168.         retval = dbmnymul(dbProc[inx].dbproc, &m1, &m2, &mresult);
  169.  
  170.             new_mnytochar(dbProc[inx].dbproc, &mresult, mnybuf);
  171.  
  172.             --sp;  /* readjust to get rid of space preallocation */
  173.  
  174.             (void)astore(ary,++sp,str_2mortal(str_nmake((double)retval)));
  175.         (void)astore(ary,++sp,str_2mortal(str_make(mnybuf, 0)));
  176.     }
  177.     break;
  178.       case US_dbmnysub:
  179.     if ((items > 3) || (items < 2 ))
  180.         {
  181.         fatal("Usage: @arr = &dbmnysub($dbproc, $m1, $m2)");
  182.         }
  183.     else
  184.     {
  185.         int     retval, off1, off2;
  186.         DBMONEY m1, m2, mresult;
  187.             DBCHAR  mnybuf[40];
  188.  
  189.         if(items == 3)
  190.         {
  191.         inx  = getDbProc(STACK(sp)[1]);
  192.         off1 = 2;
  193.         off2 = 3;
  194.         }
  195.         else
  196.         {
  197.         inx  = 0;
  198.         off1 = 1;
  199.         off2 = 2;
  200.             }
  201.  
  202.         if (dbconvert(dbProc[inx].dbproc, SYBCHAR,
  203.               (char *)str_get(STACK(sp)[off1]), (DBINT)-1,
  204.               SYBMONEY, (BYTE*)&m1, (DBINT)-1) == -1)
  205.             {
  206.            fatal("Invalid dbconvert() for &dbmnysub $m1 parameter");
  207.             }
  208.  
  209.         if (dbconvert(dbProc[inx].dbproc, SYBCHAR,
  210.               (char *)str_get(STACK(sp)[off2]), (DBINT)-1,
  211.               SYBMONEY, (BYTE*)&m2, (DBINT)-1) == -1)
  212.             {
  213.            fatal("Invalid dbconvert() for &dbmnysub $m2 parameter");
  214.             }
  215.  
  216.         retval = dbmnysub(dbProc[inx].dbproc, &m1, &m2, &mresult);
  217.  
  218.             new_mnytochar(dbProc[inx].dbproc, &mresult, mnybuf);
  219.  
  220.             --sp;  /* readjust to get rid of space preallocation */
  221.  
  222.             (void)astore(ary,++sp,str_2mortal(str_nmake((double)retval)));
  223.         (void)astore(ary,++sp,str_2mortal(str_make(mnybuf, 0)));
  224.     }
  225.     break;
  226.       case US_dbmnyzero:
  227.     if (items > 1)
  228.         {
  229.         fatal("Usage: @arr = &dbmnyzero($dbproc)");
  230.         }
  231.     else
  232.     {
  233.         int     retval;
  234.         DBMONEY mresult;
  235.             DBCHAR  mnybuf[40];
  236.  
  237.         if(items == 1)
  238.         {
  239.         inx = getDbProc(STACK(sp)[1]);
  240.         }
  241.         else
  242.         {
  243.         inx = 0;
  244.             }
  245.  
  246.         retval = dbmnyzero(dbProc[inx].dbproc, &mresult);
  247.  
  248.             new_mnytochar(dbProc[inx].dbproc, &mresult, mnybuf);
  249.  
  250.             --sp;  /* readjust to get rid of space preallocation */
  251.  
  252.             (void)astore(ary,++sp,str_2mortal(str_nmake((double)retval)));
  253.         (void)astore(ary,++sp,str_2mortal(str_make(mnybuf, 0)));
  254.     }
  255.     break;
  256.       case US_dbmnydec:
  257.     if ((items > 2) || (items < 1 ))
  258.         {
  259.         fatal("Usage: @arr = &dbmnydec($dbproc, $m1)");
  260.         }
  261.     else
  262.     {
  263.         int     retval, off1;
  264.         DBMONEY mresult;
  265.             DBCHAR  mnybuf[40];
  266.  
  267.         if(items == 2)
  268.         {
  269.         inx  = getDbProc(STACK(sp)[1]);
  270.         off1 = 2;
  271.         }
  272.         else
  273.         {
  274.         inx  = 0;
  275.         off1 = 1;
  276.             }
  277.  
  278.         if (dbconvert(dbProc[inx].dbproc, SYBCHAR,
  279.               (char *)str_get(STACK(sp)[off1]), (DBINT)-1,
  280.               SYBMONEY, (BYTE *)&mresult, (DBINT)-1) == -1)
  281.             {
  282.            fatal("Invalid dbconvert() for &dbmnydec $m1 parameter");
  283.             }
  284.  
  285.         retval = dbmnydec(dbProc[inx].dbproc, &mresult);
  286.  
  287.             new_mnytochar(dbProc[inx].dbproc, &mresult, mnybuf);
  288.  
  289.             --sp;  /* readjust to get rid of space preallocation */
  290.  
  291.             (void)astore(ary,++sp,str_2mortal(str_nmake((double)retval)));
  292.         (void)astore(ary,++sp,str_2mortal(str_make(mnybuf, 0)));
  293.     }
  294.     break;
  295.       case US_dbmnydown:
  296.     if ((items > 3) || (items < 2 ))
  297.         {
  298.         fatal("Usage: @arr = &dbmnydown($dbproc, $m1, $i1)");
  299.         }
  300.     else
  301.     {
  302.         int     retval, off1, off2;
  303.         int   i1, iresult = 0;
  304.         DBMONEY mresult;
  305.             DBCHAR  mnybuf[40];
  306.  
  307.         if(items == 3)
  308.         {
  309.         inx  = getDbProc(STACK(sp)[1]);
  310.         off1 = 2;
  311.         off2 = 3;
  312.         }
  313.         else
  314.         {
  315.         inx  = 0;
  316.         off1 = 1;
  317.         off2 = 2;
  318.             }
  319.  
  320.         if (dbconvert(dbProc[inx].dbproc, SYBCHAR,
  321.               (char *)str_get(STACK(sp)[off1]), (DBINT)-1,
  322.               SYBMONEY, (BYTE*)&mresult, (DBINT)-1) == -1)
  323.             {
  324.            fatal("Invalid dbconvert() for &dbmnydown $m1 parameter");
  325.             }
  326.  
  327.         if (dbconvert(dbProc[inx].dbproc, SYBCHAR,
  328.               (char *)str_get(STACK(sp)[off2]), (DBINT)-1,
  329.               SYBINT4, (BYTE*)&i1, (DBINT)-1) == -1)
  330.             {
  331.            fatal("Invalid dbconvert() for &dbmnydown $i1 parameter");
  332.             }
  333.  
  334.         retval = dbmnydown(dbProc[inx].dbproc, &mresult, i1, &iresult);
  335.  
  336.             new_mnytochar(dbProc[inx].dbproc, &mresult, mnybuf);
  337.  
  338.             --sp;  /* readjust to get rid of space preallocation */
  339.  
  340.             (void)astore(ary,++sp,str_2mortal(str_nmake((double)retval)));
  341.         (void)astore(ary,++sp,str_2mortal(str_make(mnybuf, 0)));
  342.             (void)astore(ary,++sp,str_2mortal(str_nmake((double)iresult)));
  343.     }
  344.     break;
  345.       case US_dbmnyinc:
  346.     if ((items > 2) || (items < 1 ))
  347.         {
  348.         fatal("Usage: @arr = &dbmnyinc($dbproc, $m1)");
  349.         }
  350.     else
  351.     {
  352.         int     retval, off1;
  353.         DBMONEY mresult;
  354.             DBCHAR  mnybuf[40];
  355.  
  356.         if(items == 2)
  357.         {
  358.         inx  = getDbProc(STACK(sp)[1]);
  359.         off1 = 2;
  360.         }
  361.         else
  362.         {
  363.         inx  = 0;
  364.         off1 = 1;
  365.             }
  366.  
  367.         if (dbconvert(dbProc[inx].dbproc, SYBCHAR,
  368.               (char *)str_get(STACK(sp)[off1]), (DBINT)-1,
  369.               SYBMONEY, (BYTE*)&mresult, (DBINT)-1) == -1)
  370.             {
  371.            fatal("Invalid dbconvert() for &dbmnyinc $m1 parameter");
  372.             }
  373.  
  374.         retval = dbmnyinc(dbProc[inx].dbproc, &mresult);
  375.  
  376.             new_mnytochar(dbProc[inx].dbproc, &mresult, mnybuf);
  377.  
  378.             --sp;  /* readjust to get rid of space preallocation */
  379.  
  380.             (void)astore(ary,++sp,str_2mortal(str_nmake((double)retval)));
  381.         (void)astore(ary,++sp,str_2mortal(str_make(mnybuf, 0)));
  382.     }
  383.     break;
  384.       case US_dbmnyinit:
  385.     if ((items > 3) || (items < 2 ))
  386.         {
  387.         fatal("Usage: @arr = &dbmnyinit($dbproc, $m1, $i1)");
  388.         }
  389.     else
  390.     {
  391.         int     retval, off1, off2;
  392.         DBINT   i1, iresult;
  393.         DBMONEY mresult;
  394.         DBBOOL  bresult = (DBBOOL)FALSE;
  395.             DBCHAR  mnybuf[40];
  396.  
  397.         if(items == 3)
  398.         {
  399.         inx  = getDbProc(STACK(sp)[1]);
  400.         off1 = 2;
  401.         off2 = 3;
  402.         }
  403.         else
  404.         {
  405.         inx  = 0;
  406.         off1 = 1;
  407.         off2 = 2;
  408.             }
  409.  
  410.         if (dbconvert(dbProc[inx].dbproc, SYBCHAR,
  411.               (char *)str_get(STACK(sp)[off1]), (DBINT)-1,
  412.               SYBMONEY, (BYTE*)&mresult, (DBINT)-1) == -1)
  413.             {
  414.            fatal("Invalid dbconvert() for &dbmnyinit $m1 parameter");
  415.             }
  416.  
  417.         if (dbconvert(dbProc[inx].dbproc, SYBCHAR,
  418.               (char *)str_get(STACK(sp)[off2]), (DBINT)-1,
  419.               SYBINT4, (BYTE*)&i1, (DBINT)-1) == -1)
  420.             {
  421.            fatal("Invalid dbconvert() for &dbmnyinit $i1 parameter");
  422.             }
  423.  
  424.         retval = dbmnyinit(dbProc[inx].dbproc, &mresult, i1, &bresult);
  425.  
  426.             new_mnytochar(dbProc[inx].dbproc, &mresult, mnybuf);
  427.  
  428.         iresult = (DBINT)bresult;
  429.  
  430.             --sp;  /* readjust to get rid of space preallocation */
  431.  
  432.             (void)astore(ary,++sp,str_2mortal(str_nmake((double)retval)));
  433.         (void)astore(ary,++sp,str_2mortal(str_make(mnybuf, 0)));
  434.             (void)astore(ary,++sp,str_2mortal(str_nmake((double)iresult)));
  435.     }
  436.     break;
  437.       case US_dbmnymaxneg:
  438.     if (items > 1)
  439.         {
  440.         fatal("Usage: @arr = &dbmnymaxneg($dbproc)");
  441.         }
  442.     else
  443.     {
  444.         int     retval;
  445.         DBMONEY mresult;
  446.             DBCHAR  mnybuf[40];
  447.  
  448.         if(items == 1)
  449.         {
  450.         inx = getDbProc(STACK(sp)[1]);
  451.         }
  452.         else
  453.         {
  454.         inx = 0;
  455.             }
  456.  
  457.         retval = dbmnymaxneg(dbProc[inx].dbproc, &mresult);
  458.  
  459.             new_mnytochar(dbProc[inx].dbproc, &mresult, mnybuf);
  460.  
  461.             --sp;  /* readjust to get rid of space preallocation */
  462.  
  463.             (void)astore(ary,++sp,str_2mortal(str_nmake((double)retval)));
  464.         (void)astore(ary,++sp,str_2mortal(str_make(mnybuf, 0)));
  465.     }
  466.     break;
  467.       case US_dbmnymaxpos:
  468.     if (items > 1)
  469.         {
  470.         fatal("Usage: @arr = &dbmnymaxpos($dbproc)");
  471.         }
  472.     else
  473.     {
  474.         int     retval;
  475.         DBMONEY mresult;
  476.             DBCHAR  mnybuf[40];
  477.  
  478.         if(items == 1)
  479.         {
  480.         inx = getDbProc(STACK(sp)[1]);
  481.         }
  482.         else
  483.         {
  484.         inx = 0;
  485.             }
  486.  
  487.         retval = dbmnymaxpos(dbProc[inx].dbproc, &mresult);
  488.  
  489.             new_mnytochar(dbProc[inx].dbproc, &mresult, mnybuf);
  490.  
  491.             --sp;  /* readjust to get rid of space preallocation */
  492.  
  493.             (void)astore(ary,++sp,str_2mortal(str_nmake((double)retval)));
  494.         (void)astore(ary,++sp,str_2mortal(str_make(mnybuf, 0)));
  495.     }
  496.     break;
  497.       case US_dbmnyndigit:
  498.     if ((items > 2) || (items < 1 ))
  499.         {
  500.         fatal("Usage: @arr = &dbmnyndigit($dbproc, $m1)");
  501.         }
  502.     else
  503.     {
  504.         int     retval, off1;
  505.         DBMONEY mresult;
  506.         DBINT   iresult;
  507.         DBBOOL  bresult = (DBBOOL)FALSE;
  508.             DBCHAR  mnybuf[40], dgtbuf[ 10 ];
  509.  
  510.         if(items == 2)
  511.         {
  512.         inx  = getDbProc(STACK(sp)[1]);
  513.         off1 = 2;
  514.         }
  515.         else
  516.         {
  517.         inx  = 0;
  518.         off1 = 1;
  519.             }
  520.  
  521.         if (dbconvert(dbProc[inx].dbproc, SYBCHAR,
  522.               (char *)str_get(STACK(sp)[off1]), (DBINT)-1,
  523.               SYBMONEY, (BYTE*)&mresult, (DBINT)-1) == -1)
  524.             {
  525.            fatal("Invalid dbconvert() for &dbmnyndigit $m1 parameter");
  526.             }
  527.  
  528.         retval = dbmnyndigit(dbProc[inx].dbproc, &mresult, dgtbuf, &bresult);
  529.  
  530.             new_mnytochar(dbProc[inx].dbproc, &mresult, mnybuf);
  531.  
  532.         iresult = (DBINT)bresult;
  533.  
  534.             --sp;  /* readjust to get rid of space preallocation */
  535.  
  536.             (void)astore(ary,++sp,str_2mortal(str_nmake((double)retval)));
  537.         (void)astore(ary,++sp,str_2mortal(str_make(mnybuf, 0)));
  538.         (void)astore(ary,++sp,str_2mortal(str_make(dgtbuf, 0)));
  539.             (void)astore(ary,++sp,str_2mortal(str_nmake((double)iresult)));
  540.     }
  541.     break;
  542.       case US_dbmnyscale:
  543.     if ((items > 4) || (items < 3 ))
  544.         {
  545.         fatal("Usage: @arr = &dbmnyscale($dbproc, $m1, $i1, $i2)");
  546.         }
  547.     else
  548.     {
  549.         int     retval, off1, off2, off3;
  550.         DBINT   i1, i2;
  551.         DBMONEY mresult;
  552.             DBCHAR  mnybuf[40];
  553.  
  554.         if(items == 4)
  555.         {
  556.         inx  = getDbProc(STACK(sp)[1]);
  557.         off1 = 2;
  558.         off2 = 3;
  559.         off3 = 4;
  560.         }
  561.         else
  562.         {
  563.         inx  = 0;
  564.         off1 = 1;
  565.         off2 = 2;
  566.         off3 = 3;
  567.             }
  568.  
  569.         if (dbconvert(dbProc[inx].dbproc, SYBCHAR,
  570.               (char *)str_get(STACK(sp)[off1]), (DBINT)-1,
  571.               SYBMONEY, (BYTE*)&mresult, (DBINT)-1) == -1)
  572.             {
  573.            fatal("Invalid dbconvert() for &dbmnyscale $m1 parameter");
  574.             }
  575.  
  576.         if (dbconvert(dbProc[inx].dbproc, SYBCHAR,
  577.               (char *)str_get(STACK(sp)[off2]), (DBINT)-1,
  578.               SYBINT4, (BYTE*)&i1, (DBINT)-1) == -1)
  579.             {
  580.            fatal("Invalid dbconvert() for &dbmnyscale $i1 parameter");
  581.             }
  582.  
  583.         if (dbconvert(dbProc[inx].dbproc, SYBCHAR,
  584.               (char *)str_get(STACK(sp)[off3]), (DBINT)-1,
  585.               SYBINT4, (BYTE*)&i2, (DBINT)-1) == -1)
  586.             {
  587.            fatal("Invalid dbconvert() for &dbmnyscale $i2 parameter");
  588.             }
  589.  
  590.         retval = dbmnyscale(dbProc[inx].dbproc, &mresult, i1, i2);
  591.  
  592.             new_mnytochar(dbProc[inx].dbproc, &mresult, mnybuf);
  593.  
  594.             --sp;  /* readjust to get rid of space preallocation */
  595.  
  596.             (void)astore(ary,++sp,str_2mortal(str_nmake((double)retval)));
  597.         (void)astore(ary,++sp,str_2mortal(str_make(mnybuf, 0)));
  598.     }
  599.     break;
  600. #endif
  601.       case US_dbwritetext:
  602.         if (items != 5)
  603.             fatal ("Usage: dbwritetext($dbproc1,$column,$dbproc2,$col,$text");
  604.     else
  605.     {
  606.         int inx2, wcolnum;
  607.         char *wcolname, *wtext;
  608.         int ret;
  609.         
  610.         inx = getDbProc(STACK(sp)[1]);
  611.         wcolname = str_get(STACK(sp)[2]);
  612.         inx2 = getDbProc(STACK(sp)[3]);
  613.         wcolnum = (int)str_gnum(STACK(sp)[4]);
  614.         wtext = str_get(STACK(sp)[5]);
  615.         ret = dbwritetext (dbProc[inx].dbproc, wcolname, dbtxptr(dbProc[inx2].dbproc, wcolnum),
  616.                    DBTXPLEN, dbtxtimestamp(dbProc[inx2].dbproc, wcolnum), 0,
  617.                    strlen(wtext), wtext);
  618.         str_numset(STACK(sp)[0], (double) ret);
  619.     }
  620.         break;
  621.       case US_dbnumcols:
  622.     if (items > 1)
  623.         fatal("Usage: $dbnumcols = &dbnumcols($dbproc);");
  624.     else
  625.     {
  626.         int j;
  627.  
  628.         if(items)
  629.         inx = getDbProc(STACK(sp)[1]);
  630.         else
  631.         inx = 0;
  632.         
  633.         j = dbnumcols(dbProc[inx].dbproc);
  634.         str_numset(STACK(sp)[0], (double) j);
  635.     }
  636.     break;
  637.       case US_dbcoltype:
  638.     if (items > 2 || items < 1)
  639.         fatal("Usage: $dbcoltype = &dbcoltype($dbproc, columnid);");
  640.     else
  641.     {
  642.         int j, off;
  643.         
  644.         if(items)
  645.         {
  646.         inx = getDbProc(STACK(sp)[1]);
  647.         off = 2;
  648.         }
  649.         else
  650.         inx = 0, off = 1;
  651.         
  652.         
  653.         j = dbcoltype(dbProc[inx].dbproc, (int)str_gnum(STACK(sp)[off]));
  654.         str_numset(STACK(sp)[0], (double) j);
  655.     }
  656.     break;
  657.       case US_dbcolname:
  658.     if (items > 2 || items < 1)
  659.         fatal("Usage: $dbcolname = &dbcolname($dbproc, columnid);");
  660.     else
  661.     {
  662.         int j, off;
  663.         char *colname;
  664.         
  665.         if(items)
  666.         {
  667.         inx = getDbProc(STACK(sp)[1]);
  668.         off = 2;
  669.         }
  670.         else
  671.         inx = 0, off = 1;
  672.         
  673.         
  674.         colname = dbcolname(dbProc[inx].dbproc, (int)str_gnum(STACK(sp)[off]));
  675.         str_set (STACK (sp)[0], colname);
  676.     }
  677.     break;
  678.       case US_dbcollen:
  679.     if (items > 2)
  680.         fatal("Usage: $dbcollen = &dbcollen($dbproc, columnid);");
  681.     else
  682.     {
  683.         int j, off;
  684.         
  685.         if(items)
  686.         {
  687.         inx = getDbProc(STACK(sp)[1]);
  688.         off = 2;
  689.         }
  690.         else
  691.         inx = 0, off = 1;
  692.         
  693.         
  694.         j = dbcollen(dbProc[inx].dbproc, (int)str_gnum(STACK(sp)[off]));
  695.         str_numset(STACK(sp)[0], (double) j);
  696.     }
  697.     break;
  698.       case US_dbrecftos:
  699.     if (items != 1)
  700.         fatal("Usage: &dbrecftos($filename);");
  701.     else
  702.     {
  703.         dbrecftos((char *)str_get(STACK(sp)[1]));
  704.         
  705.         str_numset(STACK(sp)[0], (double) 0);
  706.     }
  707.     break;
  708.  
  709.       case US_BCP_SETL:
  710.     if (items != 1)
  711.         fatal("Usage: &BCP_SETL($state);");
  712.     else
  713.     {
  714.         BCP_SETL(login, (int)str_gnum(STACK(sp)[1]));
  715.         str_numset(STACK(sp)[0], (double) 0);
  716.     }
  717.     break;
  718.  
  719.       case US_bcp_getl:
  720.     if (items)
  721.         fatal("Usage: $state = &bcp_getl();");
  722.     else
  723.     {
  724.         int ret;
  725.         ret = bcp_getl(login);
  726.         str_numset(STACK(sp)[0], (double) ret);
  727.     }
  728.     break;
  729.  
  730.       case US_bcp_init:
  731.     if (items < 4 || items > 5)
  732.         fatal("Usage: &bcp_init($dbproc, $tblname, $hfile, $errfile, $dir);");
  733.     else
  734.     {
  735.         int j, off;
  736.         char *hfile;
  737.         
  738.         if(items == 5)
  739.         {
  740.         inx = getDbProc(STACK(sp)[1]);
  741.         off = 2;
  742.         }
  743.         else
  744.         inx = 0, off = 1;
  745.  
  746.         hfile = str_get(STACK(sp)[off+1]);
  747.         if((Str = STACK(sp)[off+1]) == &str_undef ||
  748.            ((hfile = str_get(Str)) && strlen(hfile) == 0))
  749.         hfile = NULL;
  750.         j = bcp_init(dbProc[inx].dbproc, str_get(STACK(sp)[off]),
  751.              hfile,
  752.              str_get(STACK(sp)[off+2]),
  753.              (int)str_gnum(STACK(sp)[off+3]));
  754.         str_numset(STACK(sp)[0], (double) j);
  755.     }
  756.     break;
  757.  
  758.       case US_bcp_meminit:
  759.     if (items < 1 || items > 2)
  760.         fatal("Usage: &bcp_meminit($dbproc, $num_cols);");
  761.     else
  762.     {
  763.         int j, off, numcols;
  764.         BYTE dummy;
  765.         
  766.         if(items == 2)
  767.         {
  768.         inx = getDbProc(STACK(sp)[1]);
  769.         off = 2;
  770.         }
  771.         else
  772.         inx = 0, off = 1;
  773.         numcols = str_gnum(STACK(sp)[off]);
  774.         for(j = 1; j <= numcols; ++j)
  775.         bcp_bind(dbProc[inx].dbproc, &dummy, 0, -1, "", 1, SYBCHAR, j);
  776.  
  777.         if(dbProc[inx].colPtr) /* avoid a potential memory leak */
  778.         Safefree(dbProc[inx].colPtr);
  779.         New (902, dbProc[inx].colPtr, numcols, BYTE *);
  780.         
  781.         str_numset(STACK(sp)[0], (double) j);
  782.     }
  783.     break;
  784.     
  785.       case US_bcp_sendrow:    /* WARNING: the dbproc param is NOT */
  786.                 /* optional for this call!!! */
  787.     if (items < 2)
  788.         fatal("Usage: &bcp_sendrow($dbproc, LIST);");
  789.     else
  790.     {
  791.         int j, off;
  792.  
  793.         inx = getDbProc(STACK(sp)[1]);
  794.         for(j = 1; j < items; ++j)
  795.         {
  796.         Str = STACK(sp)[j+1];
  797.         if(Str == &str_undef) /* it's a NULL data value */
  798.             bcp_collen(dbProc[inx].dbproc, 0, j);
  799.         else
  800.             bcp_collen(dbProc[inx].dbproc, -1, j);
  801.         dbProc[inx].colPtr[j] = (BYTE *)str_get(Str);
  802.         bcp_colptr(dbProc[inx].dbproc, dbProc[inx].colPtr[j], j);
  803.         }
  804.         j = bcp_sendrow(dbProc[inx].dbproc);
  805.         str_numset(STACK(sp)[0], (double) j);
  806.     }
  807.     break;
  808.     
  809.       case US_bcp_batch:
  810.     if (items > 1)
  811.         fatal("Usage: $ret = &bcp_batch($dbproc);");
  812.     else
  813.     {
  814.         int j;
  815.         
  816.         if(items)
  817.         inx = getDbProc(STACK(sp)[1]);
  818.         else
  819.         inx = 0;
  820.         
  821.         j = bcp_batch(dbProc[inx].dbproc);
  822.         str_numset(STACK(sp)[0], (double) j);
  823.     }
  824.     break;
  825.         
  826.       case US_bcp_done:
  827.     if (items > 1)
  828.         fatal("Usage: $ret = &bcp_done($dbproc);");
  829.     else
  830.     {
  831.         int j;
  832.         
  833.         if(items)
  834.         inx = getDbProc(STACK(sp)[1]);
  835.         else
  836.         inx = 0;
  837.         if(dbProc[inx].colPtr)
  838.         {
  839.         Safefree(dbProc[inx].colPtr);
  840.         dbProc[inx].colPtr = NULL;
  841.         }
  842.         j = bcp_done(dbProc[inx].dbproc);
  843.         str_numset(STACK(sp)[0], (double) j);
  844.     }
  845.     break;
  846.  
  847.       case US_bcp_control:
  848.     if (items < 2 || items > 3)
  849.         fatal("Usage: $ret = &bcp_control($dbproc, $field, $value);");
  850.     else
  851.     {
  852.         int j, off;
  853.  
  854.         if(items == 3)
  855.         {
  856.         inx = getDbProc(STACK(sp)[1]);
  857.         off = 2;
  858.         }
  859.         else
  860.         inx = 0, off = 1;
  861.         j = bcp_control(dbProc[inx].dbproc, (int)str_gnum(STACK(sp)[off]),
  862.                 (int)str_gnum(STACK(sp)[off+1]));
  863.         str_numset(STACK(sp)[0], (double) j);
  864.     }
  865.     break;
  866.         
  867.       case US_bcp_columns:
  868.     if (items < 1 || items > 2)
  869.         fatal("Usage: $ret = &bcp_columns($dbproc, $host_colcount);");
  870.     else
  871.     {
  872.         int j, off;
  873.  
  874.         if(items == 2)
  875.         {
  876.         inx = getDbProc(STACK(sp)[1]);
  877.         off = 2;
  878.         }
  879.         else
  880.         inx = 0, off = 1;
  881.         j = bcp_columns(dbProc[inx].dbproc, (int)str_gnum(STACK(sp)[off]));
  882.         str_numset(STACK(sp)[0], (double) j);
  883.     }
  884.     break;
  885.         
  886.       case US_bcp_colfmt:
  887.     if (items < 7 || items > 8)
  888.         fatal("Usage: $ret = &bcp_colfmt($dbproc, $host_colnum, $host_type, $host_prefixlen, $host_collen, $host_term, $host_termlen, $table_colnum);");
  889.     else
  890.     {
  891.         int j, off;
  892.         char *host_term;
  893.  
  894.         if(items == 8)
  895.         {
  896.         inx = getDbProc(STACK(sp)[1]);
  897.         off = 2;
  898.         }
  899.         else
  900.         inx = 0, off = 1;
  901.  
  902.         if(STACK(sp)[off+4] == &str_undef)
  903.         host_term = NULL;
  904.         else
  905.         host_term = str_get(STACK(sp)[off+4]);
  906.         
  907.         j = bcp_colfmt(dbProc[inx].dbproc, (int)str_gnum(STACK(sp)[off]),
  908.                (int)str_gnum(STACK(sp)[off+1]),
  909.                (int)str_gnum(STACK(sp)[off+2]),
  910.                (int)str_gnum(STACK(sp)[off+3]),
  911.                host_term,
  912.                (int)str_gnum(STACK(sp)[off+5]),
  913.                (int)str_gnum(STACK(sp)[off+6]));
  914.         str_numset(STACK(sp)[0], (double) j);
  915.     }
  916.     break;
  917.         
  918.       case US_bcp_collen:
  919.     if (items < 2 || items > 3)
  920.         fatal("Usage: $ret = &bcp_collen($dbproc, $varlen, $table_column);");
  921.     else
  922.     {
  923.         int j, off;
  924.  
  925.         if(items == 3)
  926.         {
  927.         inx = getDbProc(STACK(sp)[1]);
  928.         off = 2;
  929.         }
  930.         else
  931.         inx = 0, off = 1;
  932.         j = bcp_collen(dbProc[inx].dbproc, (int)str_gnum(STACK(sp)[off]),
  933.                (int)str_gnum(STACK(sp)[off+1]));
  934.         str_numset(STACK(sp)[0], (double) j);
  935.     }
  936.     break;
  937.     
  938.       case US_bcp_exec:
  939.     if (items > 1)
  940.         fatal("Usage: ($ret, $rows_copied) = &bcp_exec($dbproc);");
  941.     else
  942.     {
  943.         int j;
  944.         DBINT rows;
  945.  
  946.         if(items == 1)
  947.         inx = getDbProc(STACK(sp)[1]);
  948.         else
  949.         inx = 0;
  950.         j = bcp_exec(dbProc[inx].dbproc, &rows);
  951.         
  952.             --sp;  /* readjust to get rid of space preallocation */
  953.  
  954.             (void)astore(ary,++sp,str_2mortal(str_nmake((double)j)));
  955.         (void)astore(ary,++sp,str_2mortal(str_nmake((double)rows)));
  956.     }
  957.     break;
  958.         
  959.       case US_bcp_readfmt:
  960.     if (items < 1 || items > 2)
  961.         fatal("Usage: $ret = &bcp_readfmt($dbproc, $filename);");
  962.     else
  963.     {
  964.         int j, off;
  965.  
  966.         if(items == 2)
  967.         {
  968.         inx = getDbProc(STACK(sp)[1]);
  969.         off = 2;
  970.         }
  971.         else
  972.         inx = 0, off = 1;
  973.         j = bcp_readfmt(dbProc[inx].dbproc, str_get(STACK(sp)[off]));
  974.         str_numset(STACK(sp)[0], (double) j);
  975.     }
  976.     break;
  977.     
  978.       case US_bcp_writefmt:
  979.     if (items < 1 || items > 2)
  980.         fatal("Usage: $ret = &bcp_writefmt($dbproc, $filename);");
  981.     else
  982.     {
  983.         int j, off;
  984.  
  985.         if(items == 2)
  986.         {
  987.         inx = getDbProc(STACK(sp)[1]);
  988.         off = 2;
  989.         }
  990.         else
  991.         inx = 0, off = 1;
  992.         j = bcp_writefmt(dbProc[inx].dbproc, str_get(STACK(sp)[off]));
  993.         str_numset(STACK(sp)[0], (double) j);
  994.     }
  995.     break;
  996.     
  997.       default:
  998.     fatal("Unimplemented user-defined subroutine");
  999.     }
  1000.     return sp;
  1001. }
  1002.  
  1003. /* 
  1004.  * Return the value of a userdefined variable. These variables are nearly all
  1005.  * READ-ONLY.
  1006.  */
  1007. static int
  1008. userval(ix, str)
  1009. int ix;
  1010. STR *str;
  1011. {
  1012.     char buff[24];
  1013.     
  1014.     switch (ix)
  1015.     {
  1016.       case UV_SUCCEED:
  1017.     str_numset(str, (double)SUCCEED);
  1018.     break;
  1019.       case UV_FAIL:
  1020.     str_numset(str, (double)FAIL);
  1021.     break;
  1022.       case UV_NO_MORE_ROWS:
  1023.     str_numset(str, (double)NO_MORE_ROWS);
  1024.     break;
  1025.       case UV_NO_MORE_RESULTS:
  1026.     str_numset(str, (double)NO_MORE_RESULTS);
  1027.     break;
  1028.       case UV_ComputeId:
  1029.     str_numset(str, (double)ComputeId);
  1030.     break;
  1031.       case UV_SybperlVer:
  1032.     sprintf(buff, "%d.%3.3d", VERSION, PATCHLEVEL);
  1033.     str_set(str, buff);
  1034.     break;
  1035.       case UV_DBstatus:
  1036.     str_numset(str, (double)DBstatus);
  1037.     break;
  1038. #if defined(DBLIB461)
  1039.       case UV_STDEXIT:
  1040.     str_numset(str, (double)STDEXIT);
  1041.     break;
  1042.       case UV_ERREXIT:
  1043.     str_numset(str, (double)ERREXIT);
  1044.     break;
  1045.       case UV_INT_EXIT:
  1046.     str_numset(str, (double)INT_EXIT);
  1047.     break;
  1048.       case UV_INT_CONTINUE:
  1049.     str_numset(str, (double)INT_CONTINUE);
  1050.     break;
  1051.       case UV_INT_CANCEL:
  1052.     str_numset(str, (double)INT_CANCEL);
  1053.     break;
  1054.       case UV_INT_TIMEOUT:
  1055.     str_numset(str, (double)INT_TIMEOUT);
  1056.     break;
  1057.       case UV_MORE_ROWS:
  1058.     str_numset(str, (double)MORE_ROWS);
  1059.     break;
  1060.       case UV_REG_ROW:
  1061.     str_numset(str, (double)REG_ROW);
  1062.     break;
  1063.       case UV_BUF_FULL:
  1064.     str_numset(str, (double)BUF_FULL);
  1065.     break;
  1066.       case UV_NO_MORE_PARAMS:
  1067.     str_numset(str, (double)NO_MORE_PARAMS);
  1068.     break;
  1069.       case UV_DBSAVE:
  1070.     str_numset(str, (double)DBSAVE);
  1071.     break;
  1072.       case UV_DBNOSAVE:
  1073.     str_numset(str, (double)DBNOSAVE);
  1074.     break;
  1075.       case UV_DBNOERR:
  1076.     str_numset(str, (double)DBNOERR);
  1077.     break;
  1078.       case UV_DB_PASSTHRU_MORE:
  1079.     str_numset(str, (double)DB_PASSTHRU_MORE);
  1080.     break;
  1081.       case UV_DB_PASSTHRU_EOM:
  1082.     str_numset(str, (double)DB_PASSTHRU_EOM);
  1083.     break;
  1084.       case UV_DBNOPROC:
  1085.     str_numset(str, (double)DBNOPROC);
  1086.     break;
  1087.       case UV_EXCEPTION:
  1088.     str_numset(str, (double)EXCEPTION);
  1089.     break;
  1090.       case UV_EXSIGNAL:
  1091.     str_numset(str, (double)EXSIGNAL);
  1092.     break;
  1093.       case UV_EXSCREENIO:
  1094.     str_numset(str, (double)EXSCREENIO);
  1095.     break;
  1096.       case UV_EXDBLIB:
  1097.     str_numset(str, (double)EXDBLIB);
  1098.     break;
  1099.       case UV_EXFORMS:
  1100.     str_numset(str, (double)EXFORMS);
  1101.     break;
  1102.       case UV_EXCLIPBOARD:
  1103.     str_numset(str, (double)EXCLIPBOARD);
  1104.     break;
  1105.       case UV_EXLOOKUP:
  1106.     str_numset(str, (double)EXLOOKUP);
  1107.     break;
  1108.       case UV_EXINFO:
  1109.     str_numset(str, (double)EXINFO);
  1110.     break;
  1111.       case UV_EXUSER:
  1112.     str_numset(str, (double)EXUSER);
  1113.     break;
  1114.       case UV_EXNONFATAL:
  1115.     str_numset(str, (double)EXNONFATAL);
  1116.     break;
  1117.       case UV_EXCONVERSION:
  1118.     str_numset(str, (double)EXCONVERSION);
  1119.     break;
  1120.       case UV_EXSERVER:
  1121.     str_numset(str, (double)EXSERVER);
  1122.     break;
  1123.       case UV_EXTIME:
  1124.     str_numset(str, (double)EXTIME);
  1125.     break;
  1126.       case UV_EXPROGRAM:
  1127.     str_numset(str, (double)EXPROGRAM);
  1128.     break;
  1129.       case UV_EXRESOURCE:
  1130.     str_numset(str, (double)EXRESOURCE);
  1131.     break;
  1132.       case UV_EXCOMM:
  1133.     str_numset(str, (double)EXCOMM);
  1134.     break;
  1135.       case UV_EXFATAL:
  1136.     str_numset(str, (double)EXFATAL);
  1137.     break;
  1138.       case UV_EXCONSISTENCY:
  1139.     str_numset(str, (double)EXCONSISTENCY);
  1140.     break;
  1141. #endif
  1142.       case UV_DB_IN:
  1143.     str_numset(str, (double)DB_IN);
  1144.     break;
  1145.       case UV_DB_OUT:
  1146.     str_numset(str, (double)DB_OUT);
  1147.     break;
  1148.       case UV_BCPMAXERRS:
  1149.     str_numset(str, (double)BCPMAXERRS);
  1150.     break;
  1151.       case UV_BCPFIRST:
  1152.     str_numset(str, (double)BCPFIRST);
  1153.     break;
  1154.       case UV_BCPLAST:
  1155.     str_numset(str, (double)BCPLAST);
  1156.     break;
  1157.       case UV_BCPBATCH:
  1158.     str_numset(str, (double)BCPBATCH);
  1159.     break;
  1160.       case UV_DBTRUE:
  1161.     str_numset(str, (double)TRUE);
  1162.     break;
  1163.       case UV_DBFALSE:
  1164.     str_numset(str, (double)FALSE);
  1165.     break;
  1166. #if defined(PACKAGE_BUG)
  1167.       case UV_PACKAGE_BUG:
  1168.     str_numset(str, 1.0);
  1169.     break;
  1170. #endif
  1171.       case UV_dbNullIsUndef:
  1172.     str_numset(str, (double)dbNullIsUndef);
  1173.     break;
  1174.       case UV_dbKeepNumeric:
  1175.     str_numset(str, (double)dbKeepNumeric);
  1176.     break;
  1177.       case UV_dbBin0x:
  1178.     str_numset(str, (double)dbBin0x);
  1179.     break;
  1180.      }
  1181.     return 0;
  1182. }
  1183.  
  1184. static int
  1185. userset(ix, str)
  1186. int ix;
  1187. STR *str;
  1188. {
  1189.     switch (ix)
  1190.     {
  1191.       case UV_dbNullIsUndef:
  1192.     dbNullIsUndef = str_gnum(str);
  1193.     break;
  1194.       case UV_dbKeepNumeric:
  1195.     dbKeepNumeric = str_gnum(str);
  1196.     break;
  1197.       case UV_dbBin0x:
  1198.     dbBin0x = str_gnum(str);
  1199.     break;
  1200.       default:
  1201. #if defined(USERVAL_SET_FATAL)
  1202.     fatal("sybperl: trying to write to a read-only variable.");
  1203. #else
  1204.     warn("sybperl: trying to write to a read-only variable.");
  1205. #endif
  1206.     break;
  1207.     }
  1208.     return 0;
  1209. }
  1210.  
  1211.  
  1212. /*ARGSUSED*/
  1213. static int err_handler(db, severity, dberr, oserr, dberrstring, oserrstr)
  1214.     DBPROCESS *db;
  1215.     int severity;
  1216.     int dberr;
  1217.     int oserr;
  1218.     char *dberrstring;
  1219.     char *oserrstr;
  1220. {
  1221. #ifdef HAS_CALLBACK
  1222.     /* If we have error handler subroutine, use it. */
  1223.     if (err_handler_sub)
  1224.     {
  1225.     int sp = perl_sp;
  1226.     int j;
  1227.  
  1228.     for(j = 0; j < MAX_DBPROCS; ++j)
  1229.         if(db == dbProc[j].dbproc)
  1230.         break;
  1231.     if(j == MAX_DBPROCS)
  1232.         j = 0;
  1233.     
  1234.     /* Reserve spot for return value. */
  1235.     astore (stack, ++ sp, Nullstr);
  1236.     
  1237.     /* Set up arguments. */
  1238.     astore (stack, ++ sp,
  1239.         str_2mortal (str_nmake ((double) j)));
  1240.     astore (stack, ++ sp, str_2mortal (str_nmake ((double) severity)));
  1241.     astore (stack, ++ sp, str_2mortal (str_nmake ((double) dberr)));
  1242.     astore (stack, ++ sp, str_2mortal (str_nmake ((double) oserr)));
  1243.     if (dberrstring && *dberrstring)
  1244.         astore (stack, ++ sp, str_2mortal (str_make (dberrstring, 0)));
  1245.     else
  1246.         astore (stack, ++ sp, &str_undef);
  1247.     if (oserrstr && *oserrstr)
  1248.         astore (stack, ++ sp, str_2mortal (str_make (oserrstr, 0)));
  1249.     else
  1250.         astore (stack, ++ sp, &str_undef);
  1251.     
  1252.     /* Call it. */
  1253.     sp = callback (err_handler_sub, sp, 0, 1, 6);
  1254.     
  1255.     /* Return whatever it returned. */
  1256.     return (int) str_gnum (STACK (sp)[0]);
  1257.     }
  1258. #endif                /* HAS_CALLBACK */
  1259.     if ((db == NULL) || (DBDEAD(db)))
  1260.     return(INT_EXIT);
  1261.     else 
  1262.     {
  1263.     fprintf(stderr,"DB-Library error:\n\t%s\n", dberrstring);
  1264.     
  1265.     if (oserr != DBNOERR)
  1266.         fprintf(stderr,"Operating-system error:\n\t%s\n", oserrstr);
  1267.     
  1268.     return(INT_CANCEL);
  1269.     }
  1270. }
  1271.  
  1272. /*ARGSUSED*/
  1273.  
  1274. static int msg_handler(db, msgno, msgstate, severity, msgtext, srvname, procname, line)
  1275.     DBPROCESS *db;
  1276.     DBINT msgno;
  1277.     int msgstate;
  1278.     int severity;
  1279.     char *msgtext;
  1280.     char *srvname;
  1281.     char *procname;
  1282.     DBUSMALLINT line;
  1283. {
  1284. #ifdef HAS_CALLBACK
  1285.     /* If we have message handler subroutine, use it. */
  1286.     if (msg_handler_sub)
  1287.     {
  1288.     int sp = perl_sp;
  1289.     int j;
  1290.  
  1291.     for(j = 0; j < MAX_DBPROCS; ++j)
  1292.         if(db == dbProc[j].dbproc)
  1293.         break;
  1294.     if(j == MAX_DBPROCS)
  1295.         j = 0;
  1296.     
  1297.     /* Reserve spot for return value. */
  1298.     astore (stack, ++ sp, Nullstr);
  1299.     
  1300.     /* Set up arguments. */
  1301.     astore (stack, ++ sp,
  1302.         str_2mortal (str_nmake ((double) j)));
  1303.     astore (stack, ++ sp, str_2mortal (str_nmake ((double) msgno)));
  1304.     astore (stack, ++ sp, str_2mortal (str_nmake ((double) msgstate)));
  1305.     astore (stack, ++ sp, str_2mortal (str_nmake ((double) severity)));
  1306.     if (msgtext && *msgtext)
  1307.         astore (stack, ++ sp, str_2mortal (str_make (msgtext, 0)));
  1308.     else
  1309.         astore (stack, ++ sp, &str_undef);
  1310.     if (srvname && *srvname)
  1311.         astore (stack, ++ sp, str_2mortal (str_make (srvname, 0)));
  1312.     else
  1313.         astore (stack, ++ sp, &str_undef);
  1314.     if (procname && *procname)
  1315.         astore (stack, ++ sp, str_2mortal (str_make (procname, 0)));
  1316.     else
  1317.         astore (stack, ++ sp, &str_undef);
  1318.     astore (stack, ++ sp, str_2mortal (str_nmake ((double) line)));
  1319.     
  1320.     /* Call it. */
  1321.     sp = callback (msg_handler_sub, sp, 0, 1, 8);
  1322.     
  1323.     /* Return whatever it returned. */
  1324.     return (int) str_gnum (STACK (sp)[0]);
  1325.     }
  1326. #endif                /* HAS_CALLBACK */
  1327. #ifdef OLD_SYBPERL
  1328.     if(!severity)
  1329.     return 0;
  1330. #endif
  1331.     fprintf (stderr,"Msg %ld, Level %d, State %d\n", 
  1332.          msgno, severity, msgstate);
  1333.     if (strlen(srvname) > 0)
  1334.     fprintf (stderr,"Server '%s', ", srvname);
  1335.     if (strlen(procname) > 0)
  1336.     fprintf (stderr,"Procedure '%s', ", procname);
  1337.     if (line > 0)
  1338.     fprintf (stderr,"Line %d", line);
  1339.     
  1340.     fprintf(stderr,"\n\t%s\n", msgtext);
  1341.     
  1342.     return(0);
  1343. }
  1344.  
  1345. /* 
  1346.  * Get the index into the dbproc[] array from a Perl STR datatype. 
  1347.  * Check that the index is reasonably valid...
  1348.  */
  1349. static int
  1350. getDbProc(Str)
  1351.     STR *Str;
  1352. {
  1353.     int ix;
  1354.  
  1355.     if (Str == &str_undef || !Str->str_nok) /* This may be getting a bit too */
  1356.                         /* close with the internals of */
  1357.                         /* the 'str' workings... */
  1358.     warn("The $dbproc parameter has not been properly initialized - it defaults to 0");
  1359.  
  1360.     ix = (int)str_gnum(Str);
  1361.  
  1362.     if(ix < 0 || ix >= MAX_DBPROCS)
  1363.     fatal("$dbproc parameter is out of range");
  1364.     if(dbProc[ix].dbproc == NULL || DBDEAD(dbProc[ix].dbproc))
  1365.     fatal("$dbproc parameter is NULL or the connection to the server has been closed");
  1366.     return ix;
  1367. }
  1368.  
  1369.  
  1370. #ifdef HAS_CALLBACK
  1371.  
  1372. /* Taken from Perl 4.018 usub/usersub.c. mp. */
  1373.  
  1374. /* Be sure to refetch the stack pointer after calling these routines. */
  1375.  
  1376. int
  1377. callback(subname, sp, gimme, hasargs, numargs)
  1378. char *subname;
  1379. int sp;            /* stack pointer after args are pushed */
  1380. int gimme;        /* called in array or scalar context */
  1381. int hasargs;        /* whether to create a @_ array for routine */
  1382. int numargs;        /* how many args are pushed on the stack */
  1383. {
  1384.     static ARG myarg[3];    /* fake syntax tree node */
  1385.     int arglast[3];
  1386.     
  1387.     arglast[2] = sp;
  1388.     sp -= numargs;
  1389.     arglast[1] = sp--;
  1390.     arglast[0] = sp;
  1391.  
  1392.     if (!myarg[0].arg_ptr.arg_str)
  1393.     myarg[0].arg_ptr.arg_str = str_make("",0);
  1394.  
  1395.     myarg[1].arg_type = A_WORD;
  1396.     myarg[1].arg_ptr.arg_stab = stabent(subname, FALSE);
  1397.  
  1398.     myarg[2].arg_type = hasargs ? A_EXPR : A_NULL;
  1399.  
  1400.     return do_subr(myarg, gimme, arglast);
  1401. }
  1402.  
  1403. #endif                /* HAS_CALLBACK */
  1404.  
  1405.  
  1406. #if defined(DBLIB461)
  1407.  
  1408. /* The following routines originate from the OpenClient R4.6.1 reference  */
  1409. /* manual, pages 2-165 to 2-168 both inclusive.  It has been subsequently */
  1410. /* modified (slightly) to suit local conditions.                          */
  1411.  
  1412. #define PRECISION 4
  1413.  
  1414. static void new_mny4tochar(dbproc, mny4ptr, buf_ptr)
  1415. DBPROCESS *dbproc;
  1416. DBMONEY4  *mny4ptr;
  1417. DBCHAR    *buf_ptr;
  1418. {
  1419.    DBMONEY local_mny;
  1420.    DBCHAR  value;
  1421.    char    temp_buf[40];
  1422.  
  1423.    int     bytes_written = 0;
  1424.    int     i             = 0;
  1425.    DBBOOL  negative      = (DBBOOL)FALSE;
  1426.    DBBOOL  zero          = (DBBOOL)FALSE;
  1427.  
  1428.    if (dbconvert(dbproc, SYBMONEY4, (BYTE*)mny4ptr, (DBINT)-1,
  1429.                  SYBMONEY, (BYTE*)&local_mny, (DBINT)-1) == -1)
  1430.    {
  1431.       fatal("dbconvert() failed in routine new_mny4tochar()");
  1432.    }
  1433.  
  1434.    if (dbmnyinit(dbproc, &local_mny, 4 - PRECISION, &negative) == FAIL)
  1435.    {
  1436.       fatal("dbmnyinit() failed in routine new_mny4tochar()");
  1437.    }
  1438.  
  1439.    while (zero == FALSE)
  1440.    {
  1441.       if (dbmnyndigit(dbproc, &local_mny, &value, &zero) == FAIL)
  1442.       {
  1443.          fatal("dbmnyndigit() failed in routine new_mny4tochar()");
  1444.       }
  1445.  
  1446.       temp_buf[bytes_written++] = value;
  1447.  
  1448.       if (zero == FALSE)
  1449.       {
  1450.          if (bytes_written == PRECISION)
  1451.          {
  1452.             temp_buf[bytes_written++] = '.';
  1453.          }
  1454.       }
  1455.    }
  1456.  
  1457.    while (bytes_written < PRECISION)
  1458.    {
  1459.       temp_buf[bytes_written++] = '0';
  1460.    }
  1461.  
  1462.    if (bytes_written == PRECISION)
  1463.    {
  1464.       temp_buf[bytes_written++] = '.';
  1465.       temp_buf[bytes_written++] = '0';
  1466.    }
  1467.  
  1468.    if (negative == TRUE)
  1469.    {
  1470.       buf_ptr[i++] = '-';
  1471.    }
  1472.  
  1473.    while (bytes_written--)
  1474.    {
  1475.       buf_ptr[i++] = temp_buf[bytes_written];
  1476.    }
  1477.  
  1478.    buf_ptr[i] = '\0';
  1479.  
  1480.    return;
  1481. }
  1482.  
  1483. static void new_mnytochar(dbproc, mnyptr, buf_ptr)
  1484. DBPROCESS *dbproc;
  1485. DBMONEY   *mnyptr;
  1486. DBCHAR    *buf_ptr;
  1487. {
  1488.    DBMONEY local_mny;
  1489.    DBCHAR  value;
  1490.    char    temp_buf[40];
  1491.  
  1492.    int     bytes_written = 0;
  1493.    int     i             = 0;
  1494.    DBBOOL  negative      = (DBBOOL)FALSE;
  1495.    DBBOOL  zero          = (DBBOOL)FALSE;
  1496.  
  1497.    if (dbmnycopy(dbproc, mnyptr, &local_mny) == FAIL)
  1498.    {
  1499.       fatal("dbmnycopy() failed in routine new_mnytochar()");
  1500.    }
  1501.  
  1502.    if (dbmnyinit(dbproc, &local_mny, 4 - PRECISION, &negative) == FAIL)
  1503.    {
  1504.       fatal("dbmnyinit() failed in routine new_mnytochar()");
  1505.    }
  1506.  
  1507.    while (zero == FALSE)
  1508.    {
  1509.       if (dbmnyndigit(dbproc, &local_mny, &value, &zero) == FAIL)
  1510.       {
  1511.          fatal("dbmnyndigit() failed in routine new_mnytochar()");
  1512.       }
  1513.  
  1514.       temp_buf[bytes_written++] = value;
  1515.  
  1516.       if (zero == FALSE)
  1517.       {
  1518.          if (bytes_written == PRECISION)
  1519.          {
  1520.             temp_buf[bytes_written++] = '.';
  1521.          }
  1522.       }
  1523.    }
  1524.  
  1525.    while (bytes_written < PRECISION)
  1526.    {
  1527.       temp_buf[bytes_written++] = '0';
  1528.    }
  1529.  
  1530.    if (bytes_written == PRECISION)
  1531.    {
  1532.       temp_buf[bytes_written++] = '.';
  1533.       temp_buf[bytes_written++] = '0';
  1534.    }
  1535.  
  1536.    if (negative == TRUE)
  1537.    {
  1538.       buf_ptr[i++] = '-';
  1539.    }
  1540.  
  1541.    while (bytes_written--)
  1542.    {
  1543.       buf_ptr[i++] = temp_buf[bytes_written];
  1544.    }
  1545.  
  1546.    buf_ptr[i] = '\0';
  1547.  
  1548.    return;
  1549. }
  1550.  
  1551. #endif  /* DBLIB461 */
  1552.  
  1553.