home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl560.zip / os2 / OS2 / REXX / t / rx_tiesql.test < prev    next >
Encoding:
Text File  |  1999-07-20  |  1.4 KB  |  87 lines
  1. BEGIN {
  2.     chdir 't' if -d 't/lib';
  3.     @INC = '../lib';
  4.     require Config; import Config;
  5.     if ($Config{'extensions'} !~ /\bOS2(::|\/)REXX\b/) {
  6.     print "1..0\n";
  7.     exit 0;
  8.     }
  9. }
  10.  
  11. #extproc perl5 -Rx
  12. #! perl
  13.  
  14. use REXX;
  15.  
  16. $db2 = load REXX "sqlar" or die "load";
  17. tie $sqlcode, REXX, "SQLCA.SQLCODE";
  18. tie $sqlstate, REXX, "SQLCA.SQLSTATE";
  19. tie %rexx, REXX, "";
  20.  
  21. sub stmt
  22. {
  23.     my ($s) = @_;
  24.     $s =~ s/\s*\n\s*/ /g;
  25.     $s =~ s/^\s+//;
  26.     $s =~ s/\s+$//;
  27.     return $s;
  28. }
  29.  
  30. sub sql
  31. {
  32.     my ($stmt) = stmt(@_);
  33.     return 0 if $db2->SqlExec($stmt);
  34.     return $sqlcode >= 0;
  35. }
  36.  
  37. sub dbs
  38. {
  39.     my ($stmt) = stmt(@_);
  40.     return 0 if $db2->SqlDBS($stmt);
  41.     return $sqlcode >= 0;
  42. }
  43.  
  44. sub error
  45. {
  46.     my ($where) = @_;
  47.     print "ERROR in $where: sqlcode=$sqlcode, sqlstate=$sqlstate\n";
  48.     dbs("GET MESSAGE INTO :msg LINEWIDTH 75");
  49.     print "\n", $rexx{'MSG'};
  50.     exit 1;
  51. }
  52.  
  53. sql(<<) or error("connect");
  54.      CONNECT TO sample IN SHARE MODE
  55.  
  56. $rexx{'STMT'} = stmt(<<);
  57.      SELECT name FROM sysibm.systables
  58.  
  59. sql(<<) or error("prepare");
  60.      PREPARE s1 FROM :stmt
  61.  
  62. sql(<<) or error("declare");
  63.      DECLARE c1 CURSOR FOR s1
  64.  
  65. sql(<<) or error("open");
  66.      OPEN c1
  67.  
  68. while (1) {
  69.      sql(<<) or error("fetch");
  70.           FETCH c1 INTO :name
  71.  
  72.      last if $sqlcode == 100;
  73.  
  74.      print "Table name is $rexx{'NAME'}\n";
  75. }
  76.     
  77. sql(<<) or error("close");
  78.      CLOSE c1
  79.  
  80. sql(<<) or error("rollback");
  81.      ROLLBACK
  82.  
  83. sql(<<) or error("disconnect");
  84.      CONNECT RESET
  85.  
  86. exit 0;
  87.