Populate caches for related result sets even if they're empty
[dbsrgits/DBIx-Class.git] / t / 73oracle.t
1 use strict;
2 use warnings;
3
4 use Test::Exception;
5 use Test::More;
6 use Sub::Name;
7 use Try::Tiny;
8 use DBIx::Class::Optional::Dependencies ();
9
10 use lib qw(t/lib);
11 use DBICTest;
12
13 my ($dsn,  $user,  $pass)  = @ENV{map { "DBICTEST_ORA_${_}" }  qw/DSN USER PASS/};
14
15 # optional:
16 my ($dsn2, $user2, $pass2) = @ENV{map { "DBICTEST_ORA_EXTRAUSER_${_}" } qw/DSN USER PASS/};
17
18 plan skip_all => 'Set $ENV{DBICTEST_ORA_DSN}, _USER and _PASS to run this test.'
19   unless ($dsn && $user && $pass);
20
21 plan skip_all => 'Test needs ' . DBIx::Class::Optional::Dependencies->req_missing_for ('test_rdbms_oracle')
22   unless DBIx::Class::Optional::Dependencies->req_ok_for ('test_rdbms_oracle');
23
24 $ENV{NLS_SORT} = "BINARY";
25 $ENV{NLS_COMP} = "BINARY";
26 $ENV{NLS_LANG} = "AMERICAN";
27
28 {
29   package    # hide from PAUSE
30     DBICTest::Schema::ArtistFQN;
31
32   use base 'DBIx::Class::Core';
33
34   __PACKAGE__->table(
35     $ENV{DBICTEST_ORA_USER}
36       ? (uc $ENV{DBICTEST_ORA_USER}) . '.artist'
37       : '??_no_user_??'
38   );
39   __PACKAGE__->add_columns(
40     'artistid' => {
41       data_type         => 'integer',
42       is_auto_increment => 1,
43     },
44     'name' => {
45       data_type   => 'varchar',
46       size        => 100,
47       is_nullable => 1,
48     },
49     'autoinc_col' => {
50       data_type         => 'integer',
51       is_auto_increment => 1,
52     },
53     'default_value_col' => {
54       data_type           => 'varchar',
55       size                => 100,
56       is_nullable         => 0,
57       retrieve_on_insert  => 1,
58     }
59   );
60   __PACKAGE__->set_primary_key(qw/ artistid autoinc_col /);
61
62   1;
63 }
64
65 DBICTest::Schema->load_classes('ArtistFQN');
66
67 # This is in Core now, but it's here just to test that it doesn't break
68 DBICTest::Schema::Artist->load_components('PK::Auto');
69 # These are compat shims for PK::Auto...
70 DBICTest::Schema::CD->load_components('PK::Auto::Oracle');
71 DBICTest::Schema::Track->load_components('PK::Auto::Oracle');
72
73
74 # check if we indeed do support stuff
75 my $v = do {
76   my $si = DBICTest::Schema->connect($dsn, $user, $pass)->storage->_server_info;
77   $si->{normalized_dbms_version}
78     or die "Unparseable Oracle server version: $si->{dbms_version}\n";
79 };
80
81 my $test_server_supports_only_orajoins = $v < 9;
82
83 # TODO find out which version supports the RETURNING syntax
84 # 8i (8.1) has it and earlier docs are a 404 on oracle.com
85 my $test_server_supports_insert_returning = $v >= 8.001;
86
87 is (
88   DBICTest::Schema->connect($dsn, $user, $pass)->storage->_use_insert_returning,
89   $test_server_supports_insert_returning,
90   'insert returning capability guessed correctly'
91 );
92
93 isa_ok (DBICTest::Schema->connect($dsn, $user, $pass)->storage->sql_maker, 'DBIx::Class::SQLMaker::Oracle');
94
95 # see if determining a driver with bad credentials throws propely
96 throws_ok {
97   DBICTest::Schema->connect($dsn, "BORKED BORKED USER $user", $pass)->storage->sql_maker;
98 } qr/DBI Connection failed/;
99
100 ##########
101 # the recyclebin (new for 10g) sometimes comes in the way
102 my $on_connect_sql = $v >= 10 ? ["ALTER SESSION SET recyclebin = OFF"] : [];
103
104 # iterate all tests on following options
105 my @tryopt = (
106   { on_connect_do => $on_connect_sql },
107   { quote_char => '"', on_connect_do => $on_connect_sql },
108 );
109
110 # keep a database handle open for cleanup
111 my ($dbh, $dbh2);
112
113 my $schema;
114 for my $use_insert_returning ($test_server_supports_insert_returning ? (1,0) : (0) ) {
115   for my $force_ora_joins ($test_server_supports_only_orajoins ? (0) : (0,1) ) {
116
117     no warnings qw/once redefine/;
118     my $old_connection = DBICTest::Schema->can('connection');
119     local *DBICTest::Schema::connection = subname 'DBICTest::Schema::connection' => sub {
120       my $s = shift->$old_connection (@_);
121       $s->storage->_use_insert_returning ($use_insert_returning);
122       $s->storage->sql_maker_class('DBIx::Class::SQLMaker::OracleJoins') if $force_ora_joins;
123       $s;
124     };
125
126     for my $opt (@tryopt) {
127       # clean all cached sequences from previous run
128       for (map { values %{DBICTest::Schema->source($_)->columns_info} } (qw/Artist CD Track/) ) {
129         delete $_->{sequence};
130       }
131
132       my $schema = DBICTest::Schema->connect($dsn, $user, $pass, $opt);
133
134       $dbh = $schema->storage->dbh;
135       my $q = $schema->storage->sql_maker->quote_char || '';
136
137       do_creates($dbh, $q);
138
139       _run_tests($schema, $opt);
140     }
141   }
142 }
143
144 sub _run_tests {
145   my ($schema, $opt) = @_;
146
147   my $q = $schema->storage->sql_maker->quote_char || '';
148
149 # test primary key handling with multiple triggers
150   my ($new, $seq);
151
152   my $new_artist = $schema->resultset('Artist')->create({ name => 'foo' });
153   my $new_cd     = $schema->resultset('CD')->create({ artist => 1, title => 'EP C', year => '2003' });
154
155   SKIP: {
156     skip 'not detecting sequences when using INSERT ... RETURNING', 4
157       if $schema->storage->_use_insert_returning;
158
159     is($new_artist->artistid, 1, "Oracle Auto-PK worked for standard sqlt-like trigger");
160     $seq = $new_artist->result_source->column_info('artistid')->{sequence};
161     $seq = $$seq if ref $seq;
162     like ($seq, qr/\.${q}artist_pk_seq${q}$/, 'Correct PK sequence selected for sqlt-like trigger');
163
164     is($new_cd->cdid, 1, 'Oracle Auto-PK worked - using scalar ref as table name/custom weird trigger');
165     $seq = $new_cd->result_source->column_info('cdid')->{sequence};
166     $seq = $$seq if ref $seq;
167     like ($seq, qr/\.${q}cd_seq${q}$/, 'Correct PK sequence selected for custom trigger');
168   }
169
170 # test PKs again with fully-qualified table name
171   my $artistfqn_rs = $schema->resultset('ArtistFQN');
172   my $artist_rsrc = $artistfqn_rs->result_source;
173
174   delete $artist_rsrc->column_info('artistid')->{sequence};
175   $new = $artistfqn_rs->create( { name => 'bar' } );
176
177   is_deeply( {map { $_ => $new->$_ } $artist_rsrc->primary_columns},
178     { artistid => 2, autoinc_col => 2},
179     "Oracle Multi-Auto-PK worked with fully-qualified tablename" );
180
181
182   delete $artist_rsrc->column_info('artistid')->{sequence};
183   $new = $artistfqn_rs->create( { name => 'bar', autoinc_col => 1000 } );
184
185   is( $new->artistid, 3, "Oracle Auto-PK worked with fully-qualified tablename" );
186   is( $new->autoinc_col, 1000, "Oracle Auto-Inc overruled with fully-qualified tablename");
187
188
189   is( $new->default_value_col, 'default_value', $schema->storage->_use_insert_returning
190     ? 'Check retrieve_on_insert on default_value_col with INSERT ... RETURNING'
191     : 'Check retrieve_on_insert on default_value_col without INSERT ... RETURNING'
192   );
193
194   SKIP: {
195     skip 'not detecting sequences when using INSERT ... RETURNING', 1
196       if $schema->storage->_use_insert_returning;
197
198     $seq = $new->result_source->column_info('artistid')->{sequence};
199     $seq = $$seq if ref $seq;
200     like ($seq, qr/\.${q}artist_pk_seq${q}$/, 'Correct PK sequence selected for sqlt-like trigger');
201   }
202
203
204 # test LIMIT support
205   for (1..6) {
206     $schema->resultset('Artist')->create({ name => 'Artist ' . $_ });
207   }
208   my $it = $schema->resultset('Artist')->search( { name => { -like => 'Artist %' } }, {
209     rows => 3,
210     offset => 4,
211     order_by => 'artistid'
212   });
213
214   is( $it->count, 2, "LIMIT count past end of RS ok" );
215   is( $it->next->name, "Artist 5", "iterator->next ok" );
216   is( $it->next->name, "Artist 6", "iterator->next ok" );
217   is( $it->next, undef, "next past end of resultset ok" );
218
219 # test identifiers over the 30 char limit
220   lives_ok {
221     my @results = $schema->resultset('CD')->search(undef, {
222       prefetch => 'very_long_artist_relationship',
223       rows => 3,
224       offset => 0,
225     })->all;
226     ok( scalar @results > 0, 'limit with long identifiers returned something');
227   } 'limit with long identifiers executed successfully';
228
229
230 # test rel names over the 30 char limit
231   my $query = $schema->resultset('Artist')->search({
232     artistid => 1
233   }, {
234     prefetch => 'cds_very_very_very_long_relationship_name'
235   });
236
237   lives_and {
238     is $query->first->cds_very_very_very_long_relationship_name->first->cdid, 1
239   } 'query with rel name over 30 chars survived and worked';
240
241 # test rel names over the 30 char limit using group_by and join
242   {
243     my @group_cols = ( 'me.name' );
244     my $query = $schema->resultset('Artist')->search({
245       artistid => 1
246     }, {
247       select => \@group_cols,
248       as => [map { /^\w+\.(\w+)$/ } @group_cols],
249       join => [qw( cds_very_very_very_long_relationship_name )],
250       group_by => \@group_cols,
251     });
252
253     lives_and {
254       my @got = $query->get_column('name')->all();
255       is_deeply \@got, [$new_artist->name];
256     } 'query with rel name over 30 chars worked on join, group_by for me col';
257
258     lives_and {
259       is $query->count(), 1
260     } 'query with rel name over 30 chars worked on join, group_by, count for me col';
261   }
262   {
263     my @group_cols = ( 'cds_very_very_very_long_relationship_name.title' );
264     my $query = $schema->resultset('Artist')->search({
265       artistid => 1
266     }, {
267       select => \@group_cols,
268       as => [map { /^\w+\.(\w+)$/ } @group_cols],
269       join => [qw( cds_very_very_very_long_relationship_name )],
270       group_by => \@group_cols,
271     });
272
273     lives_and {
274       my @got = $query->get_column('title')->all();
275       is_deeply \@got, [$new_cd->title];
276     } 'query with rel name over 30 chars worked on join, group_by for long rel col';
277
278     lives_and {
279       is $query->count(), 1
280     } 'query with rel name over 30 chars worked on join, group_by, count for long rel col';
281   }
282
283   # rel name over 30 char limit with user condition
284   # This requires walking the SQLA data structure.
285   {
286     $query = $schema->resultset('Artist')->search({
287       'cds_very_very_very_long_relationship_name.title' => 'EP C'
288     }, {
289       prefetch => 'cds_very_very_very_long_relationship_name'
290     });
291
292     lives_and {
293       is $query->first->cds_very_very_very_long_relationship_name->first->cdid, 1
294     } 'query with rel name over 30 chars and user condition survived and worked';
295   }
296
297
298 # test join with row count ambiguity
299   my $cd = $schema->resultset('CD')->next;
300   my $track = $cd->create_related('tracks', { position => 1, title => 'Track1'} );
301   my $tjoin = $schema->resultset('Track')->search({ 'me.title' => 'Track1'}, {
302     join => 'cd', rows => 2
303   });
304
305   ok(my $row = $tjoin->next);
306
307   is($row->title, 'Track1', "ambiguous column ok");
308
309
310
311 # check count distinct with multiple columns
312   my $other_track = $schema->resultset('Track')->create({ cd => $cd->cdid, position => 1, title => 'Track2' });
313
314   my $tcount = $schema->resultset('Track')->search(
315     {},
316     {
317       select => [ qw/position title/ ],
318       distinct => 1,
319     }
320   );
321   is($tcount->count, 2, 'multiple column COUNT DISTINCT ok');
322
323   $tcount = $schema->resultset('Track')->search(
324     {},
325     {
326       columns => [ qw/position title/ ],
327       distinct => 1,
328     }
329   );
330   is($tcount->count, 2, 'multiple column COUNT DISTINCT ok');
331
332   $tcount = $schema->resultset('Track')->search(
333     {},
334     {
335       group_by => [ qw/position title/ ]
336     }
337   );
338   is($tcount->count, 2, 'multiple column COUNT DISTINCT using column syntax ok');
339
340
341 # check group_by
342   my $g_rs = $schema->resultset('Track')->search( undef, { columns=>[qw/trackid position/], group_by=> [ qw/trackid position/ ] , rows => 2, offset => 1 });
343   is( scalar $g_rs->all, 1, "Group by with limit OK" );
344
345
346 # test with_deferred_fk_checks
347   lives_ok {
348     $schema->storage->with_deferred_fk_checks(sub {
349       $schema->resultset('Track')->create({
350         trackid => 999, cd => 999, position => 1, title => 'deferred FK track'
351       });
352       $schema->resultset('CD')->create({
353         artist => 1, cdid => 999, year => '2003', title => 'deferred FK cd'
354       });
355     });
356   } 'with_deferred_fk_checks code survived';
357
358   is eval { $schema->resultset('Track')->find(999)->title }, 'deferred FK track',
359     'code in with_deferred_fk_checks worked';
360
361   throws_ok {
362     $schema->resultset('Track')->create({
363       trackid => 1, cd => 9999, position => 1, title => 'Track1'
364     });
365   } qr/constraint/i, 'with_deferred_fk_checks is off';
366
367
368 # test auto increment using sequences WITHOUT triggers
369   for (1..5) {
370     my $st = $schema->resultset('SequenceTest')->create({ name => 'foo' });
371     is($st->pkid1, $_, "Oracle Auto-PK without trigger: First primary key");
372     is($st->pkid2, $_ + 9, "Oracle Auto-PK without trigger: Second primary key");
373     is($st->nonpkid, $_ + 19, "Oracle Auto-PK without trigger: Non-primary key");
374   }
375   my $st = $schema->resultset('SequenceTest')->create({ name => 'foo', pkid1 => 55 });
376   is($st->pkid1, 55, "Oracle Auto-PK without trigger: First primary key set manually");
377
378
379 # test populate (identity, success and error handling)
380   my $art_rs = $schema->resultset('Artist');
381
382   my $seq_pos = $art_rs->get_column('artistid')->max;
383   ok($seq_pos, 'Starting with something in the artist table');
384
385
386   my $pop_rs = $schema->resultset('Artist')->search(
387     { name => { -like => 'pop_art_%' } },
388     { order_by => 'artistid' }
389   );
390
391   $art_rs->delete;
392   lives_ok {
393     $pop_rs->populate([
394       map { +{ name => "pop_art_$_" } }
395       (1,2,3)
396     ]);
397
398     is_deeply (
399       [ $pop_rs->get_column('artistid')->all ],
400       [ map { $seq_pos + $_ } (1,2,3) ],
401       'Sequence works after empty-table insertion'
402     );
403   } 'Populate without identity does not throw';
404
405   lives_ok {
406     $pop_rs->populate([
407       map { +{ artistid => $_, name => "pop_art_$_" } }
408       (1,2,3)
409     ]);
410
411     is_deeply (
412       [ $pop_rs->get_column('artistid')->all ],
413       [ 1,2,3, map { $seq_pos + $_ } (1,2,3) ],
414       'Explicit id population works'
415     );
416   } 'Populate with identity does not throw';
417
418   throws_ok {
419     $pop_rs->populate([
420       map { +{ artistid => $_, name => "pop_art_$_" } }
421       (200, 1, 300)
422     ]);
423   } qr/unique constraint.+populate slice.+name => "pop_art_1"/s, 'Partially failed populate throws';
424
425   is_deeply (
426     [ $pop_rs->get_column('artistid')->all ],
427     [ 1,2,3, map { $seq_pos + $_ } (1,2,3) ],
428     'Partially failed populate did not alter table contents'
429   );
430
431 # test complex join (exercise orajoins)
432   lives_ok { is_deeply (
433     $schema->resultset('CD')->search(
434       { 'artist.name' => 'pop_art_1', 'me.cdid' => { '!=', 999} },
435       { join => 'artist', prefetch => 'tracks', rows => 4, order_by => 'tracks.trackid' }
436     )->all_hri,
437     [{
438       artist => 1,
439       cdid => 1,
440       genreid => undef,
441       single_track => undef,
442       title => "EP C",
443       tracks => [
444         {
445           cd => 1,
446           last_updated_at => undef,
447           last_updated_on => undef,
448           position => 1,
449           title => "Track1",
450           trackid => 1
451         },
452         {
453           cd => 1,
454           last_updated_at => undef,
455           last_updated_on => undef,
456           position => 1,
457           title => "Track2",
458           trackid => 2
459         },
460       ],
461       year => 2003
462     }],
463     'Correct set of data prefetched',
464   ) } 'complex prefetch ok';
465
466 # test sequence detection from a different schema
467   SKIP: {
468   TODO: {
469     skip ((join '',
470       'Set DBICTEST_ORA_EXTRAUSER_DSN, _USER and _PASS to a *DIFFERENT* Oracle user',
471       ' to run the cross-schema sequence detection test.'),
472     1) unless $dsn2 && $user2 && $user2 ne $user;
473
474     skip 'not detecting cross-schema sequence name when using INSERT ... RETURNING', 1
475       if $schema->storage->_use_insert_returning;
476
477     # Oracle8i Reference Release 2 (8.1.6)
478     #   http://download.oracle.com/docs/cd/A87860_01/doc/server.817/a76961/ch294.htm#993
479     # Oracle Database Reference 10g Release 2 (10.2)
480     #   http://download.oracle.com/docs/cd/B19306_01/server.102/b14237/statviews_2107.htm#sthref1297
481     todo_skip "On Oracle8i all_triggers view is empty, i don't yet know why...", 1
482       if $schema->storage->_server_info->{normalized_dbms_version} < 9;
483
484     my $schema2 = $schema->connect($dsn2, $user2, $pass2, $opt);
485     my $dbh2 = $schema2->storage->dbh;
486
487     # create identically named tables/sequences in the other schema
488     do_creates($dbh2, $q);
489
490     # grant select privileges to the 2nd user
491     $dbh->do("GRANT INSERT ON ${q}artist${q} TO " . uc $user2);
492     $dbh->do("GRANT SELECT ON ${q}artist${q} TO " . uc $user2);
493     $dbh->do("GRANT SELECT ON ${q}artist_pk_seq${q} TO " . uc $user2);
494     $dbh->do("GRANT SELECT ON ${q}artist_autoinc_seq${q} TO " . uc $user2);
495
496     # test with a fully qualified table (user1/schema prepended)
497     my $rs2 = $schema2->resultset('ArtistFQN');
498     delete $rs2->result_source->column_info('artistid')->{sequence};
499
500     lives_and {
501       my $row = $rs2->create({ name => 'From Different Schema' });
502       ok $row->artistid;
503     } 'used autoinc sequence across schemas';
504
505     # now quote the sequence name (do_creates always uses an lc name)
506     my $q_seq = $q
507       ? '"artist_pk_seq"'
508       : '"ARTIST_PK_SEQ"'
509     ;
510     delete $rs2->result_source->column_info('artistid')->{sequence};
511     $dbh->do(qq{
512       CREATE OR REPLACE TRIGGER ${q}artist_insert_trg_pk${q}
513       BEFORE INSERT ON ${q}artist${q}
514       FOR EACH ROW
515       BEGIN
516         IF :new.${q}artistid${q} IS NULL THEN
517           SELECT $q_seq.nextval
518           INTO :new.${q}artistid${q}
519           FROM DUAL;
520         END IF;
521       END;
522     });
523
524
525     lives_and {
526       my $row = $rs2->create({ name => 'From Different Schema With Quoted Sequence' });
527       ok $row->artistid;
528     } 'used quoted autoinc sequence across schemas';
529
530     is_deeply $rs2->result_source->column_info('artistid')->{sequence},
531       \( (uc $user) . ".$q_seq"),
532       'quoted sequence name correctly extracted';
533
534     # try an insert operation on the default user2 artist
535     my $art1 = $schema->resultset('Artist');
536     my $art2 = $schema2->resultset('Artist');
537     my $art1_count = $art1->count || 0;
538     my $art2_count = $art2->count;
539
540     is( $art2_count, 0, 'No artists created yet in second schema' );
541
542     delete $art2->result_source->column_info('artistid')->{sequence};
543     my $new_art = $art2->create({ name => '2nd best' });
544
545     is ($art1->count, $art1_count, 'No new rows in main schema');
546     is ($art2->count, 1, 'One artist create in 2nd schema');
547
548     is( $new_art->artistid, 1, 'Expected first PK' );
549
550     do_clean ($dbh2);
551   }}
552
553 # test driver determination issues that led to the diagnosis/fix in 37b5ab51
554 # observed side-effect when count-is-first on a fresh env-based connect
555   {
556     local $ENV{DBI_DSN};
557     ($ENV{DBI_DSN}, my @user_pass_args) = @{ $schema->storage->connect_info };
558     my $s2 = DBICTest::Schema->connect( undef, @user_pass_args );
559     ok (! $s2->storage->connected, 'Not connected' );
560     is (ref $s2->storage, 'DBIx::Class::Storage::DBI', 'Undetermined driver' );
561
562     ok (
563       $s2->resultset('Artist')->search({ 'me.name' => { like => '%' } }, { prefetch => 'cds' })->count,
564       'Some artist count'
565     );
566     ok (
567       scalar $s2->resultset('CD')->search({}, { join => 'tracks' } )->all,
568       'Some cds returned'
569     );
570     $s2->storage->disconnect;
571   }
572
573   do_clean ($dbh);
574 }
575
576 done_testing;
577
578 sub do_creates {
579   my ($dbh, $q) = @_;
580
581   do_clean($dbh);
582
583   $dbh->do("CREATE SEQUENCE ${q}artist_autoinc_seq${q} START WITH 1 MAXVALUE 999999 MINVALUE 0");
584   $dbh->do("CREATE SEQUENCE ${q}artist_pk_seq${q} START WITH 1 MAXVALUE 999999 MINVALUE 0");
585   $dbh->do("CREATE SEQUENCE ${q}cd_seq${q} START WITH 1 MAXVALUE 999999 MINVALUE 0");
586   $dbh->do("CREATE SEQUENCE ${q}track_seq${q} START WITH 1 MAXVALUE 999999 MINVALUE 0");
587
588   $dbh->do("CREATE SEQUENCE ${q}nonpkid_seq${q} START WITH 20 MAXVALUE 999999 MINVALUE 0");
589   # this one is always quoted as per manually specified sequence =>
590   $dbh->do('CREATE SEQUENCE "pkid1_seq" START WITH 1 MAXVALUE 999999 MINVALUE 0');
591   # this one is always unquoted as per manually specified sequence =>
592   $dbh->do("CREATE SEQUENCE pkid2_seq START WITH 10 MAXVALUE 999999 MINVALUE 0");
593
594   $dbh->do("CREATE TABLE ${q}artist${q} (${q}artistid${q} NUMBER(12), ${q}name${q} VARCHAR(255),${q}default_value_col${q} VARCHAR(255) DEFAULT 'default_value', ${q}autoinc_col${q} NUMBER(12), ${q}rank${q} NUMBER(38), ${q}charfield${q} VARCHAR2(10))");
595   $dbh->do("ALTER TABLE ${q}artist${q} ADD (CONSTRAINT ${q}artist_pk${q} PRIMARY KEY (${q}artistid${q}))");
596
597   $dbh->do("CREATE TABLE ${q}sequence_test${q} (${q}pkid1${q} NUMBER(12), ${q}pkid2${q} NUMBER(12), ${q}nonpkid${q} NUMBER(12), ${q}name${q} VARCHAR(255))");
598   $dbh->do("ALTER TABLE ${q}sequence_test${q} ADD (CONSTRAINT ${q}sequence_test_constraint${q} PRIMARY KEY (${q}pkid1${q}, ${q}pkid2${q}))");
599
600   # table cd will be unquoted => Oracle will see it as uppercase
601   $dbh->do("CREATE TABLE cd (${q}cdid${q} NUMBER(12), ${q}artist${q} NUMBER(12), ${q}title${q} VARCHAR(255), ${q}year${q} VARCHAR(4), ${q}genreid${q} NUMBER(12), ${q}single_track${q} NUMBER(12))");
602   $dbh->do("ALTER TABLE cd ADD (CONSTRAINT ${q}cd_pk${q} PRIMARY KEY (${q}cdid${q}))");
603
604   $dbh->do("CREATE TABLE ${q}track${q} (${q}trackid${q} NUMBER(12), ${q}cd${q} NUMBER(12) REFERENCES CD(${q}cdid${q}) DEFERRABLE, ${q}position${q} NUMBER(12), ${q}title${q} VARCHAR(255), ${q}last_updated_on${q} DATE, ${q}last_updated_at${q} DATE)");
605   $dbh->do("ALTER TABLE ${q}track${q} ADD (CONSTRAINT ${q}track_pk${q} PRIMARY KEY (${q}trackid${q}))");
606
607   $dbh->do(qq{
608     CREATE OR REPLACE TRIGGER ${q}artist_insert_trg_auto${q}
609     BEFORE INSERT ON ${q}artist${q}
610     FOR EACH ROW
611     BEGIN
612       IF :new.${q}autoinc_col${q} IS NULL THEN
613         SELECT ${q}artist_autoinc_seq${q}.nextval
614         INTO :new.${q}autoinc_col${q}
615         FROM DUAL;
616       END IF;
617     END;
618   });
619
620   $dbh->do(qq{
621     CREATE OR REPLACE TRIGGER ${q}artist_insert_trg_pk${q}
622     BEFORE INSERT ON ${q}artist${q}
623     FOR EACH ROW
624     BEGIN
625       IF :new.${q}artistid${q} IS NULL THEN
626         SELECT ${q}artist_pk_seq${q}.nextval
627         INTO :new.${q}artistid${q}
628         FROM DUAL;
629       END IF;
630     END;
631   });
632
633   $dbh->do(qq{
634     CREATE OR REPLACE TRIGGER ${q}cd_insert_trg${q}
635     BEFORE INSERT OR UPDATE ON cd
636     FOR EACH ROW
637
638     DECLARE
639     tmpVar NUMBER;
640
641     BEGIN
642       tmpVar := 0;
643
644       IF :new.${q}cdid${q} IS NULL THEN
645         SELECT ${q}cd_seq${q}.nextval
646         INTO tmpVar
647         FROM dual;
648
649         :new.${q}cdid${q} := tmpVar;
650       END IF;
651     END;
652   });
653
654   $dbh->do(qq{
655     CREATE OR REPLACE TRIGGER ${q}track_insert_trg${q}
656     BEFORE INSERT ON ${q}track${q}
657     FOR EACH ROW
658     BEGIN
659       IF :new.${q}trackid${q} IS NULL THEN
660         SELECT ${q}track_seq${q}.nextval
661         INTO :new.${q}trackid${q}
662         FROM DUAL;
663       END IF;
664     END;
665   });
666 }
667
668 # clean up our mess
669 sub do_clean {
670
671   my $dbh = shift || return;
672
673   for my $q ('', '"') {
674     my @clean = (
675       "DROP TRIGGER ${q}track_insert_trg${q}",
676       "DROP TRIGGER ${q}cd_insert_trg${q}",
677       "DROP TRIGGER ${q}artist_insert_trg_auto${q}",
678       "DROP TRIGGER ${q}artist_insert_trg_pk${q}",
679       "DROP SEQUENCE ${q}nonpkid_seq${q}",
680       "DROP SEQUENCE ${q}pkid2_seq${q}",
681       "DROP SEQUENCE ${q}pkid1_seq${q}",
682       "DROP SEQUENCE ${q}track_seq${q}",
683       "DROP SEQUENCE ${q}cd_seq${q}",
684       "DROP SEQUENCE ${q}artist_autoinc_seq${q}",
685       "DROP SEQUENCE ${q}artist_pk_seq${q}",
686       "DROP TABLE ${q}bindtype_test${q}",
687       "DROP TABLE ${q}sequence_test${q}",
688       "DROP TABLE ${q}track${q}",
689       "DROP TABLE ${q}cd${q}",
690       "DROP TABLE ${q}artist${q}",
691     );
692     eval { $dbh -> do ($_) } for @clean;
693   }
694 }
695
696 END {
697   for ($dbh, $dbh2) {
698     next unless $_;
699     local $SIG{__WARN__} = sub {};
700     do_clean($_);
701   }
702   undef $dbh;
703   undef $dbh2;
704 }