1{ 2 package # hide from PAUSE 3 DBICTest::Schema::ArtistFQN; 4 5 use base 'DBIx::Class::Core'; 6 7 __PACKAGE__->table( 8 defined $ENV{DBICTEST_ORA_USER} 9 ? $ENV{DBICTEST_ORA_USER} . '.artist' 10 : 'artist' 11 ); 12 __PACKAGE__->add_columns( 13 'artistid' => { 14 data_type => 'integer', 15 is_auto_increment => 1, 16 }, 17 'name' => { 18 data_type => 'varchar', 19 size => 100, 20 is_nullable => 1, 21 }, 22 ); 23 __PACKAGE__->set_primary_key('artistid'); 24 25 1; 26} 27 28use strict; 29use warnings; 30 31use Test::Exception; 32use Test::More; 33use lib qw(t/lib); 34use DBICTest; 35 36my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_ORA_${_}" } qw/DSN USER PASS/}; 37 38plan skip_all => 'Set $ENV{DBICTEST_ORA_DSN}, _USER and _PASS to run this test. ' . 39 'Warning: This test drops and creates tables called \'artist\', \'cd\', \'track\' and \'sequence_test\''. 40 ' as well as following sequences: \'pkid1_seq\', \'pkid2_seq\' and \'nonpkid_seq\'' 41 unless ($dsn && $user && $pass); 42 43DBICTest::Schema->load_classes('ArtistFQN'); 44my $schema = DBICTest::Schema->connect($dsn, $user, $pass); 45 46my $dbh = $schema->storage->dbh; 47 48eval { 49 $dbh->do("DROP SEQUENCE artist_seq"); 50 $dbh->do("DROP SEQUENCE cd_seq"); 51 $dbh->do("DROP SEQUENCE pkid1_seq"); 52 $dbh->do("DROP SEQUENCE pkid2_seq"); 53 $dbh->do("DROP SEQUENCE nonpkid_seq"); 54 $dbh->do("DROP TABLE artist"); 55 $dbh->do("DROP TABLE sequence_test"); 56 $dbh->do("DROP TABLE track"); 57 $dbh->do("DROP TABLE cd"); 58}; 59$dbh->do("CREATE SEQUENCE artist_seq START WITH 1 MAXVALUE 999999 MINVALUE 0"); 60$dbh->do("CREATE SEQUENCE cd_seq START WITH 1 MAXVALUE 999999 MINVALUE 0"); 61$dbh->do("CREATE SEQUENCE pkid1_seq START WITH 1 MAXVALUE 999999 MINVALUE 0"); 62$dbh->do("CREATE SEQUENCE pkid2_seq START WITH 10 MAXVALUE 999999 MINVALUE 0"); 63$dbh->do("CREATE SEQUENCE nonpkid_seq START WITH 20 MAXVALUE 999999 MINVALUE 0"); 64 65$dbh->do("CREATE TABLE artist (artistid NUMBER(12), name VARCHAR(255), rank NUMBER(38), charfield VARCHAR2(10))"); 66$dbh->do("ALTER TABLE artist ADD (CONSTRAINT artist_pk PRIMARY KEY (artistid))"); 67 68$dbh->do("CREATE TABLE sequence_test (pkid1 NUMBER(12), pkid2 NUMBER(12), nonpkid NUMBER(12), name VARCHAR(255))"); 69$dbh->do("ALTER TABLE sequence_test ADD (CONSTRAINT sequence_test_constraint PRIMARY KEY (pkid1, pkid2))"); 70 71$dbh->do("CREATE TABLE cd (cdid NUMBER(12), artist NUMBER(12), title VARCHAR(255), year VARCHAR(4), genreid NUMBER(12), single_track NUMBER(12))"); 72$dbh->do("ALTER TABLE cd ADD (CONSTRAINT cd_pk PRIMARY KEY (cdid))"); 73 74$dbh->do("CREATE TABLE track (trackid NUMBER(12), cd NUMBER(12) REFERENCES cd(cdid) DEFERRABLE, position NUMBER(12), title VARCHAR(255), last_updated_on DATE, last_updated_at DATE, small_dt DATE)"); 75 76$dbh->do(qq{ 77 CREATE OR REPLACE TRIGGER artist_insert_trg 78 BEFORE INSERT ON artist 79 FOR EACH ROW 80 BEGIN 81 IF :new.artistid IS NULL THEN 82 SELECT artist_seq.nextval 83 INTO :new.artistid 84 FROM DUAL; 85 END IF; 86 END; 87}); 88$dbh->do(qq{ 89 CREATE OR REPLACE TRIGGER cd_insert_trg 90 BEFORE INSERT ON cd 91 FOR EACH ROW 92 BEGIN 93 IF :new.cdid IS NULL THEN 94 SELECT cd_seq.nextval 95 INTO :new.cdid 96 FROM DUAL; 97 END IF; 98 END; 99}); 100 101{ 102 # Swiped from t/bindtype_columns.t to avoid creating my own Resultset. 103 104 local $SIG{__WARN__} = sub {}; 105 eval { $dbh->do('DROP TABLE bindtype_test') }; 106 107 $dbh->do(qq[ 108 CREATE TABLE bindtype_test 109 ( 110 id integer NOT NULL PRIMARY KEY, 111 bytea integer NULL, 112 blob blob NULL, 113 clob clob NULL 114 ) 115 ],{ RaiseError => 1, PrintError => 1 }); 116} 117 118# This is in Core now, but it's here just to test that it doesn't break 119$schema->class('Artist')->load_components('PK::Auto'); 120# These are compat shims for PK::Auto... 121$schema->class('CD')->load_components('PK::Auto::Oracle'); 122$schema->class('Track')->load_components('PK::Auto::Oracle'); 123 124# test primary key handling 125my $new = $schema->resultset('Artist')->create({ name => 'foo' }); 126is($new->artistid, 1, "Oracle Auto-PK worked"); 127 128my $cd = $schema->resultset('CD')->create({ artist => 1, title => 'EP C', year => '2003' }); 129is($cd->cdid, 1, "Oracle Auto-PK worked - using scalar ref as table name"); 130 131# test again with fully-qualified table name 132$new = $schema->resultset('ArtistFQN')->create( { name => 'bar' } ); 133is( $new->artistid, 2, "Oracle Auto-PK worked with fully-qualified tablename" ); 134 135# test rel names over the 30 char limit 136my $query = $schema->resultset('Artist')->search({ 137 artistid => 1 138}, { 139 prefetch => 'cds_very_very_very_long_relationship_name' 140}); 141 142lives_and { 143 is $query->first->cds_very_very_very_long_relationship_name->first->cdid, 1 144} 'query with rel name over 30 chars survived and worked'; 145 146# rel name over 30 char limit with user condition 147# This requires walking the SQLA data structure. 148{ 149 local $TODO = 'user condition on rel longer than 30 chars'; 150 151 $query = $schema->resultset('Artist')->search({ 152 'cds_very_very_very_long_relationship_name.title' => 'EP C' 153 }, { 154 prefetch => 'cds_very_very_very_long_relationship_name' 155 }); 156 157 lives_and { 158 is $query->first->cds_very_very_very_long_relationship_name->first->cdid, 1 159 } 'query with rel name over 30 chars and user condition survived and worked'; 160} 161 162# test join with row count ambiguity 163 164my $track = $schema->resultset('Track')->create({ trackid => 1, cd => 1, 165 position => 1, title => 'Track1' }); 166my $tjoin = $schema->resultset('Track')->search({ 'me.title' => 'Track1'}, 167 { join => 'cd', 168 rows => 2 } 169); 170 171ok(my $row = $tjoin->next); 172 173is($row->title, 'Track1', "ambiguous column ok"); 174 175# check count distinct with multiple columns 176my $other_track = $schema->resultset('Track')->create({ trackid => 2, cd => 1, position => 1, title => 'Track2' }); 177 178my $tcount = $schema->resultset('Track')->search( 179 {}, 180 { 181 select => [ qw/position title/ ], 182 distinct => 1, 183 } 184); 185is($tcount->count, 2, 'multiple column COUNT DISTINCT ok'); 186 187$tcount = $schema->resultset('Track')->search( 188 {}, 189 { 190 columns => [ qw/position title/ ], 191 distinct => 1, 192 } 193); 194is($tcount->count, 2, 'multiple column COUNT DISTINCT ok'); 195 196$tcount = $schema->resultset('Track')->search( 197 {}, 198 { 199 group_by => [ qw/position title/ ] 200 } 201); 202is($tcount->count, 2, 'multiple column COUNT DISTINCT using column syntax ok'); 203 204# test LIMIT support 205for (1..6) { 206 $schema->resultset('Artist')->create({ name => 'Artist ' . $_ }); 207} 208my $it = $schema->resultset('Artist')->search( {}, 209 { rows => 3, 210 offset => 3, 211 order_by => 'artistid' } 212); 213is( $it->count, 3, "LIMIT count ok" ); 214is( $it->next->name, "Artist 2", "iterator->next ok" ); 215$it->next; 216$it->next; 217is( $it->next, undef, "next past end of resultset ok" ); 218 219{ 220 my $rs = $schema->resultset('Track')->search( undef, { columns=>[qw/trackid position/], group_by=> [ qw/trackid position/ ] , rows => 2, offset=>1 }); 221 my @results = $rs->all; 222 is( scalar @results, 1, "Group by with limit OK" ); 223} 224 225# test with_deferred_fk_checks 226lives_ok { 227 $schema->storage->with_deferred_fk_checks(sub { 228 $schema->resultset('Track')->create({ 229 trackid => 999, cd => 999, position => 1, title => 'deferred FK track' 230 }); 231 $schema->resultset('CD')->create({ 232 artist => 1, cdid => 999, year => '2003', title => 'deferred FK cd' 233 }); 234 }); 235} 'with_deferred_fk_checks code survived'; 236 237is eval { $schema->resultset('Track')->find(999)->title }, 'deferred FK track', 238 'code in with_deferred_fk_checks worked'; 239 240throws_ok { 241 $schema->resultset('Track')->create({ 242 trackid => 1, cd => 9999, position => 1, title => 'Track1' 243 }); 244} qr/constraint/i, 'with_deferred_fk_checks is off'; 245 246# test auto increment using sequences WITHOUT triggers 247for (1..5) { 248 my $st = $schema->resultset('SequenceTest')->create({ name => 'foo' }); 249 is($st->pkid1, $_, "Oracle Auto-PK without trigger: First primary key"); 250 is($st->pkid2, $_ + 9, "Oracle Auto-PK without trigger: Second primary key"); 251 is($st->nonpkid, $_ + 19, "Oracle Auto-PK without trigger: Non-primary key"); 252} 253my $st = $schema->resultset('SequenceTest')->create({ name => 'foo', pkid1 => 55 }); 254is($st->pkid1, 55, "Oracle Auto-PK without trigger: First primary key set manually"); 255 256SKIP: { 257 my %binstr = ( 'small' => join('', map { chr($_) } ( 1 .. 127 )) ); 258 $binstr{'large'} = $binstr{'small'} x 1024; 259 260 my $maxloblen = length $binstr{'large'}; 261 note "Localizing LongReadLen to $maxloblen to avoid truncation of test data"; 262 local $dbh->{'LongReadLen'} = $maxloblen; 263 264 my $rs = $schema->resultset('BindType'); 265 my $id = 0; 266 267 if ($DBD::Oracle::VERSION eq '1.23') { 268 throws_ok { $rs->create({ id => 1, blob => $binstr{large} }) } 269 qr/broken/, 270 'throws on blob insert with DBD::Oracle == 1.23'; 271 272 skip 'buggy BLOB support in DBD::Oracle 1.23', 7; 273 } 274 275 foreach my $type (qw( blob clob )) { 276 foreach my $size (qw( small large )) { 277 $id++; 278 279 lives_ok { $rs->create( { 'id' => $id, $type => $binstr{$size} } ) } 280 "inserted $size $type without dying"; 281 282 ok($rs->find($id)->$type eq $binstr{$size}, "verified inserted $size $type" ); 283 } 284 } 285} 286 287done_testing; 288 289# clean up our mess 290END { 291 if($schema && ($dbh = $schema->storage->dbh)) { 292 $dbh->do("DROP SEQUENCE artist_seq"); 293 $dbh->do("DROP SEQUENCE cd_seq"); 294 $dbh->do("DROP SEQUENCE pkid1_seq"); 295 $dbh->do("DROP SEQUENCE pkid2_seq"); 296 $dbh->do("DROP SEQUENCE nonpkid_seq"); 297 $dbh->do("DROP TABLE artist"); 298 $dbh->do("DROP TABLE sequence_test"); 299 $dbh->do("DROP TABLE track"); 300 $dbh->do("DROP TABLE cd"); 301 $dbh->do("DROP TABLE bindtype_test"); 302 } 303} 304 305