[svn:dbd-oracle] r15470 - dbd-oracle/trunk/t
[email protected] Fri, 9 Nov 2012 07:51:29 -0800 (PST)
| Newsgroups | perl.dbd.oracle.changes |
|---|---|
| Message-ID | <[email protected]> |
Author: mjevans
Date: Fri Nov 9 07:51:27 2012
New Revision: 15470
Modified:
dbd-oracle/trunk/t/58object.t (contents, props changed)
Log:
use unix line endings
Modified: dbd-oracle/trunk/t/58object.t
==============================================================================
--- dbd-oracle/trunk/t/58object.t (original)
+++ dbd-oracle/trunk/t/58object.t Fri Nov 9 07:51:27 2012
@@ -1,262 +1,262 @@
-#!perl -w
-
-use DBI;
-use DBD::Oracle qw(ORA_RSET SQLCS_NCHAR);
-use strict;
-use Data::Dumper;
-
-use Test::More;
-unshift @INC ,'t';
-require 'nchar_test_lib.pl';
-
-$| = 1;
-
-$ENV{NLS_DATE_FORMAT} = 'YYYY-MM-DD"T"HH24:MI:SS';
-
-# create a database handle
-my $dsn = oracle_test_dsn();
-my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger';
-my $dbh;
-eval {$dbh = DBI->connect($dsn, $dbuser, '',{ RaiseError=>1,
- AutoCommit=>1,
- PrintError => 0,
- ora_objects => 1 })};
-
-plan skip_all => "Unable to connect to Oracle" unless $dbh;
-
-plan tests => 65;
-
-my ($schema) = $dbuser =~ m{^([^/]*)};
-
-# Test ora_objects flag
-is $dbh->{ora_objects} => 1, 'ora_objects flag is set to 1';
-
-$dbh->{ora_objects} = 0;
-is $dbh->{ora_objects} => 0, 'ora_objects flag is set to 0';
-
-# check that our db handle is good
-isa_ok($dbh, "DBI::db");
-
-
-ok( $schema = $dbh->selectrow_array(
- "select sys_context('userenv', 'current_schema') from dual"
-), 'Fetch current schema name');
-
-
-my $obj_prefix = "dbd_test_";
-my $super_type = "${obj_prefix}_type_A";
-my $sub_type = "${obj_prefix}_type_B";
-my $table = "${obj_prefix}_obj_table";
-my $outer_type = "${obj_prefix}_outer_type";
-my $inner_type = "${obj_prefix}_inner_type";
-my $list_type = "${obj_prefix}_list_type";
-my $nest_table = "${obj_prefix}_nest_table";
-my $list_table = "${obj_prefix}_list_table";
-
-sub drop_test_objects {
- for my $obj ("TABLE $list_table", "TABLE $nest_table",
- "TYPE $list_type", "TYPE $outer_type", "TYPE $inner_type",
- "TABLE $table", "TYPE $sub_type", "TYPE $super_type") {
- #do not warn if already there
- eval {
- local $dbh->{PrintError} = 0;
- $dbh->do(qq{drop $obj});
- };
- }
-}
-
-&drop_test_objects;
-
-# get the user's privileges
-my $privs_sth = $dbh->prepare( 'SELECT PRIVILEGE from session_privs' );
-$privs_sth->execute;
-my @privileges = map { $_->[0] } @{ $privs_sth->fetchall_arrayref };
-
-
-SKIP: {
- skip q{don't have permission to create type} => 61
- unless grep { $_ eq 'CREATE TYPE' } @privileges;
-
-sql_do_ok( $dbh, qq{ CREATE OR REPLACE TYPE $super_type AS OBJECT (
- num INTEGER,
- name VARCHAR2(20)
- ) NOT FINAL } );
-
-sql_do_ok( $dbh, qq{ CREATE OR REPLACE TYPE $sub_type UNDER $super_type (
- datetime DATE,
- amount NUMERIC(10,5)
- ) NOT FINAL } );
-
-sql_do_ok( $dbh, qq{ CREATE TABLE $table (id INTEGER, obj $super_type) });
-
-sql_do_ok( $dbh, qq{ INSERT INTO $table VALUES (1, $super_type(13, 'obj1')) });
-
-sql_do_ok( $dbh, qq{ INSERT INTO $table VALUES (2, $sub_type(NULL, 'obj2',
- TO_DATE('2004-11-30 14:27:18', 'YYYY-MM-DD HH24:MI:SS'),
- 12345.6789)) }
- );
-
-sql_do_ok( $dbh, qq{ INSERT INTO $table VALUES (3, $sub_type(5, 'obj3', NULL,
- 777.666)) } );
-
-sql_do_ok( $dbh, qq{ CREATE OR REPLACE TYPE $inner_type AS OBJECT (
- num INTEGER,
- name VARCHAR2(20)
- ) FINAL });
-
-sql_do_ok( $dbh, qq{ CREATE OR REPLACE TYPE $outer_type AS OBJECT (
- num INTEGER,
- obj $inner_type
- ) FINAL });
-
-sql_do_ok( $dbh, qq{ CREATE OR REPLACE TYPE $list_type AS
- TABLE OF $inner_type });
-
-sql_do_ok( $dbh, qq{ CREATE TABLE $nest_table(obj $outer_type) });
-
-sql_do_ok( $dbh, qq{ INSERT INTO $nest_table VALUES($outer_type(91, $inner_type(1, 'one'))) }
- );
-
-sql_do_ok( $dbh, qq{ INSERT INTO $nest_table VALUES($outer_type(92, $inner_type(0, null))) }
- );
-
-sql_do_ok( $dbh, qq{ INSERT INTO $nest_table VALUES($outer_type(93, null)) }
-);
-
-sql_do_ok( $dbh, qq{ CREATE TABLE $list_table ( id INTEGER, list $list_type )
- NESTED TABLE list STORE AS ${list_table}_list });
-
-sql_do_ok( $dbh, qq{ INSERT INTO $list_table VALUES(81,$list_type($inner_type(null, 'listed'))) } );
-# Test old (backward compatible) interface
-
-# test select testing objects
-my $sth = $dbh->prepare("select * from $table order by id");
-ok ($sth, 'old: Prepare select');
-ok ($sth->execute(), 'old: Execute select');
-
-my @row1 = $sth->fetchrow();
-ok (scalar @row1, 'old: Fetch first row');
-cmp_ok(ref $row1[1], 'eq', 'ARRAY', 'old: Row 1 column 2 is an ARRAY');
-cmp_ok(scalar(@{$row1[1]}), '==', 2, 'old: Row 1 column 2 is has 2 elements');
-
-my @row2 = $sth->fetchrow();
-ok (scalar @row2, 'old: Fetch second row');
-cmp_ok(ref $row2[1], 'eq', 'ARRAY', 'old: Row 2 column 2 is an ARRAY');
-cmp_ok(scalar(@{$row2[1]}), '==', 2, 'old: Row 2 column 2 is has 2 elements');
-
-my @row3 = $sth->fetchrow();
-ok (scalar @row3, 'old: Fetch third row');
-cmp_ok(ref $row3[1], 'eq', 'ARRAY', 'old: Row 3 column 2 is an ARRAY');
-cmp_ok(scalar(@{$row3[1]}), '==', 2, 'old: Row 3 column 2 is has 2 elements');
-
-ok (!$sth->fetchrow(), 'old: No more rows expected');
-
-#print STDERR Dumper(\@row1, \@row2, \@row3);
-
-# Test new (extended) object interface
-
-# enable extended object support
-$dbh->{ora_objects} = 1;
-
-# test select testing objects - in extended mode
-$sth = $dbh->prepare("select * from $table order by id");
-ok ($sth, 'new: Prepare select');
-ok ($sth->execute(), 'new: Execute select');
-
-
-@row1 = $sth->fetchrow();
-ok (scalar @row1, 'new: Fetch first row');
-cmp_ok(ref $row1[1], 'eq', 'DBD::Oracle::Object', 'new: Row 1 column 2 is an DBD:Oracle::Object');
-cmp_ok(uc $row1[1]->type_name, "eq", uc "$schema.$super_type", "new: Row 1 column 2 object type");
-is_deeply([$row1[1]->attributes], ['NUM', 13, 'NAME', 'obj1'], "new: Row 1 column 2 object attributes");
-
-@row2 = $sth->fetchrow();
-ok (scalar @row2, 'new: Fetch second row');
-cmp_ok(ref $row2[1], 'eq', 'DBD::Oracle::Object', 'new: Row 2 column 2 is an DBD::Oracle::Object');
-cmp_ok(uc $row2[1]->type_name, "eq", uc "$schema.$sub_type", "new: Row 2 column 2 object type");
-
-my %attrs = $row2[1]->attributes;
-
-$attrs{AMOUNT} = sprintf "%9.4f", $attrs{AMOUNT};
-
-is_deeply( \%attrs, {'NUM', undef, 'NAME', 'obj2',
- 'DATETIME', '2004-11-30T14:27:18', 'AMOUNT', '12345.6789'}, "new: Row 1 column 2 object attributes");
-
-@row3 = $sth->fetchrow();
-ok (scalar @row3, 'new: Fetch third row');
-cmp_ok(ref $row3[1], 'eq', 'DBD::Oracle::Object', 'new: Row 3 column 2 is an DBD::Oracle::Object');
-cmp_ok(uc $row3[1]->type_name, "eq", uc "$schema.$sub_type", "new: Row 3 column 2 object type");
-
-%attrs = $row3[1]->attributes;
-$attrs{AMOUNT} = sprintf "%6.3f", $attrs{AMOUNT};
-
-is_deeply( \%attrs, {'NUM', 5, 'NAME', 'obj3',
- 'DATETIME', undef, 'AMOUNT', '777.666'}, "new: Row 1 column 2 object attributes");
-
-ok (!$sth->fetchrow(), 'new: No more rows expected');
-
-#print STDERR Dumper(\@row1, \@row2, \@row3);
-
-# Test DBD::Oracle::Object
-my $obj = $row3[1];
-my $expected_hash = {
- NUM => 5,
- NAME => 'obj3',
- DATETIME => undef,
- AMOUNT => 777.666,
- };
-my $attrs = $obj->attr_hash;
-$attrs->{AMOUNT} = sprintf "%6.3f", $attrs->{AMOUNT};
-
-is_deeply($attrs, $expected_hash, 'DBD::Oracle::Object->attr_hash');
-is_deeply($obj->attr, $expected_hash, 'DBD::Oracle::Object->attr');
-is($obj->attr("NAME"), 'obj3', 'DBD::Oracle::Object->attr("NAME")');
-
-# try the list table
-$sth = $dbh->prepare("select * from $list_table");
-ok ($sth, 'new: Prepare select with nested table of objects');
-ok ($sth->execute(), 'new: Execute (nested table)');
-
-@row1 = $sth->fetchrow();
-ok (scalar @row1, 'new: Fetch first row (nested table)');
-is_deeply($row1[1]->[0]->attr, {NUM=>undef, NAME=>'listed'},
- 'Check propertes of first (and only) item in nested table');
-
-ok (!$sth->fetchrow(), 'new: No more rows expected (nested table)');
-
-#try the nested table
-$sth = $dbh->prepare("select * from $nest_table");
-ok ($sth, 'new: Prepare select with nested object');
-ok ($sth->execute(), 'new: Execute (nested object)');
-
-@row1 = $sth->fetchrow();
-ok (scalar @row1, 'new: Fetch first row (nested object)');
-is($row1[0]->attr->{NUM}, '91', 'Check obj.num');
-is_deeply($row1[0]->attr->{OBJ}->attr, {NUM=>'1', NAME=>'one'}, 'Check obj.obj');
-
-@row2 = $sth->fetchrow();
-ok (scalar @row2, 'new: Fetch second row (nested object)');
-is($row2[0]->attr->{NUM}, '92', 'Check obj.num');
-is_deeply($row2[0]->attr->{OBJ}->attr, {NUM=>'0', NAME=>undef}, 'Check obj.obj');
-
-@row3 = $sth->fetchrow();
-ok (scalar @row3, 'new: Fetch third row (nested object)');
-is_deeply($row3[0]->attr, {NUM=>'93', OBJ=>undef}, 'Check obj');
-
-ok (!$sth->fetchrow(), 'new: No more rows expected (nested object)');
-
-}
-
-#cleanup
-&drop_test_objects;
-$dbh->disconnect;
-
-1;
-
-
-sub sql_do_ok {
- my ( $dbh, $sql, $title ) = @_;
- $title = $sql unless defined $title;
- ok( $dbh->do( $sql ), $title ) or diag $dbh->errstr;
-}
-
+#!perl -w
+
+use DBI;
+use DBD::Oracle qw(ORA_RSET SQLCS_NCHAR);
+use strict;
+use Data::Dumper;
+
+use Test::More;
+unshift @INC ,'t';
+require 'nchar_test_lib.pl';
+
+$| = 1;
+
+$ENV{NLS_DATE_FORMAT} = 'YYYY-MM-DD"T"HH24:MI:SS';
+
+# create a database handle
+my $dsn = oracle_test_dsn();
+my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger';
+my $dbh;
+eval {$dbh = DBI->connect($dsn, $dbuser, '',{ RaiseError=>1,
+ AutoCommit=>1,
+ PrintError => 0,
+ ora_objects => 1 })};
+
+plan skip_all => "Unable to connect to Oracle" unless $dbh;
+
+plan tests => 65;
+
+my ($schema) = $dbuser =~ m{^([^/]*)};
+
+# Test ora_objects flag
+is $dbh->{ora_objects} => 1, 'ora_objects flag is set to 1';
+
+$dbh->{ora_objects} = 0;
+is $dbh->{ora_objects} => 0, 'ora_objects flag is set to 0';
+
+# check that our db handle is good
+isa_ok($dbh, "DBI::db");
+
+
+ok( $schema = $dbh->selectrow_array(
+ "select sys_context('userenv', 'current_schema') from dual"
+), 'Fetch current schema name');
+
+
+my $obj_prefix = "dbd_test_";
+my $super_type = "${obj_prefix}_type_A";
+my $sub_type = "${obj_prefix}_type_B";
+my $table = "${obj_prefix}_obj_table";
+my $outer_type = "${obj_prefix}_outer_type";
+my $inner_type = "${obj_prefix}_inner_type";
+my $list_type = "${obj_prefix}_list_type";
+my $nest_table = "${obj_prefix}_nest_table";
+my $list_table = "${obj_prefix}_list_table";
+
+sub drop_test_objects {
+ for my $obj ("TABLE $list_table", "TABLE $nest_table",
+ "TYPE $list_type", "TYPE $outer_type", "TYPE $inner_type",
+ "TABLE $table", "TYPE $sub_type", "TYPE $super_type") {
+ #do not warn if already there
+ eval {
+ local $dbh->{PrintError} = 0;
+ $dbh->do(qq{drop $obj});
+ };
+ }
+}
+
+&drop_test_objects;
+
+# get the user's privileges
+my $privs_sth = $dbh->prepare( 'SELECT PRIVILEGE from session_privs' );
+$privs_sth->execute;
+my @privileges = map { $_->[0] } @{ $privs_sth->fetchall_arrayref };
+
+
+SKIP: {
+ skip q{don't have permission to create type} => 61
+ unless grep { $_ eq 'CREATE TYPE' } @privileges;
+
+sql_do_ok( $dbh, qq{ CREATE OR REPLACE TYPE $super_type AS OBJECT (
+ num INTEGER,
+ name VARCHAR2(20)
+ ) NOT FINAL } );
+
+sql_do_ok( $dbh, qq{ CREATE OR REPLACE TYPE $sub_type UNDER $super_type (
+ datetime DATE,
+ amount NUMERIC(10,5)
+ ) NOT FINAL } );
+
+sql_do_ok( $dbh, qq{ CREATE TABLE $table (id INTEGER, obj $super_type) });
+
+sql_do_ok( $dbh, qq{ INSERT INTO $table VALUES (1, $super_type(13, 'obj1')) });
+
+sql_do_ok( $dbh, qq{ INSERT INTO $table VALUES (2, $sub_type(NULL, 'obj2',
+ TO_DATE('2004-11-30 14:27:18', 'YYYY-MM-DD HH24:MI:SS'),
+ 12345.6789)) }
+ );
+
+sql_do_ok( $dbh, qq{ INSERT INTO $table VALUES (3, $sub_type(5, 'obj3', NULL,
+ 777.666)) } );
+
+sql_do_ok( $dbh, qq{ CREATE OR REPLACE TYPE $inner_type AS OBJECT (
+ num INTEGER,
+ name VARCHAR2(20)
+ ) FINAL });
+
+sql_do_ok( $dbh, qq{ CREATE OR REPLACE TYPE $outer_type AS OBJECT (
+ num INTEGER,
+ obj $inner_type
+ ) FINAL });
+
+sql_do_ok( $dbh, qq{ CREATE OR REPLACE TYPE $list_type AS
+ TABLE OF $inner_type });
+
+sql_do_ok( $dbh, qq{ CREATE TABLE $nest_table(obj $outer_type) });
+
+sql_do_ok( $dbh, qq{ INSERT INTO $nest_table VALUES($outer_type(91, $inner_type(1, 'one'))) }
+ );
+
+sql_do_ok( $dbh, qq{ INSERT INTO $nest_table VALUES($outer_type(92, $inner_type(0, null))) }
+ );
+
+sql_do_ok( $dbh, qq{ INSERT INTO $nest_table VALUES($outer_type(93, null)) }
+);
+
+sql_do_ok( $dbh, qq{ CREATE TABLE $list_table ( id INTEGER, list $list_type )
+ NESTED TABLE list STORE AS ${list_table}_list });
+
+sql_do_ok( $dbh, qq{ INSERT INTO $list_table VALUES(81,$list_type($inner_type(null, 'listed'))) } );
+# Test old (backward compatible) interface
+
+# test select testing objects
+my $sth = $dbh->prepare("select * from $table order by id");
+ok ($sth, 'old: Prepare select');
+ok ($sth->execute(), 'old: Execute select');
+
+my @row1 = $sth->fetchrow();
+ok (scalar @row1, 'old: Fetch first row');
+cmp_ok(ref $row1[1], 'eq', 'ARRAY', 'old: Row 1 column 2 is an ARRAY');
+cmp_ok(scalar(@{$row1[1]}), '==', 2, 'old: Row 1 column 2 is has 2 elements');
+
+my @row2 = $sth->fetchrow();
+ok (scalar @row2, 'old: Fetch second row');
+cmp_ok(ref $row2[1], 'eq', 'ARRAY', 'old: Row 2 column 2 is an ARRAY');
+cmp_ok(scalar(@{$row2[1]}), '==', 2, 'old: Row 2 column 2 is has 2 elements');
+
+my @row3 = $sth->fetchrow();
+ok (scalar @row3, 'old: Fetch third row');
+cmp_ok(ref $row3[1], 'eq', 'ARRAY', 'old: Row 3 column 2 is an ARRAY');
+cmp_ok(scalar(@{$row3[1]}), '==', 2, 'old: Row 3 column 2 is has 2 elements');
+
+ok (!$sth->fetchrow(), 'old: No more rows expected');
+
+#print STDERR Dumper(\@row1, \@row2, \@row3);
+
+# Test new (extended) object interface
+
+# enable extended object support
+$dbh->{ora_objects} = 1;
+
+# test select testing objects - in extended mode
+$sth = $dbh->prepare("select * from $table order by id");
+ok ($sth, 'new: Prepare select');
+ok ($sth->execute(), 'new: Execute select');
+
+
+@row1 = $sth->fetchrow();
+ok (scalar @row1, 'new: Fetch first row');
+cmp_ok(ref $row1[1], 'eq', 'DBD::Oracle::Object', 'new: Row 1 column 2 is an DBD:Oracle::Object');
+cmp_ok(uc $row1[1]->type_name, "eq", uc "$schema.$super_type", "new: Row 1 column 2 object type");
+is_deeply([$row1[1]->attributes], ['NUM', 13, 'NAME', 'obj1'], "new: Row 1 column 2 object attributes");
+
+@row2 = $sth->fetchrow();
+ok (scalar @row2, 'new: Fetch second row');
+cmp_ok(ref $row2[1], 'eq', 'DBD::Oracle::Object', 'new: Row 2 column 2 is an DBD::Oracle::Object');
+cmp_ok(uc $row2[1]->type_name, "eq", uc "$schema.$sub_type", "new: Row 2 column 2 object type");
+
+my %attrs = $row2[1]->attributes;
+
+$attrs{AMOUNT} = sprintf "%9.4f", $attrs{AMOUNT};
+
+is_deeply( \%attrs, {'NUM', undef, 'NAME', 'obj2',
+ 'DATETIME', '2004-11-30T14:27:18', 'AMOUNT', '12345.6789'}, "new: Row 1 column 2 object attributes");
+
+@row3 = $sth->fetchrow();
+ok (scalar @row3, 'new: Fetch third row');
+cmp_ok(ref $row3[1], 'eq', 'DBD::Oracle::Object', 'new: Row 3 column 2 is an DBD::Oracle::Object');
+cmp_ok(uc $row3[1]->type_name, "eq", uc "$schema.$sub_type", "new: Row 3 column 2 object type");
+
+%attrs = $row3[1]->attributes;
+$attrs{AMOUNT} = sprintf "%6.3f", $attrs{AMOUNT};
+
+is_deeply( \%attrs, {'NUM', 5, 'NAME', 'obj3',
+ 'DATETIME', undef, 'AMOUNT', '777.666'}, "new: Row 1 column 2 object attributes");
+
+ok (!$sth->fetchrow(), 'new: No more rows expected');
+
+#print STDERR Dumper(\@row1, \@row2, \@row3);
+
+# Test DBD::Oracle::Object
+my $obj = $row3[1];
+my $expected_hash = {
+ NUM => 5,
+ NAME => 'obj3',
+ DATETIME => undef,
+ AMOUNT => 777.666,
+ };
+my $attrs = $obj->attr_hash;
+$attrs->{AMOUNT} = sprintf "%6.3f", $attrs->{AMOUNT};
+
+is_deeply($attrs, $expected_hash, 'DBD::Oracle::Object->attr_hash');
+is_deeply($obj->attr, $expected_hash, 'DBD::Oracle::Object->attr');
+is($obj->attr("NAME"), 'obj3', 'DBD::Oracle::Object->attr("NAME")');
+
+# try the list table
+$sth = $dbh->prepare("select * from $list_table");
+ok ($sth, 'new: Prepare select with nested table of objects');
+ok ($sth->execute(), 'new: Execute (nested table)');
+
+@row1 = $sth->fetchrow();
+ok (scalar @row1, 'new: Fetch first row (nested table)');
+is_deeply($row1[1]->[0]->attr, {NUM=>undef, NAME=>'listed'},
+ 'Check propertes of first (and only) item in nested table');
+
+ok (!$sth->fetchrow(), 'new: No more rows expected (nested table)');
+
+#try the nested table
+$sth = $dbh->prepare("select * from $nest_table");
+ok ($sth, 'new: Prepare select with nested object');
+ok ($sth->execute(), 'new: Execute (nested object)');
+
+@row1 = $sth->fetchrow();
+ok (scalar @row1, 'new: Fetch first row (nested object)');
+is($row1[0]->attr->{NUM}, '91', 'Check obj.num');
+is_deeply($row1[0]->attr->{OBJ}->attr, {NUM=>'1', NAME=>'one'}, 'Check obj.obj');
+
+@row2 = $sth->fetchrow();
+ok (scalar @row2, 'new: Fetch second row (nested object)');
+is($row2[0]->attr->{NUM}, '92', 'Check obj.num');
+is_deeply($row2[0]->attr->{OBJ}->attr, {NUM=>'0', NAME=>undef}, 'Check obj.obj');
+
+@row3 = $sth->fetchrow();
+ok (scalar @row3, 'new: Fetch third row (nested object)');
+is_deeply($row3[0]->attr, {NUM=>'93', OBJ=>undef}, 'Check obj');
+
+ok (!$sth->fetchrow(), 'new: No more rows expected (nested object)');
+
+}
+
+#cleanup
+&drop_test_objects;
+$dbh->disconnect;
+
+1;
+
+
+sub sql_do_ok {
+ my ( $dbh, $sql, $title ) = @_;
+ $title = $sql unless defined $title;
+ ok( $dbh->do( $sql ), $title ) or diag $dbh->errstr;
+}
+