1BEGIN {
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
11use OS2::REXX;
12
13sub 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
22sub sqlcode
23{
24	OS2::REXX::_fetch("SQLCA.SQLCODE");
25}
26
27sub sqlstate
28{
29	OS2::REXX::_fetch("SQLCA.SQLSTATE");
30}
31
32sub sql
33{
34	my ($stmt) = stmt(@_);
35	return 0 if OS2::REXX::_call("sqlexec", $sqlexec, "", $stmt);
36	return sqlcode() >= 0;
37}
38
39sub dbs
40{
41	my ($stmt) = stmt(@_);
42	return 0 if OS2::REXX::_call("sqldbs", $sqldbs, "", $stmt);
43	return sqlcode() >= 0;
44}
45
46sub 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
56REXX_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
97exit 0;
98