prism/examples/prism-qore.html

962 lines
28 KiB
HTML

<h2>Full example</h2>
<pre><code>#!/usr/bin/env qore
# database test script
# databases users must be able to create and destroy tables and procedures, etc
# in order to execute all tests
%require-our
%enable-all-warnings
our ($o, $errors, $test_count);
const opts =
( "help" : "h,help",
"host" : "H,host=s",
"pass" : "p,pass=s",
"db" : "d,db=s",
"user" : "u,user=s",
"type" : "t,type=s",
"enc" : "e,encoding=s",
"verbose" : "v,verbose:i+",
"leave" : "l,leave"
);
sub usage()
{
printf("usage: %s [options]
-h,--help this help text
-u,--user=ARG set username
-p,--pass=ARG set password
-d,--db=ARG set database name
-e,--encoding=ARG set database character set encoding (i.e. \"utf8\")
-H,--host=ARG set hostname (for MySQL and PostgreSQL connections)
-t,--type set database driver (default mysql)
-v,--verbose more v's = more information
-l,--leave leave test tables in schema at end\n",
basename($ENV."_"));
exit();
}
const object_map =
( "oracle" :
( "tables" : ora_tables ),
"mysql" :
( "tables" : mysql_tables ),
"pgsql" :
( "tables" : pgsql_tables ),
"sybase" :
( "tables" : syb_tables,
"procs" : sybase_procs ),
"freetds" :
( "tables" : freetds_sybase_tables,
"procs" : sybase_procs ) );
const ora_tables = (
"family" : "create table family (
family_id int not null,
name varchar2(80) not null
)",
"people" : "create table people (
person_id int not null,
family_id int not null,
name varchar2(250) not null,
dob date not null
)",
"attributes" : "create table attributes (
person_id int not null,
attribute varchar2(80) not null,
value varchar2(160) not null
)" );
const mysql_tables = (
"family" : "create table family (
family_id int not null,
name varchar(80) not null
) type = innodb",
"people" : "create table people (
person_id int not null,
family_id int not null,
name varchar(250) not null,
dob date not null
) type = innodb",
"attributes" : "create table attributes (
person_id int not null,
attribute varchar(80) not null,
value varchar(160) not null
) type = innodb" );
const pgsql_tables = (
"family" : "create table family (
family_id int not null,
name varchar(80) not null )",
"people" : "create table people (
person_id int not null,
family_id int not null,
name varchar(250) not null,
dob date not null )",
"attributes" : "create table attributes (
person_id int not null,
attribute varchar(80) not null,
value varchar(160) not null)",
"data_test" : "create table data_test (
int2_f smallint not null,
int4_f integer not null,
int8_f int8 not null,
bool_f boolean not null,
float4_f real not null,
float8_f double precision not null,
number_f numeric(16,3) not null,
money_f money not null,
text_f text not null,
varchar_f varchar(40) not null,
char_f char(40) not null,
name_f name not null,
date_f date not null,
abstime_f abstime not null,
reltime_f reltime not null,
interval_f interval not null,
time_f time not null,
timetz_f time with time zone not null,
timestamp_f timestamp not null,
timestamptz_f timestamp with time zone not null,
tinterval_f tinterval not null,
bytea_f bytea not null
--bit_f bit(11) not null,
--varbit_f bit varying(11) not null
)" );
const syb_tables = (
"family" : "create table family (
family_id int not null,
name varchar(80) not null
)",
"people" : "create table people (
person_id int not null,
family_id int not null,
name varchar(250) not null,
dob date not null
)",
"attributes" : "create table attributes (
person_id int not null,
attribute varchar(80) not null,
value varchar(160) not null
)",
"data_test" : "create table data_test (
null_f char(1) null,
varchar_f varchar(40) not null,
char_f char(40) not null,
unichar_f unichar(40) not null,
univarchar_f univarchar(40) not null,
text_f text not null,
unitext_f unitext not null, -- note that unitext is stored as 'image'
bit_f bit not null,
tinyint_f tinyint not null,
smallint_f smallint not null,
int_f int not null,
int_f2 int not null,
decimal_f decimal(10,4) not null,
float_f float not null, -- 8-bytes
real_f real not null, -- 4-bytes
money_f money not null,
smallmoney_f smallmoney not null,
date_f date not null,
time_f time not null,
datetime_f datetime not null,
smalldatetime_f smalldatetime not null,
binary_f binary(4) not null,
varbinary_f varbinary(4) not null,
image_f image not null
)" );
const sybase_procs = (
"find_family" :
"create procedure find_family @name varchar(80)
as
select * from family where name = @name
commit -- to maintain transaction count
",
"get_values" :
"create procedure get_values @string varchar(80) output, @int int output
as
select @string = 'hello there'
select @int = 150
commit -- to maintain transaction count
",
"get_values_and_select" :
"create procedure get_values_and_select @string varchar(80) output, @int int output
as
select @string = 'hello there'
select @int = 150
select * from family where family_id = 1
commit -- to maintain transaction count
",
"get_values_and_multiple_select" :
"create procedure get_values_and_multiple_select @string varchar(80) output, @int int output
as
select @string = 'hello there'
select @int = 150
select * from family where family_id = 1
select * from people where person_id = 1
commit -- to maintain transaction count
",
"just_select" :
"create procedure just_select
as
select * from family where family_id = 1
commit -- to maintain transaction count
",
"multiple_select" :
"create procedure multiple_select
as
select * from family where family_id = 1
select * from people where person_id = 1
commit -- to maintain transaction count
"
);
const freetds_sybase_tables = (
"family" : "create table family (
family_id int not null,
name varchar(80) not null
)",
"people" : "create table people (
person_id int not null,
family_id int not null,
name varchar(250) not null,
dob date not null
)",
"attributes" : "create table attributes (
person_id int not null,
attribute varchar(80) not null,
value varchar(160) not null
)",
"data_test" : "create table data_test (
null_f char(1) null,
varchar_f varchar(40) not null,
char_f char(40) not null,
text_f text not null,
unitext_f unitext not null, -- note that unitext is stored as 'image'
bit_f bit not null,
tinyint_f tinyint not null,
smallint_f smallint not null,
int_f int not null,
int_f2 int not null,
decimal_f decimal(10,4) not null,
float_f float not null, -- 8-bytes
real_f real not null, -- 4-bytes
money_f money not null,
smallmoney_f smallmoney not null,
date_f date not null,
time_f time not null,
datetime_f datetime not null,
smalldatetime_f smalldatetime not null,
binary_f binary(4) not null,
varbinary_f varbinary(4) not null,
image_f image not null
)" );
const freetds_mssql_tables = (
"family" : "create table family (
family_id int not null,
name varchar(80) not null
)",
"people" : "create table people (
person_id int not null,
family_id int not null,
name varchar(250) not null,
dob datetime not null
)",
"attributes" : "create table attributes (
person_id int not null,
attribute varchar(80) not null,
value varchar(160) not null
)",
"data_test" : "create table data_test (
null_f char(1) null,
varchar_f varchar(40) not null,
char_f char(40) not null,
text_f text not null,
bit_f bit not null,
tinyint_f tinyint not null,
smallint_f smallint not null,
int_f int not null,
int_f2 int not null,
decimal_f decimal(10,4) not null,
float_f float not null, -- 8-bytes
real_f real not null, -- 4-bytes
money_f money not null,
smallmoney_f smallmoney not null,
datetime_f datetime not null,
smalldatetime_f smalldatetime not null,
binary_f binary(4) not null,
varbinary_f varbinary(4) not null,
image_f image not null
)" );
sub parse_command_line()
{
my $g = new GetOpt(opts);
$o = $g.parse(\$ARGV);
if ($o.help)
usage();
if (!strlen($o.db))
{
stderr.printf("set the login parameters with -u,-p,-d, etc (-h for help)\n");
exit(1);
}
if (elements $ARGV)
{
stderr.printf("excess arguments on command-line (%n): -h for help\n", $ARGV);
exit(1);
}
if (!strlen($o.type))
$o.type = "mysql";
}
sub create_datamodel($db)
{
drop_test_datamodel($db);
my $driver = $db.getDriverName();
# create tables
my $tables = object_map.$driver.tables;
if ($driver == "freetds")
if ($db.is_sybase)
$tables = freetds_sybase_tables;
else
$tables = freetds_mssql_tables;
foreach my $table in (keys $tables)
{
tprintf(2, "creating table %n\n", $table);
$db.exec($tables.$table);
}
# create procedures if any
foreach my $proc in (keys object_map.$driver.procs)
{
tprintf(2, "creating procedure %n\n", $proc);
$db.exec(object_map.$driver.procs.$proc);
}
# create functions if any
foreach my $func in (keys object_map.$driver.funcs)
{
tprintf(2, "creating function %n\n", $func);
$db.exec(object_map.$driver.funcs.$func);
}
$db.exec("insert into family values ( 1, 'Smith' )");
$db.exec("insert into family values ( 2, 'Jones' )");
# we insert the dates here using binding by value so we don't have
# to worry about each database's specific date format
$db.exec("insert into people values ( 1, 1, 'Arnie', %v)", 1983-05-13);
$db.exec("insert into people values ( 2, 1, 'Sylvia', %v)", 1994-11-10);
$db.exec("insert into people values ( 3, 1, 'Carol', %v)", 2003-07-23);
$db.exec("insert into people values ( 4, 1, 'Bernard', %v)", 1979-02-27);
$db.exec("insert into people values ( 5, 1, 'Isaac', %v)", 2000-04-04);
$db.exec("insert into people values ( 6, 2, 'Alan', %v)", 1992-06-04);
$db.exec("insert into people values ( 7, 2, 'John', %v)", 1995-03-23);
$db.exec("insert into attributes values ( 1, 'hair', 'blond' )");
$db.exec("insert into attributes values ( 1, 'eyes', 'hazel' )");
$db.exec("insert into attributes values ( 2, 'hair', 'blond' )");
$db.exec("insert into attributes values ( 2, 'eyes', 'blue' )");
$db.exec("insert into attributes values ( 3, 'hair', 'brown' )");
$db.exec("insert into attributes values ( 3, 'eyes', 'grey')");
$db.exec("insert into attributes values ( 4, 'hair', 'brown' )");
$db.exec("insert into attributes values ( 4, 'eyes', 'brown' )");
$db.exec("insert into attributes values ( 5, 'hair', 'red' )");
$db.exec("insert into attributes values ( 5, 'eyes', 'green' )");
$db.exec("insert into attributes values ( 6, 'hair', 'black' )");
$db.exec("insert into attributes values ( 6, 'eyes', 'blue' )");
$db.exec("insert into attributes values ( 7, 'hair', 'brown' )");
$db.exec("insert into attributes values ( 7, 'eyes', 'brown' )");
$db.commit();
}
sub drop_test_datamodel($db)
{
my $driver = $db.getDriverName();
# drop the tables and ignore exceptions
# the commits are needed for databases like postgresql, where errors will prohibit and further
# actions from being taken on the Datasource
foreach my $table in (keys object_map.$driver.tables)
try {
$db.exec("drop table " + $table);
$db.commit();
tprintf(2, "dropped table %n\n", $table);
}
catch ()
{
$db.commit();
}
# drop procedures and ignore exceptions
foreach my $proc in (keys object_map.$driver.procs)
{
my $cmd = object_map.$driver.drop_proc_cmd;
if (!exists $cmd)
$cmd = "drop procedure";
try {
$db.exec($cmd + " " + $proc);
$db.commit();
tprintf(2, "dropped procedure %n\n", $proc);
}
catch ()
{
$db.commit();
}
}
# drop functions and ignore exceptions
foreach my $func in (keys object_map.$driver.funcs)
{
my $cmd = object_map.$driver.drop_func_cmd;
if (!exists $cmd)
$cmd = "drop function";
try {
$db.exec($cmd + " " + $func);
$db.commit();
tprintf(2, "dropped function %n\n", $func);
}
catch ()
{
$db.commit();
}
}
}
sub getDS()
{
my $ds = new Datasource($o.type, $o.user, $o.pass, $o.db, $o.enc);
if (strlen($o.host))
$ds.setHostName($o.host);
return $ds;
}
sub tprintf($v, $msg)
{
if ($v &lt;= $o.verbose)
vprintf($msg, $argv);
}
sub test_value($v1, $v2, $msg)
{
++$test_count;
if ($v1 == $v2)
tprintf(1, "OK: %s test\n", $msg);
else
{
tprintf(0, "ERROR: %s test failed! (%n != %n)\n", $msg, $v1, $v2);
$errors++;
}
}
const family_hash = (
"Jones" : (
"people" : (
"John" : (
"dob" : 1995-03-23,
"eyes" : "brown",
"hair" : "brown" ),
"Alan" : (
"dob" : 1992-06-04,
"eyes" : "blue",
"hair" : "black" ) ) ),
"Smith" : (
"people" : (
"Arnie" : (
"dob" : 1983-05-13,
"eyes" : "hazel",
"hair" : "blond" ),
"Carol" : (
"dob" : 2003-07-23,
"eyes" : "grey",
"hair" : "brown" ),
"Isaac" : (
"dob" : 2000-04-04,
"eyes" : "green",
"hair" : "red" ),
"Bernard" : (
"dob" : 1979-02-27,
"eyes" : "brown",
"hair" : "brown" ),
"Sylvia" : (
"dob" : 1994-11-10,
"eyes" : "blue",
"hair" : "blond" ) ) ) );
sub context_test($db)
{
# first we select all the data from the tables and then use
# context statements to order the output hierarchically
# context statements are most useful when a set of queries can be executed once
# and the results processed many times by creating "views" with context statements
my $people = $db.select("select * from people");
my $attributes = $db.select("select * from attributes");
my $today = format_date("YYYYMMDD", now());
# in this test, we create a big hash structure out of the queries executed above
# and compare it at the end to the expected result
# display each family sorted by family name
my $fl;
context family ($db.select("select * from family")) sortBy (%name)
{
my $pl;
tprintf(2, "Family %d: %s\n", %family_id, %name);
# display people, sorted by eye color, descending
context people ($people)
sortDescendingBy (find %value in $attributes
where (%attribute == "eyes"
&& %person_id == %people:person_id))
where (%family_id == %family:family_id)
{
my $al;
tprintf(2, " %s, born %s\n", %name, format_date("Month DD, YYYY", %dob));
context ($attributes) sortBy (%attribute) where (%person_id == %people:person_id)
{
$al.%attribute = %value;
tprintf(2, " has %s %s\n", %value, %attribute);
}
# leave out the ID fields and name from hash under name; subtracting a
# string from a hash removes that key from the result
# this is "doing it the hard way", there is only one key left,
# "dob", then attributes are added directly into the person hash
$pl.%name = %% - "family_id" - "person_id" - "name" + $al;
}
# leave out family_id and name fields (leaving an empty hash)
$fl.%name = %% - "family_id" - "name" + ( "people" : $pl );
}
# test context ordering
test_value(keys $fl, ("Jones", "Smith"), "first context");
test_value(keys $fl.Smith.people, ("Arnie", "Carol", "Isaac", "Bernard", "Sylvia"), "second context");
# test entire context value
test_value($fl, family_hash, "third context");
}
sub test_timeout($db, $c)
{
$db.setTransactionLockTimeout(1ms);
try {
# this should cause a TRANSACTION-LOCK-TIMEOUT exception to be thrown
$db.exec("insert into family values (3, 'Test')\n");
test_value(True, False, "transaction timeout");
$db.exec("delete from family where name = 'Test'");
}
catch ($ex)
{
test_value(True, True, "transaction timeout");
}
# signal parent thread to continue
$c.dec();
}
sub transaction_test($db)
{
my $ndb = getDS();
my $r;
tprintf(2, "db.autocommit=%N, ndb.autocommit=%N\n", $db.getAutoCommit(), $ndb.getAutoCommit());
# first, we insert a new row into "family" but do not commit it
my $rows = $db.exec("insert into family values (3, 'Test')\n");
if ($rows !== 1)
printf("FAILED INSERT, rows=%N\n", $rows);
# now we verify that the new row is not visible to the other datasource
# unless it's a sybase/ms sql server datasource, in which case this would deadlock :-(
if ($o.type != "sybase" && $o.type != "freetds")
{
$r = $ndb.selectRow("select name from family where family_id = 3").name;
test_value($r, NOTHING, "first transaction");
}
# now we verify that the new row is visible to the inserting datasource
$r = $db.selectRow("select name from family where family_id = 3").name;
test_value($r, "Test", "second transaction");
# test datasource timeout
# this Counter variable will allow the parent thread to sleep
# until the child thread times out
my $c = new Counter(1);
background test_timeout($db, $c);
# wait for child thread to time out
$c.waitForZero();
# now, we commit the transaction
$db.commit();
# now we verify that the new row is visible in the other datasource
$r = $ndb.selectRow("select name from family where family_id = 3").name;
test_value($r, "Test", "third transaction");
# now we delete the row we inserted (so we can repeat the test)
$r = $ndb.exec("delete from family where family_id = 3");
test_value($r, 1, "delete row count");
$ndb.commit();
}
sub oracle_test()
{
}
# here we use a little workaround for modules that provide functions,
# namespace additions (constants, classes, etc) needed by test functions
# at parse time. To avoid parse errors (as database modules are loaded
# in this script at run-time when the Datasource class is instantiated)
# we use a Program object that we parse and run on demand to return the
# value required
sub get_val($code)
{
my $p = new Program();
my $str = sprintf("return %s;", $code);
$p.parse($str, "code");
return $p.run();
}
sub pgsql_test($db)
{
my $args = ( "int2_f" : 258,
"int4_f" : 233932,
"int8_f" : 239392939458,
"bool_f" : True,
"float4_f" : 21.3444,
"float8_f" : 49394.23423491,
"number_f" : get_val("pgsql_bind(PG_TYPE_NUMERIC, '7235634215.3250')"),
"money_f" : get_val("pgsql_bind(PG_TYPE_CASH, \"400.56\")"),
"text_f" : 'some text ',
"varchar_f" : 'varchar ',
"char_f" : 'char text',
"name_f" : 'name',
"date_f" : 2004-01-05,
"abstime_f" : 2005-12-03T10:00:01,
"reltime_f" : 5M + 71D + 19h + 245m + 51s,
"interval_f" : 6M + 3D + 2h + 45m + 15s,
"time_f" : 11:35:00,
"timetz_f" : get_val("pgsql_bind(PG_TYPE_TIMETZ, \"11:38:21 CST\")"),
"timestamp_f" : 2005-04-01T11:35:26,
"timestamptz_f" : 2005-04-01T11:35:26.259,
"tinterval_f" : get_val("pgsql_bind(PG_TYPE_TINTERVAL, '[\"May 10, 1947 23:59:12\" \"Jan 14, 1973 03:14:21\"]')"),
"bytea_f" : &lt;bead>
#bit_f :
#varbit_f :
);
$db.vexec("insert into data_test values (%v, %v, %v, %v, %v, %v, %v, %v, %v, %v, %v, %v, %v, %v, %v, %v, %v, %v, %v, %v, %v, %v)", hash_values($args));
my $q = $db.selectRow("select * from data_test");
if ($o.verbose > 1)
foreach my $k in (keys $q)
tprintf(2, " %-16s= %-10s %N\n", $k, type($q.$k), $q.$k);
# fix values where we know the return type is different
$args.money_f = 400.56;
$args.timetz_f = 11:38:21;
$args.tinterval_f = '["1947-05-10 21:59:12" "1973-01-14 02:14:21"]';
$args.number_f = "7235634215.3250";
$args.reltime_f = 19177551s;
$args.interval_f = 6M + 3D + 9915s;
# rounding errors can happen in float4
$q.float4_f = round($q.float4_f);
$args.float4_f = round($args.float4_f);
# remove values where we know they won't match
# abstime and timestamptz are converted to GMT by the server
delete $q.abstime_f;
delete $q.timestamptz_f;
# compare each value
foreach my $k in (keys $q)
test_value($q.$k, $args.$k, sprintf("%s bind and retrieve", $k));
$db.commit();
}
sub mysql_test()
{
}
const family_q = ( "family_id" : 1,
"name" : "Smith" );
const person_q = ( "person_id" : 1,
"family_id" : 1,
"name" : "Arnie",
"dob" : 1983-05-13 );
const params = ( "string" : "hello there",
"int" : 150 );
sub sybase_test($db)
{
# simple stored proc test, bind by name
my $x = $db.exec("exec find_family %v", "Smith");
test_value($x, ("name": list("Smith"), "family_id" : list(1)), "simple stored proc");
# stored proc execute with output params
$x = $db.exec("declare @string varchar(40), @int int
exec get_values :string output, :int output");
test_value($x, params + ("rowcount":1), "get_values");
# we use Datasource::selectRows() in the following queries because we
# get hash results instead of a hash of lists as with exec in the queries
# normally we should not use selectRows to execute a stored procedure,
# as the Datasource::selectRows() method will not grab the transaction lock,
# but we already called Datasource::exec() above, so we have it already.
# the other alternative would be to call Datasource::beginTransaction() before
# Datasource::selectRows()
# simple stored proc test, bind by name, returns hash
$x = $db.selectRows("exec find_family %v", "Smith");
test_value($x, family_q, "simple stored proc");
# stored proc execute with output params and select results
$x = $db.selectRows("declare @string varchar(40), @int int
exec get_values_and_select :string output, :int output");
test_value($x, ("query":family_q,"params":params), "get_values_and_select");
# stored proc execute with output params and multiple select results
$x = $db.selectRows("declare @string varchar(40), @int int
exec get_values_and_multiple_select :string output, :int output");
test_value($x, ("query":("query0":family_q,"query1":person_q),"params":params), "get_values_and_multiple_select");
# stored proc execute with just select results
$x = $db.selectRows("exec just_select");
test_value($x, family_q, "just_select");
# stored proc execute with multiple select results
$x = $db.selectRows("exec multiple_select");
test_value($x, ("query0":family_q,"query1":person_q), "multiple_select");
my $args = ( "null_f" : NULL,
"varchar_f" : "varchar",
"char_f" : "char",
"unichar_f" : "unichar",
"univarchar_f" : "univarchar",
"text_f" : "test",
"unitext_f" : "test",
"bit_f" : True,
"tinyint_f" : 55,
"smallint_f" : 4285,
"int_f" : 405402,
"int_f2" : 214123498,
"decimal_f" : 500.1231,
"float_f" : 23443.234324234,
"real_f" : 213.123,
"money_f" : 3434234250.2034,
"smallmoney_f" : 211100.1012,
"date_f" : 2007-05-01,
"time_f" : 10:30:01,
"datetime_f" : 3459-01-01T11:15:02.250,
"smalldatetime_f" : 2007-12-01T12:01:00,
"binary_f" : &lt;0badbeef>,
"varbinary_f" : &lt;feedface>,
"image_f" : &lt;cafebead> );
# insert data
my $rows = $db.vexec("insert into data_test values (%v, %v, %v, %v, %v, %v, %v, %v, %v, %v, %v, %d, %v, %v, %v, %v, %v, %v, %v, %v, %v, %v, %v, %v)", hash_values($args));
my $q = $db.selectRow("select * from data_test");
if ($o.verbose > 1)
foreach my $k in (keys $q)
tprintf(2, " %-16s= %-10s %N\n", $k, type($q.$k), $q.$k);
# remove values where we know they won't match
# unitext_f is returned as IMAGE by the server
delete $q.unitext_f;
delete $args.unitext_f;
# rounding errors can happen in real
$q.real_f = round($q.real_f);
$args.real_f = round($args.real_f);
# compare each value
foreach my $k in (keys $q)
test_value($q.$k, $args.$k, sprintf("%s bind and retrieve", $k));
$db.commit();
}
sub freetds_test($db)
{
# simple stored proc test, bind by name
my $x = $db.exec("exec find_family %v", "Smith");
test_value($x, ("name": list("Smith"), "family_id" : list(1)), "simple stored proc");
# we cannot retrieve parameters from newer SQL Servers with the approach we use;
# Microsoft changed the handling of the protocol and require us to use RPC calls,
# this will be implemented in the next version of qore where the "freetds" driver will
# be able to add custom methods to the Datasource class. For now, we skip these tests
if ($db.is_sybase)
{
$x = $db.exec("declare @string varchar(40), @int int
exec get_values :string output, :int output");
test_value($x, params, "get_values");
}
# we use Datasource::selectRows() in the following queries because we
# get hash results instead of a hash of lists as with exec in the queries
# normally we should not use selectRows to execute a stored procedure,
# as the Datasource::selectRows() method will not grab the transaction lock,
# but we already called Datasource::exec() above, so we have it already.
# the other alternative would be to call Datasource::beginTransaction() before
# Datasource::selectRows()
# simple stored proc test, bind by name, returns hash
$x = $db.selectRows("exec find_family %v", "Smith");
test_value($x, family_q, "simple stored proc");
# stored proc execute with output params and select results
if ($db.is_sybase)
{
$x = $db.selectRows("declare @string varchar(40), @int int
exec get_values_and_select :string output, :int output");
test_value($x, ("query":family_q,"params":params), "get_values_and_select");
# stored proc execute with output params and multiple select results
$x = $db.selectRows("declare @string varchar(40), @int int
exec get_values_and_multiple_select :string output, :int output");
test_value($x, ("query":("query0":family_q,"query1":person_q),"params":params), "get_values_and_multiple_select");
}
# stored proc execute with just select results
$x = $db.selectRows("exec just_select");
test_value($x, family_q, "just_select");
# stored proc execute with multiple select results
$x = $db.selectRows("exec multiple_select");
test_value($x, ("query0":family_q,"query1":person_q), "multiple_select");
# the freetds driver does not work with the following sybase column types:
# unichar, univarchar
my $args = ( "null_f" : NULL,
"varchar_f" : "test",
"char_f" : "test",
"text_f" : "test",
"unitext_f" : "test",
"bit_f" : True,
"tinyint_f" : 55,
"smallint_f" : 4285,
"int_f" : 405402,
"int_f2" : 214123498,
"decimal_f" : 500.1231,
"float_f" : 23443.234324234,
"real_f" : 213.123,
"money_f" : 3434234250.2034,
"smallmoney_f" : 211100.1012,
"date_f" : 2007-05-01,
"time_f" : 10:30:01,
"datetime_f" : 3459-01-01T11:15:02.250,
"smalldatetime_f" : 2007-12-01T12:01:00,
"binary_f" : &lt;0badbeef>,
"varbinary_f" : &lt;feedface>,
"image_f" : &lt;cafebead> );
# remove fields not supported by sql server
if (!$db.is_sybase)
{
delete $args.unitext_f;
delete $args.date_f;
delete $args.time_f;
}
my $sql = "insert into data_test values (";
for (my $i; $i &lt; elements $args; ++$i)
$sql += "%v, ";
$sql = substr($sql, 0, -2) + ")";
# insert data, using the values from the hash above
my $rows = $db.vexec($sql, hash_values($args));
my $q = $db.selectRow("select * from data_test");
if ($o.verbose > 1)
foreach my $k in (keys $q)
tprintf(2, " %-16s= %-10s %N\n", $k, type($q.$k), $q.$k);
# remove values where we know they won't match
# unitext_f is returned as IMAGE by the server
delete $q.unitext_f;
delete $args.unitext_f;
# rounding errors can happen in real
$q.real_f = round($q.real_f);
$args.real_f = round($args.real_f);
# compare each value
foreach my $k in (keys $q)
test_value($q.$k, $args.$k, sprintf("%s bind and retrieve", $k));
$db.commit();
}
sub main()
{
my $test_map =
( "sybase" : \sybase_test(),
"freetds" : \freetds_test(),
"mysql" : \mysql_test(),
"pgsql" : \pgsql_test(),
"oracle" : \oracle_test());
parse_command_line();
my $db = getDS();
my $driver = $db.getDriverName();
printf("testing %s driver\n", $driver);
my $sv = $db.getServerVersion();
if ($o.verbose > 1)
tprintf(2, "client version=%n\nserver version=%n\n", $db.getClientVersion(), $sv);
# determine if the server is a sybase or sql server dataserver
if ($driver == "freetds")
if ($sv !~ /microsoft/i)
$db.is_sybase = True;
create_datamodel($db);
context_test($db);
transaction_test($db);
my $test = $test_map.($db.getDriverName());
if (exists $test)
$test($db);
if (!$o.leave)
drop_test_datamodel($db);
printf("%d/%d tests OK\n", $test_count - $errors, $test_count);
}
main();</code></pre>