1#!/usr/bin/perl 2# vim: set ft=perl: 3 4use strict; 5use Test::More; 6use SQL::Translator; 7use SQL::Translator::Schema::Constants; 8use Test::SQL::Translator qw(maybe_plan); 9 10maybe_plan(99, 'SQL::Translator::Parser::Oracle'); 11SQL::Translator::Parser::Oracle->import('parse'); 12 13my $t = SQL::Translator->new( trace => 0 ); 14my $sql = q[ 15 CREATE TABLE qtl_trait_category 16 ( 17 qtl_trait_category_id NUMBER(11) NOT NULL 18 CONSTRAINT pk_qtl_trait_category PRIMARY KEY, 19 trait_category VARCHAR2(100) NOT NULL, 20 CONSTRAINT AVCON_4287_PARAM_000 CHECK 21 (trait_category IN ('S', 'A', 'E')) ENABLE, 22 UNIQUE ( trait_category ) 23 ); 24 COMMENT ON TABLE qtl_trait_category IS 25 'hey, hey, hey, hey'; 26 comment on column qtl_trait_category.qtl_trait_category_id 27 is 'the primary key!'; 28 29 -- foo bar comment 30 CREATE TABLE qtl_trait 31 ( 32 qtl_trait_id NUMBER(11) NOT NULL 33 CONSTRAINT pk_qtl_trait PRIMARY KEY, 34 trait_symbol VARCHAR2(100 BYTE) NOT NULL, 35 trait_name VARCHAR2(200 CHAR) NOT NULL, 36 qtl_trait_category_id NUMBER(11) NOT NULL, 37 UNIQUE ( trait_symbol ), 38 UNIQUE ( trait_name ), 39 FOREIGN KEY ( qtl_trait_category_id ) REFERENCES qtl_trait_category 40 ); 41 42 /* qtl table comment */ 43 CREATE TABLE qtl 44 ( 45 /* qtl_id comment */ 46 qtl_id NUMBER(11) NOT NULL 47 CONSTRAINT pk_qtl PRIMARY KEY, 48 qtl_accession_id VARCHAR2(20) NOT NULL /* accession comment */, 49 published_symbol VARCHAR2(100), 50 qtl_trait_id NUMBER(11) NOT NULL, 51 linkage_group VARCHAR2(32) NOT NULL, 52 start_position NUMBER(11,2) NOT NULL, 53 stop_position NUMBER(11,2) NOT NULL, 54 comments long, 55 FOREIGN KEY ( qtl_trait_id ) REFERENCES qtl_trait 56 ); 57 58 CREATE UNIQUE INDEX qtl_accession ON qtl ( qtl_accession_id ); 59 CREATE UNIQUE INDEX qtl_accession_upper ON qtl ( UPPER(qtl_accession_id) ); 60 CREATE INDEX qtl_index ON qtl ( qtl_accession_id ); 61 62 CREATE TABLE qtl_trait_synonym 63 ( 64 qtl_trait_synonym_id NUMBER(11) NOT NULL 65 CONSTRAINT pk_qtl_trait_synonym PRIMARY KEY, 66 trait_synonym VARCHAR2(200) NOT NULL, 67 qtl_trait_id NUMBER(11) NOT NULL, 68 UNIQUE( qtl_trait_id, trait_synonym ), 69 FOREIGN KEY ( qtl_trait_id ) REFERENCES qtl_trait ON DELETE SET NULL 70 ); 71 72-- View and procedure testing 73 CREATE OR REPLACE PROCEDURE CMDOMAIN_LATEST.P_24_HOUR_EVENT_SUMMARY 74 IS 75 ldate varchar2(10); 76 user_added INT; 77 user_deleted INT; 78 workingsets_created INT; 79 change_executed INT; 80 change_detected INT; 81 reports_run INT; 82 backup_complete INT; 83 backup_failed INT; 84 devices_in_inventory INT; 85 86 BEGIN 87 select CAST(TO_CHAR(sysdate,'MM/DD/YYYY') AS varchar2(10)) INTO ldate from dual; 88 END; 89/ 90 91 CREATE OR REPLACE FORCE VIEW CMDOMAIN_MIG.VS_ASSET (ASSET_ID, FQ_NAME, FOLDER_NAME, ASSET_NAME, ANNOTATION, ASSET_TYPE, FOREIGN_ASSET_ID, FOREIGN_ASSET_ID2, DATE_CREATED, DATE_MODIFIED, CONTAINER_ID, CREATOR_ID, MODIFIER_ID, USER_ACCESS) AS 92 SELECT 93 a.asset_id, a.fq_name, 94 ap_extract_folder(a.fq_name) AS folder_name, 95 ap_extract_asset(a.fq_name) AS asset_name, 96 a.annotation, 97 a.asset_type, 98 a.foreign_asset_id, 99 a.foreign_asset_id2, 100 a.dateCreated AS date_created, 101 a.dateModified AS date_modified, 102 a.container_id, 103 a.creator_id, 104 a.modifier_id, 105 m.user_id AS user_access 106 from asset a 107 JOIN M_ACCESS_CONTROL m on a.acl_id = m.acl_id; 108 109]; 110 111$| = 1; 112 113my $data = parse( $t, $sql ); 114my $schema = $t->schema; 115 116isa_ok( $schema, 'SQL::Translator::Schema', 'Schema object' ); 117my @tables = $schema->get_tables; 118is( scalar @tables, 4, 'Found four tables' ); 119 120# 121# qtl_trait_category 122# 123my $t1 = shift @tables; 124is( $t1->name, 'qtl_trait_category', 'First table is "qtl_trait_category"' ); 125is( $t1->comments, 'hey, hey, hey, hey', 'Comment = "hey, hey, hey, hey"' ); 126 127my @t1_fields = $t1->get_fields; 128is( scalar @t1_fields, 2, '2 fields in table' ); 129 130my $f1 = shift @t1_fields; 131is( $f1->name, 'qtl_trait_category_id', 132 'First field is "qtl_trait_category_id"' ); 133is( $f1->data_type, 'number', 'Field is a number' ); 134is( $f1->size, 11, 'Size is "11"' ); 135is( $f1->is_nullable, 0, 'Field cannot be null' ); 136is( $f1->default_value, undef, 'Default value is undefined' ); 137is( $f1->is_primary_key, 1, 'Field is PK' ); 138is( join(',', $f1->comments), 'the primary key!', 'Comment = "the primary key!"' ); 139 140my $f2 = shift @t1_fields; 141is( $f2->name, 'trait_category', 'Second field is "trait_category"' ); 142is( $f2->data_type, 'varchar2', 'Field is a varchar2' ); 143is( $f2->size, 100, 'Size is "100"' ); 144is( $f2->is_nullable, 0, 'Field cannot be null' ); 145is( $f2->default_value, undef, 'Default value is undefined' ); 146is( $f2->is_primary_key, 0, 'Field is not PK' ); 147 148my @t1_indices = $t1->get_indices; 149is( scalar @t1_indices, 0, '0 indices on table' ); 150 151my @t1_constraints = $t1->get_constraints; 152#use Data::Dumper; 153#print STDERR Dumper(\@t1_constraints), "\n"; 154is( scalar @t1_constraints, 3, '3 constraints on table' ); 155 156my $c1 = $t1_constraints[0]; 157is( $c1->name, 'pk_qtl_trait_category', 158 'Constraint name is "pk_qtl_trait_category"' ); 159is( $c1->type, PRIMARY_KEY, 'First constraint is PK' ); 160is( join(',', $c1->fields), 'qtl_trait_category_id', 161 'Constraint is on field "qtl_trait_category_id"' ); 162 163my $c2 = $t1_constraints[1]; 164is( $c2->type, CHECK_C, 'Second constraint is a check' ); 165is( $c2->expression, 166 "( trait_category IN ('S', 'A', 'E') ) ENABLE", 167 'Constraint is on field "trait_category"' ); 168 169my $c3 = $t1_constraints[2]; 170is( $c3->type, UNIQUE, 'Third constraint is unique' ); 171is( join(',', $c3->fields), 'trait_category', 172 'Constraint is on field "trait_category"' ); 173 174# 175# qtl_trait 176# 177my $t2 = shift @tables; 178is( $t2->name, 'qtl_trait', 'Table "qtl_trait" exists' ); 179is( $t2->comments, 'foo bar comment', 'Comment "foo bar" exists' ); 180 181my @t2_fields = $t2->get_fields; 182is( scalar @t2_fields, 4, '4 fields in table' ); 183 184my $t2_f1 = shift @t2_fields; 185is( $t2_f1->name, 'qtl_trait_id', 'First field is "qtl_trait_id"' ); 186is( $t2_f1->data_type, 'number', 'Field is a number' ); 187is( $t2_f1->size, 11, 'Size is "11"' ); 188is( $t2_f1->is_nullable, 0, 'Field cannot be null' ); 189is( $t2_f1->default_value, undef, 'Default value is undefined' ); 190is( $t2_f1->is_primary_key, 1, 'Field is PK' ); 191 192my $t2_f2 = shift @t2_fields; 193is( $t2_f2->name, 'trait_symbol', 'Second field is "trait_symbol"' ); 194is( $t2_f2->data_type, 'varchar2', 'Field is a varchar2' ); 195is( $t2_f2->size, 100, 'Size is "100"' ); 196is( $t2_f2->is_nullable, 0, 'Field cannot be null' ); 197is( $t2_f2->is_foreign_key, 0, 'Field is not a FK' ); 198 199my $t2_f3 = shift @t2_fields; 200is( $t2_f3->name, 'trait_name', 'Third field is "trait_name"' ); 201is( $t2_f3->data_type, 'varchar2', 'Field is a varchar2' ); 202is( $t2_f3->size, 200, 'Size is "200"' ); 203is( $t2_f3->is_nullable, 0, 'Field cannot be null' ); 204is( $t2_f3->is_foreign_key, 0, 'Field is not a FK' ); 205 206my $t2_f4 = shift @t2_fields; 207is( $t2_f4->name, 'qtl_trait_category_id', 208 'Fourth field is "qtl_trait_category_id"' ); 209is( $t2_f4->data_type, 'number', 'Field is a number' ); 210is( $t2_f4->size, 11, 'Size is "11"' ); 211is( $t2_f4->is_nullable, 0, 'Field cannot be null' ); 212is( $t2_f4->is_foreign_key, 1, 'Field is a FK' ); 213my $f4_fk = $t2_f4->foreign_key_reference; 214isa_ok( $f4_fk, 'SQL::Translator::Schema::Constraint', 'FK' ); 215is( $f4_fk->reference_table, 'qtl_trait_category', 216 'FK references table "qtl_trait_category"' ); 217is( join(',', $f4_fk->reference_fields), 'qtl_trait_category_id', 218 'FK references field "qtl_trait_category_id"' ); 219 220my @t2_constraints = $t2->get_constraints; 221is( scalar @t2_constraints, 4, '4 constraints on table' ); 222 223my $t2_c1 = shift @t2_constraints; 224is( $t2_c1->type, PRIMARY_KEY, 'First constraint is PK' ); 225is( $t2_c1->name, 'pk_qtl_trait', 'Name is "pk_qtl_trait"' ); 226is( join(',', $t2_c1->fields), 'qtl_trait_id', 'Fields = "qtl_trait_id"' ); 227 228my $t2_c2 = shift @t2_constraints; 229is( $t2_c2->type, UNIQUE, 'Second constraint is unique' ); 230is( $t2_c2->name, '', 'No name' ); 231is( join(',', $t2_c2->fields), 'trait_symbol', 'Fields = "trait_symbol"' ); 232 233my $t2_c3 = shift @t2_constraints; 234is( $t2_c3->type, UNIQUE, 'Third constraint is unique' ); 235is( $t2_c3->name, '', 'No name' ); 236is( join(',', $t2_c3->fields), 'trait_name', 'Fields = "trait_name"' ); 237 238my $t2_c4 = shift @t2_constraints; 239is( $t2_c4->type, FOREIGN_KEY, 'Fourth constraint is FK' ); 240is( $t2_c4->name, '', 'No name' ); 241is( join(',', $t2_c4->fields), 'qtl_trait_category_id', 242 'Fields = "qtl_trait_category_id"' ); 243is( $t2_c4->reference_table, 'qtl_trait_category', 244 'Reference table = "qtl_trait_category"' ); 245is( join(',', $t2_c4->reference_fields), 'qtl_trait_category_id', 246 'Reference fields = "qtl_trait_category_id"' ); 247 248 249# 250# qtl 251# 252my $t3 = shift @tables; 253is( $t3->name, 'qtl', 'Table "qtl" exists' ); 254 255my @t3_fields = $t3->get_fields; 256is( scalar @t3_fields, 8, '8 fields in table' ); 257 258my @t3_constraints = $t3->get_constraints; 259is( scalar @t3_constraints, 4, '4 constraints on table' ); 260my $t3_c4 = $t3_constraints[3]; 261is( $t3_c4->type, UNIQUE, 'Fourth constraint is unique' ); 262is( $t3_c4->name, 'qtl_accession_upper', 'Name = "qtl_accession_upper"' ); 263is( join(',', $t3_c4->fields), 'UPPER(qtl_accession_id)', 'Fields = "UPPER(qtl_accession_id)"' ); 264 265is( $t3->comments, 'qtl table comment', 'Comment "qtl table comment" exists' ); 266 267my $t3_f1 = shift @t3_fields; 268is( $t3_f1->comments, 'qtl_id comment', 'Comment "qtl_id comment" exists' ); 269 270my $t3_f2 = shift @t3_fields; 271is( $t3_f2->comments, 'accession comment', 272 'Comment "accession comment" exists' ); 273 274my @t3_indices = $t3->get_indices; 275is( scalar @t3_indices, 1, '1 index on table' ); 276 277my $t3_i1 = shift @t3_indices; 278is( $t3_i1->type, 'NORMAL', 'First index is normal' ); 279is( $t3_i1->name, 'qtl_index', 'Name is "qtl_index"' ); 280is( join(',', $t3_i1->fields), 'qtl_accession_id', 'Fields = "qtl_accession_id"' ); 281 282# 283# qtl_trait_synonym 284# 285my $t4 = shift @tables; 286is( $t4->name, 'qtl_trait_synonym', 'Table "qtl_trait_synonym" exists' ); 287 288my @t4_fields = $t4->get_fields; 289is( scalar @t4_fields, 3, '3 fields in table' ); 290 291my @t4_constraints = $t4->get_constraints; 292is( scalar @t4_constraints, 3, '3 constraints on table' ); 293my $t4_c3 = $t4_constraints[2]; 294is( $t4_c3->type, FOREIGN_KEY, 'Third constraint is FK' ); 295is( $t4_c3->name, '', 'No name' ); 296is( join(',', $t4_c3->fields), 'qtl_trait_id', 297 'Fields = "qtl_trait_id"' ); 298is( $t4_c3->reference_table, 'qtl_trait', 299 'Reference table = "qtl_trait"' ); 300is( join(',', $t4_c3->reference_fields), 'qtl_trait_id', 301 'Reference fields = "qtl_trait_id"' ); 302is( $t4_c3->on_delete, 'SET NULL', 303 'on_delete = "SET NULL"' ); 304 305my @views = $schema->get_views; 306is( scalar @views, 1, 'Right number of views (1)' ); 307my $view1 = shift @views; 308is( $view1->name, 'VS_ASSET', 'Found "VS_ASSET" view' ); 309like($view1->sql, qr/VS_ASSET/, "Detected view VS_ASSET"); 310unlike($view1->sql, qr/CMDOMAIN_MIG/, "Did not detect CMDOMAIN_MIG"); 311 312my @procs = $schema->get_procedures; 313is( scalar @procs, 1, 'Right number of procedures (1)' ); 314my $proc1 = shift @procs; 315is( $proc1->name, 'P_24_HOUR_EVENT_SUMMARY', 'Found "P_24_HOUR_EVENT_SUMMARY" procedure' ); 316like($proc1->sql, qr/P_24_HOUR_EVENT_SUMMARY/, "Detected procedure P_24_HOUR_EVENT_SUMMARY"); 317unlike($proc1->sql, qr/CMDOMAIN_MIG/, "Did not detect CMDOMAIN_MIG"); 318