use OS2::REXX;

sub stmt
{
	my ($s) = @_;
	$s =~ s/\s*\n\s*/ /g;
	$s =~ s/^\s+//;
	$s =~ s/\s+$//;
	return $s;
}

sub sqlcode
{
	OS2::REXX::_fetch("SQLCA.SQLCODE");
}

sub sqlstate
{
	OS2::REXX::_fetch("SQLCA.SQLSTATE");
}

sub sql
{
	my ($stmt) = stmt(@_);
	return 0 if OS2::REXX::_call("sqlexec", $sqlexec, "", $stmt);
	return sqlcode() >= 0;
}

sub dbs
{
	my ($stmt) = stmt(@_);
	return 0 if OS2::REXX::_call("sqldbs", $sqldbs, "", $stmt);
	return sqlcode() >= 0;
}

sub error
{
	my ($where) = @_;
	print "ERROR in $where: sqlcode=", sqlcode(), " sqlstate=", sqlstate(), "\n";
	dbs("GET MESSAGE INTO :MSG LINEWIDTH 75");
	my $msg = OS2::REXX::_fetch("MSG");
	print "\n", $msg;
	exit 1;
}

$sqlar   = DynaLoader::dl_load_file("h:/sqllib/dll/sqlar.dll") or die "load";
$sqldbs  = DynaLoader::dl_find_symbol($sqlar, "SQLDBS")  or die "find sqldbs"; 
$sqlexec = DynaLoader::dl_find_symbol($sqlar, "SQLEXEC") or die "find sqlexec";

sql(<<) or error("connect");
     CONNECT TO sample IN SHARE MODE

OS2::REXX::_set("STMT" => stmt(<<));
     SELECT name FROM sysibm.systables

sql(<<) or error("prepare");
     PREPARE s1 FROM :stmt

sql(<<) or error("declare");
     DECLARE c1 CURSOR FOR s1

sql(<<) or error("open");
     OPEN c1

while (1) {
     sql(<<) or error("fetch");
          FETCH c1 INTO :name

     last if sqlcode() == 100;

     print "Table name is ", OS2::REXX::_fetch("NAME"), "\n";
}
	
sql(<<) or error("close");
     CLOSE c1

sql(<<) or error("rollback");
     ROLLBACK

sql(<<) or error("disconnect");
     CONNECT RESET

exit 0;
