home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / misc / volume28 / sybperl / part01 / eg / sql.pl < prev   
Encoding:
Text File  |  1992-02-10  |  1.7 KB  |  75 lines

  1. sub sql {
  2.     local($db,$sql,$sep)=@_;            # local copy parameters
  3.  
  4.     $sep = '~' unless $sep;            # provide default for sep
  5.  
  6.     @res = ();                    # clear result array
  7.  
  8.     &dbcmd($db,$sql);                # pass sql to server
  9.     &dbsqlexec($db);                # execute sql
  10.  
  11.     while(&dbresults($db) != $NO_MORE_RESULTS) {    # copy all results
  12.     while (@data = &dbnextrow($db1)) {
  13.         push(@res,join($sep,@data));
  14.     }
  15.     }
  16.  
  17.     @res;                    # return the result array
  18. }
  19.  
  20.  
  21. # Message and error handlers.
  22.  
  23. sub sql_message_handler
  24. {
  25.     local ($db, $message, $state, $severity, $text, $server, $procedure, $line)
  26.     = @_;
  27.  
  28.     if ($severity > 0)
  29.     {
  30.     print ("Sybase message ", $message, ", Severity ", $severity,
  31.            ", state ", $state);
  32.     print ("\nServer `", $server, "'") if defined ($server);
  33.     print ("\nProcedure `", $procedure, "'") if defined ($procedure);
  34.     print ("\nLine ", $line) if defined ($line);
  35.     print ("\n    ", $text, "\n\n");
  36.  
  37. # &dbstrcpy returns the command buffer.
  38.  
  39.     local ($lineno) = 1;    # 
  40.     foreach $row (split (/\n/, &dbstrcpy ($db)))
  41.     {
  42.         print (sprintf ("%5d", $lineno ++), "> ", $row, "\n");
  43.     }
  44.     }
  45.     elsif ($message == 0)
  46.     {
  47.     print ($text, "\n");
  48.     }
  49.     
  50.     0;
  51. }
  52.  
  53. sub sql_error_handler {
  54.     # Check the error code to see if we should report this.
  55.     if ($_[2] != &SYBESMSG) {
  56.     local ($db, $severity, $error, $os_error, $error_msg, $os_error_msg)
  57.         = @_;
  58.     print ("Sybase error: ", $error_msg, "\n");
  59.     print ("OS Error: ", $os_error_msg, "\n") if defined ($os_error_msg);
  60.     }
  61.  
  62.     &INT_CANCEL;
  63. }
  64.  
  65.  
  66. if( defined(&dbmsghandle))    # Is this a modern version of sybperl? ;-)
  67. {
  68.     &dbmsghandle ("sql_message_handler"); # Some user defined error handlers
  69.     &dberrhandle ("sql_error_handler");
  70. }
  71.  
  72.  
  73. 1;
  74.  
  75.