os2/OS2/REXX/t/rx_sql.test

   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 use OS2::REXX;
  12
  13 sub stmt
  14 {
  15         my ($s) = @_;
  16         $s =~ s/\s*\n\s*/ /g;
  17         $s =~ s/^\s+//;
  18         $s =~ s/\s+$//;
  19         return $s;
  20 }
  21
  22 sub sqlcode
  23 {
  24         OS2::REXX::_fetch("SQLCA.SQLCODE");
  25 }
  26
  27 sub sqlstate
  28 {
  29         OS2::REXX::_fetch("SQLCA.SQLSTATE");
  30 }
  31
  32 sub sql
  33 {
  34         my ($stmt) = stmt(@_);
  35         return 0 if OS2::REXX::_call("sqlexec", $sqlexec, "", $stmt);
  36         return sqlcode() >= 0;
  37 }
  38
  39 sub dbs
  40 {
  41         my ($stmt) = stmt(@_);
  42         return 0 if OS2::REXX::_call("sqldbs", $sqldbs, "", $stmt);
  43         return sqlcode() >= 0;
  44 }
  45
  46 sub error
  47 {
  48         my ($where) = @_;
  49         print "ERROR in $where: sqlcode=", sqlcode(), " sqlstate=", sqlstate(), "\n";
  50         dbs("GET MESSAGE INTO :MSG LINEWIDTH 75");
  51         my $msg = OS2::REXX::_fetch("MSG");
  52         print "\n", $msg;
  53         exit 1;
  54 }
  55
  56 REXX_call {
  57
  58   $sqlar   = DynaLoader::dl_load_file("h:/sqllib/dll/sqlar.dll") or die "load";
  59   $sqldbs  = DynaLoader::dl_find_symbol($sqlar, "SQLDBS")  or die "find sqldbs";
  60   $sqlexec = DynaLoader::dl_find_symbol($sqlar, "SQLEXEC") or die "find sqlexec";
  61
  62   sql(<<) or error("connect");
  63      CONNECT TO sample IN SHARE MODE
  64
  65   OS2::REXX::_set("STMT" => stmt(<<));
  66      SELECT name FROM sysibm.systables
  67
  68   sql(<<) or error("prepare");
  69      PREPARE s1 FROM :stmt
  70
  71   sql(<<) or error("declare");
  72      DECLARE c1 CURSOR FOR s1
  73
  74   sql(<<) or error("open");
  75      OPEN c1
  76
  77   while (1) {
  78      sql(<<) or error("fetch");
  79           FETCH c1 INTO :name
  80
  81      last if sqlcode() == 100;
  82
  83      print "Table name is ", OS2::REXX::_fetch("NAME"), "\n";
  84   }
  85
  86   sql(<<) or error("close");
  87      CLOSE c1
  88
  89   sql(<<) or error("rollback");
  90      ROLLBACK
  91
  92   sql(<<) or error("disconnect");
  93      CONNECT RESET
  94
  95 };
  96
  97 exit 0;