home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1994 March / Source_Code_CD-ROM_Walnut_Creek_March_1994.iso / compsrcs / misc / volume40 / sybperl / patch09 < prev    next >
Encoding:
Text File  |  1993-10-29  |  20.5 KB  |  752 lines
  1. Newsgroups: comp.sources.misc
  2. From: mpeppler@itf.ch (Michael Peppler)
  3. Subject: v40i005:  sybperl - Sybase DB-library extensions to Perl, v1.9, Patch09
  4. Message-ID: <1993Oct11.031306.22317@sparky.sterling.com>
  5. X-Md4-Signature: a010aba437da4a034a2a812dea5f32c4
  6. Sender: kent@sparky.sterling.com (Kent Landfield)
  7. Organization: Sterling Software
  8. Date: Mon, 11 Oct 1993 03:13:06 GMT
  9. Approved: kent@sparky.sterling.com
  10.  
  11. Submitted-by: mpeppler@itf.ch (Michael Peppler)
  12. Posting-number: Volume 40, Issue 5
  13. Archive-name: sybperl/patch09
  14. Environment: UNIX, Perl, Sybase
  15. Patch-To: sybperl: Volume 39, Issues 101-103
  16.  
  17. This is patch 9 to Sybperl.
  18.  
  19. [ NOTE: Sybperl was initially posted at patchlevel 8.  In order to ]
  20. [       get the version number to match the patchlevel, this patch ]
  21. [       is being posted as patch09.  There have been *no* previous ]
  22. [       patches since the initial posting in volume39.   -Kent+    ]
  23.  
  24. Sybperl is an extension to Perl which allows you to access Sybase
  25. databases directly from Perl scripts using standard OpenClient (aka
  26. DB-Library) calls.
  27.  
  28. >From the CHANGES file:
  29.  
  30.     1.009   The script name is now used to set the application
  31.         name in sysprocesses via the DBSETLAPP() macro.
  32.         Calling &dbsafestr() with three arguments would result
  33.         in an erroneous fatal error message.
  34.         Sybperl now sets the application name in sysprocesses
  35.         (via DBSETLAPP()) to the name of the script that is
  36.         running.
  37.         Some problems with dbschema.pl which only showed up
  38.         when PACKAGE_BUG is defined have been corrected.
  39.  
  40. --
  41. Michael Peppler                           mpeppler@itf.ch
  42. ITF Management SA                      mpeppler@bix.com     
  43. 13 Rue de la Fontaine                  Phone: (+4122) 312 1311
  44. CH-1204 Geneva, Switzerland            Fax:   (+4122) 312 1325
  45.  
  46.  
  47. Index: patchlevel.h
  48. Prereq: 1.2
  49. *** ../sybperl-1.8/patchlevel.h    Thu Sep 30 16:28:24 1993
  50. --- patchlevel.h    Tue Sep 28 19:16:26 1993
  51. ***************
  52. *** 1,7 ****
  53.   
  54. ! /*     @(#)patchlevel.h    1.2    9/6/93     */
  55.   
  56.   #define VERSION 1
  57. ! #define PATCHLEVEL 8
  58. ! 
  59.   
  60. --- 1,6 ----
  61.   
  62. ! /*     @(#)patchlevel.h    1.3    9/28/93     */
  63.   
  64.   #define VERSION 1
  65. ! #define PATCHLEVEL 9
  66.   
  67. Index: BUGS
  68. Prereq: 1.1
  69. *** ../sybperl-1.8/BUGS    Thu Sep 30 16:28:29 1993
  70. --- BUGS    Mon Oct  4 15:14:17 1993
  71. ***************
  72. *** 1,4 ****
  73. !     @(#)BUGS    1.1    9/2/93
  74.       
  75.       The Sybase DB-Library - Perl savestr() conflict
  76.       ------------------------------------------------
  77. --- 1,4 ----
  78. !     @(#)BUGS    1.3    10/4/93
  79.       
  80.       The Sybase DB-Library - Perl savestr() conflict
  81.       ------------------------------------------------
  82. ***************
  83. *** 11,28 ****
  84.       list of commands pointed to by dpproc->dbcmdbuf, and in dbuse() as
  85.       well. Now there are several ways to work around this problem.
  86.   
  87. !     1) Compile sybperl.c with -DBROKEN_DBCMD. I've written some code
  88. !        that emulates calls to dbcmd() and dbuse(). This works OK on my
  89. !        machine/OS/Version of Perl/Version of DBlib, but it relies on
  90. !        the internal storing method used by DBlib, and that might
  91. !        change in the future.
  92. ! 
  93. !     2) Recompile Perl (specifically, uperl.o in the Perl source
  94.          directory) with some suitable flags (eg -Dsavestr=p_savestr).
  95.          This does not create any compatibility problems, but is a
  96.          lengthy procedure.
  97.   
  98. !     3) Do something like:
  99.          cc -c sybperl.c
  100.          ld -r -o sybperl2.o sybperl.o -lsybdb
  101.          [edit sybperl2.o and replace `_savestr' with something like `_savest1']
  102. --- 11,22 ----
  103.       list of commands pointed to by dpproc->dbcmdbuf, and in dbuse() as
  104.       well. Now there are several ways to work around this problem.
  105.   
  106. !     1) Recompile Perl (specifically, uperl.o in the Perl source
  107.          directory) with some suitable flags (eg -Dsavestr=p_savestr).
  108.          This does not create any compatibility problems, but is a
  109.          lengthy procedure.
  110.   
  111. !     2) Do something like:
  112.          cc -c sybperl.c
  113.          ld -r -o sybperl2.o sybperl.o -lsybdb
  114.          [edit sybperl2.o and replace `_savestr' with something like `_savest1']
  115. ***************
  116. *** 30,36 ****
  117.          This is not a bad solution, but won't work if you have shared
  118.          library versions of libsybdb.a
  119.   
  120. !     4) Edit uperl.o and replace savestr with something else. This is
  121.          the solution I've chosen as the default. It is relatively fast,
  122.          does not rely on any internal knowledge of DB-Library, and does
  123.          not require Perl to be recompiled.
  124. --- 24,30 ----
  125.          This is not a bad solution, but won't work if you have shared
  126.          library versions of libsybdb.a
  127.   
  128. !     3) Edit uperl.o and replace savestr with something else. This is
  129.          the solution I've chosen as the default. It is relatively fast,
  130.          does not rely on any internal knowledge of DB-Library, and does
  131.          not require Perl to be recompiled.
  132. ***************
  133. *** 146,152 ****
  134. --- 140,154 ----
  135.   
  136.       It's not the cleanest of solutions, but it works...
  137.   
  138. +     However, be aware of the Perl @_ array assignement problems if you
  139. +     call sybperl functions without a parameter list (as in &dbsqlexec;
  140. +     instead of &dbsqlexec($dbproc);). When calling Sybperl functions
  141. +     via the glue routines, the @_ array will default to the parameters
  142. +     passed to last previously called Perl subroutine if it's called
  143. +     without a parameter list. And that's almost certainly not what you
  144. +     want.
  145.   
  146. +     
  147.   
  148.       
  149.       Please let me know if you find any other problems with Sybperl so
  150. ***************
  151. *** 155,159 ****
  152.       Thank you.
  153.   
  154.       Michael Peppler    <mpeppler@itf.ch>
  155. - 
  156.   
  157. --- 157,160 ----
  158. Index: CHANGES
  159. Prereq: 1.4
  160. *** ../sybperl-1.8/CHANGES    Thu Sep 30 16:28:29 1993
  161. --- CHANGES    Mon Oct  4 15:20:04 1993
  162. ***************
  163. *** 1,8 ****
  164. !     @(#)CHANGES    1.4    9/7/93
  165.   
  166.       
  167.       Sybperl CHANGES:
  168.   
  169.       1.008   Added user settable variables to control whether
  170.           Sybperl returns 'NULL' or Perl's 'undef' value on NULL
  171.           values from a query, whether numeric results are kept
  172. --- 1,17 ----
  173. !     @(#)CHANGES    1.7    10/4/93
  174.   
  175.       
  176.       Sybperl CHANGES:
  177.   
  178. +     1.009   The script name is now used to set the application
  179. +         name in sysprocesses via the DBSETLAPP() macro.
  180. +         Calling &dbsafestr() with three arguments would result
  181. +         in an erroneous fatal error message.
  182. +         Sybperl now sets the application name in sysprocesses
  183. +         (via DBSETLAPP()) to the name of the script that is
  184. +         running.
  185. +         Some problems with dbschema.pl which only showed up
  186. +         when PACKAGE_BUG is defined have been corrected.
  187.       1.008   Added user settable variables to control whether
  188.           Sybperl returns 'NULL' or Perl's 'undef' value on NULL
  189.           values from a query, whether numeric results are kept
  190. ***************
  191. *** 67,70 ****
  192.           Added a couple of example scripts in eg/*.pl, courtesy
  193.           of Gijs Mos (Thank You!).
  194.       1.003    Base version.
  195. - 
  196. --- 76,78 ----
  197. Index: Makefile
  198. Prereq: 1.16
  199. *** ../sybperl-1.8/Makefile    Thu Sep 30 16:28:24 1993
  200. --- Makefile    Tue Oct  5 16:27:15 1993
  201. ***************
  202. *** 1,4 ****
  203. ! #    @(#)Makefile    1.16    9/6/93
  204.   #
  205.       
  206.   CC = gcc
  207. --- 1,4 ----
  208. ! #    @(#)Makefile    1.18    10/5/93
  209.   #
  210.       
  211.   CC = gcc
  212. ***************
  213. *** 30,68 ****
  214.   # The default is to use the third solution:
  215.   UPERL = uperl2.o
  216.   
  217.   
  218. ! HAS_CALLBACK= -DHAS_CALLBACK        # Remove this if you don't
  219. !                     # have Perl 4 patchlevel 18
  220. !                     # User defined, perl based
  221. !                     # error/message handlers are
  222. !                     # not possible without this, however.
  223. ! OLD_SYBPERL= -DOLD_SYBPERL        # some backward compatibility stuff.
  224.   
  225. ! DBLIBVS = -DDBLIB461            # Comment this if your version
  226. !                     # of DBlib is older than
  227. !                     # version 4.2
  228.   
  229. ! #SET_VAL = -DUSERVAL_SET_FATAL        # Uncomment this if you wish
  230. !                     # to get a fatal error message
  231. !                     # if you attempt to set on of
  232. !                     # Sybperl's variables from a
  233. !                     # script. Normally such
  234. !                     # actions are silently ignored.
  235.   
  236. ! #PACKAGE_BUG = -DPACKAGE_BUG        # Uncomment to enable code
  237. !                     # to circumvent a bug that
  238. !                     # shows up when calling usubs from
  239. !                     # within nested packages.
  240. !                     
  241.   
  242.   CFLAGS = -O2 -g
  243.   CPPFLAGS = -I$(PERLSRC) -I$(LOCINCS) -I$(SYBINCS) $(PERL_VERSION) \
  244.           $(HAS_CALLBACK) $(OLD_SYBPERL) $(DBLIBVS) \
  245. !         $(SET_VAL) $(PACKAGE_BUG)
  246.   
  247.   BINDIR = /usr/local/bin            # where does the executable go
  248. ! PERLLIB = /usr/local/lib/perl        # where does lib/sybperl.pl
  249. !                     # and lib/sybdb.ph go
  250.   MANDIR = /usr/local/man            # where do we put the manual page
  251.   MANEXT = l
  252.   
  253. --- 30,70 ----
  254.   # The default is to use the third solution:
  255.   UPERL = uperl2.o
  256.   
  257. + # HAS_CALLBACK: This should be defined if you have Perl 4 patchlevel
  258. + # 18 or later. User defined error/message handlers in Perl are not
  259. + # possible if this is not defined, however.
  260. + HAS_CALLBACK= -DHAS_CALLBACK
  261.   
  262. ! # OLD_SYBPERL: A number of backwards compatibility stuff. Mainly, when
  263. ! # this is turned on, automatic logging in to Sybase is enabled.
  264. ! # Otherwise, failing to call &dblogin is a fatal error.
  265. ! OLD_SYBPERL= -DOLD_SYBPERL
  266.   
  267. ! # DBLIBVS: The DBlib version that you have. Valid values are DBLIB42
  268. ! # and DBLIB461. Controls the inclusion of routines which are available
  269. ! # only in more recent versions of DB library.
  270. ! DBLIBVS = -DDBLIB461
  271.   
  272. ! # SET_VAL: If this is set, then assigning a value to Sybperl's
  273. ! # read-only variables is a fatal error. Normally, this would be
  274. ! # silently ignored.
  275. ! #SET_VAL = -DUSERVAL_SET_FATAL
  276.   
  277. ! # PACKAGE_BUG: Controls whether code to circumvent a bug in Perl that
  278. ! # shows up when calling usubs from within nested packages is included.
  279. ! # See also the BUGS file.
  280. ! #PACKAGE_BUG = -DPACKAGE_BUG
  281.   
  282. + # RINDEX: Does your system know rindex(), but not strrchr() ?
  283. + #RINDEX = -Dstrrchr=rindex
  284. + 
  285.   CFLAGS = -O2 -g
  286.   CPPFLAGS = -I$(PERLSRC) -I$(LOCINCS) -I$(SYBINCS) $(PERL_VERSION) \
  287.           $(HAS_CALLBACK) $(OLD_SYBPERL) $(DBLIBVS) \
  288. !         $(SET_VAL) $(PACKAGE_BUG) $(RINDEX)
  289.   
  290.   BINDIR = /usr/local/bin            # where does the executable go
  291. ! PERLLIB = /usr/local/lib/perl        # where does lib/*.pl go
  292.   MANDIR = /usr/local/man            # where do we put the manual page
  293.   MANEXT = l
  294.   
  295. ***************
  296. *** 105,111 ****
  297.       lib/sybdb_redefs.pl t/sbex.pl \
  298.       eg/sql.pl eg/space.pl eg/capture.pl eg/report.pl \
  299.       eg/dbschema.pl eg/dbtext.pl eg/test_dbmoney.pl eg/README
  300. - 
  301.   
  302.   
  303.   
  304. --- 107,112 ----
  305. Index: PACKING.LST
  306. Prereq: 1.1
  307. *** ../sybperl-1.8/PACKING.LST    Thu Sep 30 16:28:29 1993
  308. --- PACKING.LST    Thu Sep  2 18:09:42 1993
  309. ***************
  310. *** 33,36 ****
  311.                   views, triggers and stored procedures),
  312.                   extracting the information from the
  313.                   database's system tables.
  314. - 
  315. --- 33,35 ----
  316. Index: README
  317. Prereq: 1.4
  318. *** ../sybperl-1.8/README    Thu Sep 30 16:28:23 1993
  319. --- README    Thu Sep 23 19:53:15 1993
  320. ***************
  321. *** 114,117 ****
  322.      Anders Ardo            Gijs Mos
  323.      Minh Ton Ha            G. Roderick Singleton
  324.      Peter Gutmann
  325. - 
  326. --- 114,116 ----
  327. Index: eg/README
  328. Prereq: 1.5
  329. *** ../sybperl-1.8/eg/README    Thu Sep 30 16:28:29 1993
  330. --- eg/README    Tue Aug 31 17:31:34 1993
  331. ***************
  332. *** 48,51 ****
  333.   
  334.   
  335.       Michael Peppler        mpeppler@itf.ch
  336. - 
  337. --- 48,50 ----
  338. Index: eg/capture.pl
  339. Prereq: 1.1
  340. *** ../sybperl-1.8/eg/capture.pl    Thu Sep 30 16:28:30 1993
  341. --- eg/capture.pl    Wed Jun 24 12:11:39 1992
  342. ***************
  343. *** 91,94 ****
  344.       );
  345.   };
  346.   endgrent;
  347. - 
  348. --- 91,93 ----
  349. Index: eg/dbschema.pl
  350. Prereq: 1.5
  351. *** ../sybperl-1.8/eg/dbschema.pl    Thu Sep 30 16:28:26 1993
  352. --- eg/dbschema.pl    Mon Oct  4 14:40:15 1993
  353. ***************
  354. *** 1,6 ****
  355.   #! /usr/local/bin/sybperl
  356.   #
  357. ! #    @(#)dbschema.pl    1.5    9/10/93
  358.   #
  359.   #
  360.   #    dbschema.pl    A script to extract a database structure from
  361. --- 1,6 ----
  362.   #! /usr/local/bin/sybperl
  363.   #
  364. ! #    @(#)dbschema.pl    1.7    10/4/93
  365.   #
  366.   #
  367.   #    dbschema.pl    A script to extract a database structure from
  368. ***************
  369. *** 219,225 ****
  370.       print "Bind rules & defaults to columns...\n" if $opt_v;
  371.       print SCRIPT "/* Bind rules & defaults to columns... */\n\n";
  372.   
  373. !     if($tab[1] ne 'dbo' && (keys(%dflt) || keys(%rules)))
  374.       {
  375.       print SCRIPT "/* The owner of the table is $tab[1].
  376.   ** I can't bind the rules/defaults to a table of which I am not the owner.
  377. --- 219,225 ----
  378.       print "Bind rules & defaults to columns...\n" if $opt_v;
  379.       print SCRIPT "/* Bind rules & defaults to columns... */\n\n";
  380.   
  381. !     if($tab[1] ne 'dbo' && (keys(%dflt) || keys(%rule)))
  382.       {
  383.       print SCRIPT "/* The owner of the table is $tab[1].
  384.   ** I can't bind the rules/defaults to a table of which I am not the owner.
  385. ***************
  386. *** 310,321 ****
  387.       local($ret, @dat, $act, $cnt);
  388.   
  389.       &dbcmd($dbproc, "sp_helprotect '$obj'\n");
  390. !     &dbsqlexec;
  391.   
  392.       $cnt = 0;
  393. !     while(($ret = &dbresults) != $NO_MORE_RESULTS && $ret != $FAIL)
  394.       {
  395. !     while(@dat = &dbnextrow)
  396.       {
  397.           $act = 'to';
  398.           $act = 'from' if $dat[0] =~ /Revoke/;
  399. --- 310,321 ----
  400.       local($ret, @dat, $act, $cnt);
  401.   
  402.       &dbcmd($dbproc, "sp_helprotect '$obj'\n");
  403. !     &dbsqlexec($dbproc);
  404.   
  405.       $cnt = 0;
  406. !     while(($ret = &dbresults($dbproc)) != $NO_MORE_RESULTS && $ret != $FAIL)
  407.       {
  408. !     while(@dat = &dbnextrow($dbproc))
  409.       {
  410.           $act = 'to';
  411.           $act = 'from' if $dat[0] =~ /Revoke/;
  412. ***************
  413. *** 351,363 ****
  414.       $found = 0;
  415.   
  416.       &dbcmd($dbproc, "select text from syscomments where id = $vi[2]");
  417. !     &dbsqlexec;
  418. !     &dbresults;
  419.       
  420.       print SCRIPT
  421.           "/* $objname $vi[0], owner $vi[1] */\n";
  422.   
  423. !     while(($text) = &dbnextrow)
  424.       {
  425.           if(!$found && $vi[1] ne 'dbo')
  426.           {
  427. --- 351,363 ----
  428.       $found = 0;
  429.   
  430.       &dbcmd($dbproc, "select text from syscomments where id = $vi[2]");
  431. !     &dbsqlexec($dbproc);
  432. !     &dbresults($dbproc);
  433.       
  434.       print SCRIPT
  435.           "/* $objname $vi[0], owner $vi[1] */\n";
  436.   
  437. !     while(($text) = &dbnextrow($dbproc))
  438.       {
  439.           if(!$found && $vi[1] ne 'dbo')
  440.           {
  441. ***************
  442. *** 373,377 ****
  443.       }
  444.       }
  445.   }
  446. - 
  447.   
  448. --- 373,376 ----
  449. Index: eg/dbtext.pl
  450. Prereq: 1.1
  451. *** ../sybperl-1.8/eg/dbtext.pl    Thu Sep 30 16:28:30 1993
  452. --- eg/dbtext.pl    Tue Aug 31 17:31:09 1993
  453. ***************
  454. *** 29,32 ****
  455.   print @result, "\n";
  456.   
  457.   &dbclose($d);
  458. - 
  459. --- 29,31 ----
  460. Index: eg/report.pl
  461. Prereq: 1.1
  462. *** ../sybperl-1.8/eg/report.pl    Thu Sep 30 16:28:26 1993
  463. --- eg/report.pl    Wed Jun 24 12:12:06 1992
  464. ***************
  465. *** 38,41 ****
  466.       ($n,$u,$gn,$s,$d) = split("~",$x);
  467.       write;
  468.   }
  469. - 
  470. --- 38,40 ----
  471. Index: eg/space.pl
  472. Prereq: 1.2
  473. *** ../sybperl-1.8/eg/space.pl    Thu Sep 30 16:28:30 1993
  474. --- eg/space.pl    Fri Apr  2 15:47:05 1993
  475. ***************
  476. *** 70,73 ****
  477.   $name,      $size,     $res,       $data,     $index,    $free,     $unused
  478.   . 
  479.   
  480. - 
  481. --- 70,72 ----
  482. Index: eg/sql.pl
  483. Prereq: 1.2
  484. *** ../sybperl-1.8/eg/sql.pl    Thu Sep 30 16:28:31 1993
  485. --- eg/sql.pl    Mon Aug  9 22:02:25 1993
  486. ***************
  487. *** 75,78 ****
  488.   
  489.   
  490.   1;
  491. - 
  492. --- 75,77 ----
  493. Index: eg/test_dbmoney.pl
  494. Prereq: 1.1
  495. *** ../sybperl-1.8/eg/test_dbmoney.pl    Thu Sep 30 16:28:31 1993
  496. --- eg/test_dbmoney.pl    Tue Aug 31 13:01:04 1993
  497. ***************
  498. *** 173,176 ****
  499.   &dbexit;
  500.   
  501.   exit( $STDEXIT );
  502. - 
  503. --- 173,175 ----
  504. Index: lib/sybdb.ph
  505. Prereq: 1.2
  506. *** ../sybperl-1.8/lib/sybdb.ph    Thu Sep 30 16:28:31 1993
  507. --- lib/sybdb.ph    Mon Aug 30 16:23:34 1993
  508. ***************
  509. *** 254,257 ****
  510.   sub INT_CANCEL {2;}
  511.   
  512.   1;
  513. - 
  514. --- 254,256 ----
  515. Index: lib/sybdb_redefs.pl
  516. Prereq: 1.2
  517. *** ../sybperl-1.8/lib/sybdb_redefs.pl    Thu Sep 30 16:28:32 1993
  518. --- lib/sybdb_redefs.pl    Tue Aug 31 12:07:20 1993
  519. ***************
  520. *** 613,616 ****
  521.   # ----- end of sybdb_redefs.pl -----
  522.   
  523.   1;
  524. - 
  525. --- 613,615 ----
  526. Index: lib/sybperl.pl
  527. Prereq: 1.5
  528. *** ../sybperl-1.8/lib/sybperl.pl    Thu Sep 30 16:28:32 1993
  529. --- lib/sybperl.pl    Thu Sep 23 18:18:41 1993
  530. ***************
  531. *** 73,76 ****
  532.   
  533.   
  534.   1;
  535. - 
  536. --- 73,75 ----
  537. Index: sybperl.1
  538. Prereq: 1
  539. *** ../sybperl-1.8/sybperl.1    Thu Sep 30 16:28:27 1993
  540. --- sybperl.1    Tue Sep  7 15:05:34 1993
  541. ***************
  542. *** 290,293 ****
  543.   Don Preuss (donp@niaid.nih.gov) contributed the &dbcolXXX() calls.
  544.   Jeffrey Wong (jtw@comdyn.cdsyd.oz.au) contributed the
  545.   OpenClient R4.6.1 DBMONEY routines
  546. - 
  547. --- 290,292 ----
  548. Index: sybperl.c
  549. Prereq: 1.25
  550. *** ../sybperl-1.8/sybperl.c    Thu Sep 30 16:28:27 1993
  551. --- sybperl.c    Mon Oct  4 15:22:44 1993
  552. ***************
  553. *** 1,4 ****
  554. ! static char SccsId[] = "@(#)sybperl.c    1.25    9/13/93";
  555.   /************************************************************************/
  556.   /*    Copyright 1991, 1992, 1993 by Michael Peppler            */
  557.   /*                               and ITF Management SA             */
  558. --- 1,4 ----
  559. ! static char SccsId[] = "@(#)sybperl.c    1.28    10/4/93";
  560.   /************************************************************************/
  561.   /*    Copyright 1991, 1992, 1993 by Michael Peppler            */
  562.   /*                               and ITF Management SA             */
  563. ***************
  564. *** 247,256 ****
  565. --- 247,268 ----
  566.   static int userval();
  567.   static int err_handler(), msg_handler();
  568.   static int getDbProc();
  569. + static char scriptName[32];
  570.   
  571.   int
  572.   userinit()
  573.   {
  574. +     char *p;
  575. +     int len;
  576. + 
  577. +     if(!(p = strrchr(origfilename, '/')))
  578. +     p = origfilename;
  579. +     else
  580. +     ++p;
  581. +     if((len = strlen(p)) > 30)
  582. +     len = 30;
  583. +     strncpy(scriptName, p, len);
  584. +     
  585.       init_sybase();
  586.   }
  587.   
  588. ***************
  589. *** 484,491 ****
  590.   register int sp;
  591.   register int items;
  592.   {
  593.       STR **st = stack->ary_array + sp;
  594. !     ARRAY *ary = stack;    
  595.       STR *Str;        /* used in str_get and str_gnum macros */
  596.       int inx = -1;    /* Index into dbProc[] array. Passed as */
  597.                   /* first parameter to nearly all &dbxxx() calls */
  598. --- 496,505 ----
  599.   register int sp;
  600.   register int items;
  601.   {
  602. + #if 0
  603.       STR **st = stack->ary_array + sp;
  604. ! #endif
  605. !     ARRAY *ary = stack;
  606.       STR *Str;        /* used in str_get and str_gnum macros */
  607.       int inx = -1;    /* Index into dbProc[] array. Passed as */
  608.                   /* first parameter to nearly all &dbxxx() calls */
  609. ***************
  610. *** 509,514 ****
  611. --- 523,529 ----
  612.       {        /* You can call &dbmsghandle/errhandle before calling &dblogin */
  613.   #ifdef OLD_SYBPERL
  614.       login = dblogin();
  615. +     DBSETLAPP(login, scriptName);
  616.       dbProc[0].dbproc = dbopen(login, NULL);
  617.   #else
  618.       fatal("&dblogin has not been called yet!");
  619. ***************
  620. *** 526,532 ****
  621. --- 541,550 ----
  622.           char *server = NULL, *user = NULL, *pwd = NULL;
  623.   
  624.           if (!login)
  625. +         {
  626.           login = dblogin();
  627. +         DBSETLAPP(login, scriptName);
  628. +         }
  629.           switch(items)
  630.           {
  631.             case 3:
  632. ***************
  633. *** 1377,1383 ****
  634.       break;
  635.   #if defined(DBLIB42)
  636.         case US_dbsafestr:
  637. !     if (items > 3 || items != 2)
  638.           fatal ("Usage: $string = &dbsafestr($dbproc,$instring[,$quote_char])");
  639.       else
  640.       {
  641. --- 1395,1401 ----
  642.       break;
  643.   #if defined(DBLIB42)
  644.         case US_dbsafestr:
  645. !     if (!(items == 3 || items == 2))
  646.           fatal ("Usage: $string = &dbsafestr($dbproc,$instring[,$quote_char])");
  647.       else
  648.       {
  649. ***************
  650. *** 1414,1420 ****
  651.       break;
  652.   #elif defined(DBLIB461)
  653.         case US_dbsafestr:
  654. !     if (items > 3 || items != 2)
  655.           fatal ("Usage: $string = &dbsafestr($dbproc,$instring[,$quote_char])");
  656.       else
  657.       {
  658. --- 1432,1438 ----
  659.       break;
  660.   #elif defined(DBLIB461)
  661.         case US_dbsafestr:
  662. !     if (!(items == 3 || items == 2))
  663.           fatal ("Usage: $string = &dbsafestr($dbproc,$instring[,$quote_char])");
  664.       else
  665.       {
  666. ***************
  667. *** 2401,2406 ****
  668. --- 2419,2434 ----
  669.           (void)astore(ary,++sp,str_2mortal(str_make(mnybuf, 0)));
  670.       }
  671.       break;
  672. +       case US_dbrecftos:
  673. +     if (items != 1)
  674. +         fatal("Usage: &dbrecftos($filename);");
  675. +     else
  676. +     {
  677. +         dbrecftos((char *)str_get(STACK(sp)[1]));
  678. +         
  679. +         str_numset(STACK(sp)[0], (double) 0);
  680. +     }
  681. +     break;
  682.   #endif
  683.         case US_dbwritetext:
  684.           if (items != 5)
  685. ***************
  686. *** 2499,2514 ****
  687.           str_numset(STACK(sp)[0], (double) j);
  688.       }
  689.       break;
  690. -       case US_dbrecftos:
  691. -     if (items != 1)
  692. -         fatal("Usage: &dbrecftos($filename);");
  693. -     else
  694. -     {
  695. -         dbrecftos((char *)str_get(STACK(sp)[1]));
  696. -         
  697. -         str_numset(STACK(sp)[0], (double) 0);
  698. -     }
  699. -     break;
  700.   
  701.         case US_BCP_SETL:
  702.       if (items != 1)
  703. --- 2527,2532 ----
  704. ***************
  705. *** 3353,3356 ****
  706.   }
  707.   
  708.   #endif  /* DBLIB461 */
  709. - 
  710. --- 3371,3373 ----
  711. Index: t/sbex.pl
  712. *** ../sybperl-1.8/t/sbex.pl    Thu Sep 30 16:28:33 1993
  713. --- t/sbex.pl    Fri Oct  1 08:59:54 1993
  714. ***************
  715. *** 9,14 ****
  716. --- 9,15 ----
  717.   require "sybperl.pl";
  718.   
  719.   print "Sybperl version $SybperlVer\n\n";
  720. + print "PACKAGE_BUG is defined - sybdb_redefs.pl has been loaded\n" if (defined($SybPackageBug) && $SybPackageBug == 1);
  721.   
  722.   print "This script tests some of sybperl's functions, and prints out\n";
  723.   print "description of the databases that are defined in your Sybase\n";
  724. ***************
  725. *** 113,119 ****
  726.   
  727.   # now get the indexes...
  728.   #
  729. !     print "\nIndexes on $db[0].$tab[0].$tab[1]...\n\n";
  730.       &dbuse($dbproc2, $db[0]);
  731.       &dbcmd($dbproc2, "sp_helpindex '$tab[1].$tab[0]'\n");
  732.   
  733. --- 114,120 ----
  734.   
  735.   # now get the indexes...
  736.   #
  737. !     print "\nIndexes on $db[0].$tab[1].$tab[0]...\n\n";
  738.       &dbuse($dbproc2, $db[0]);
  739.       &dbcmd($dbproc2, "sp_helpindex '$tab[1].$tab[0]'\n");
  740.   
  741. ***************
  742. *** 188,193 ****
  743.   
  744.       &INT_CANCEL;
  745.   }
  746. - 
  747.   
  748.   
  749. --- 189,193 ----
  750.  
  751. exit 0 # Just in case...
  752.