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