Commit | Line | Data |
760ac839 |
1 | BEGIN { |
2 | chdir 't' if -d 't/lib'; |
3 | @INC = '../lib'; |
4 | require Config; import Config; |
bbad3607 |
5 | if ($Config{'extensions'} !~ /\bOS2(::|\/)REXX\b/) { |
760ac839 |
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; |