[svn:dbd-oracle] r14892 - dbd-oracle/trunk/t

[email protected] Sat, 2 Jul 2011 15:05:25 -0700 (PDT)
Newsgroups perl.dbd.oracle.changes
Message-ID <[email protected]>
Author: yanick
Date: Sat Jul  2 15:05:23 2011
New Revision: 14892

Modified:
   dbd-oracle/trunk/t/58object.t

Log:
skip tests if not the right permission (instead of dying)

Modified: dbd-oracle/trunk/t/58object.t
==============================================================================
--- dbd-oracle/trunk/t/58object.t	(original)
+++ dbd-oracle/trunk/t/58object.t	Sat Jul  2 15:05:23 2011
@@ -21,18 +21,18 @@
 					AutoCommit=>1,
 					PrintError => 0,
 					 ora_objects => 1 })};
-if ($dbh) {
-    plan tests => 50;
-} else {
-    plan skip_all => "Unable to connect to Oracle";
-}
+
+plan skip_all => "Unable to connect to Oracle" unless $dbh;
+
+plan tests => 65;
+
 my ($schema) = $dbuser =~ m{^([^/]*)};
 
 # Test ora_objects flag 
-cmp_ok($dbh->{ora_objects}, 'eq', '1', 'ora_objects flag is set to 1');
+is $dbh->{ora_objects} => 1, 'ora_objects flag is set to 1';
 
 $dbh->{ora_objects} = 0;
-cmp_ok($dbh->{ora_objects}, 'eq', '0', 'ora_objects flag is set to 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");
@@ -67,50 +67,66 @@
 
 &drop_test_objects;
 
-$dbh->do(qq{ CREATE OR REPLACE TYPE $super_type AS OBJECT (
+# 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 }) or die $dbh->errstr;
+            ) NOT FINAL } );
 
-$dbh->do(qq{ CREATE OR REPLACE TYPE $sub_type UNDER $super_type (
+sql_do_ok( $dbh, qq{ CREATE OR REPLACE TYPE $sub_type UNDER $super_type (
                 datetime  DATE,
                 amount    NUMERIC(10,5)
-            ) NOT FINAL }) or die $dbh->errstr;
-$dbh->do(qq{ CREATE TABLE $table (id INTEGER, obj $super_type) })
-            or die $dbh->errstr;
-$dbh->do(qq{ INSERT INTO $table VALUES (1, $super_type(13, 'obj1')) })
-            or die $dbh->errstr;
-$dbh->do(qq{ INSERT INTO $table VALUES (2, $sub_type(NULL, 'obj2', 
+            ) 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)) }
-            ) or die $dbh->errstr;
-$dbh->do(qq{ INSERT INTO $table VALUES (3, $sub_type(5, 'obj3', NULL, 777.666)) }
-            ) or die $dbh->errstr;
+            );
+
+sql_do_ok( $dbh, qq{ INSERT INTO $table VALUES (3, $sub_type(5, 'obj3', NULL,
+    777.666)) } );
 
-$dbh->do(qq{ CREATE OR REPLACE TYPE $inner_type AS OBJECT (
+sql_do_ok( $dbh, qq{ CREATE OR REPLACE TYPE $inner_type AS OBJECT (
                 num     INTEGER,
                 name    VARCHAR2(20)
-            ) FINAL }) or die $dbh->errstr;
-$dbh->do(qq{ CREATE OR REPLACE TYPE $outer_type AS OBJECT (
+            ) FINAL });
+
+sql_do_ok( $dbh, qq{ CREATE OR REPLACE TYPE $outer_type AS OBJECT (
                 num     INTEGER,
                 obj     $inner_type
-            ) FINAL }) or die $dbh->errstr;
-$dbh->do(qq{ CREATE OR REPLACE TYPE $list_type AS
-                            TABLE OF $inner_type }) or die $dbh->errstr;
-$dbh->do(qq{ CREATE TABLE $nest_table(obj $outer_type) }) or die $dbh->errstr;
-$dbh->do(qq{ INSERT INTO $nest_table VALUES($outer_type(91, $inner_type(1, 'one'))) }
-            ) or die $dbh->errstr;
-$dbh->do(qq{ INSERT INTO $nest_table VALUES($outer_type(92, $inner_type(0, null))) }
-            ) or die $dbh->errstr;
-$dbh->do(qq{ INSERT INTO $nest_table VALUES($outer_type(93, null)) }
-            ) or die $dbh->errstr;
-
-$dbh->do(qq{ CREATE TABLE $list_table ( id INTEGER, list $list_type )
-               NESTED TABLE list STORE AS ${list_table}_list }) or die $dbh->errstr;
-$dbh->do(qq{ INSERT INTO $list_table VALUES(81,$list_type($inner_type(null, 'listed'))) }
-            ) or die $dbh->errstr;
+            ) 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 
@@ -217,11 +233,18 @@
 
 ok (!$sth->fetchrow(), 'new: No more rows expected (nested object)');
 
-#print STDERR Dumper(\@row1, \@row2, \@row3);
-
+}
 
 #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;
+}
+