1use strict; 2use warnings; 3use utf8; 4use DBIx::Class::Schema::Loader 'make_schema_at'; 5use DBIx::Class::Schema::Loader::Utils qw/no_warnings slurp_file/; 6use Test::More; 7use Test::Exception; 8use Try::Tiny; 9use File::Path 'rmtree'; 10use namespace::clean; 11 12use lib qw(t/lib); 13use dbixcsl_common_tests (); 14use dbixcsl_test_dir '$tdir'; 15 16use constant EXTRA_DUMP_DIR => "$tdir/pg_extra_dump"; 17 18my $dsn = $ENV{DBICTEST_PG_DSN} || ''; 19my $user = $ENV{DBICTEST_PG_USER} || ''; 20my $password = $ENV{DBICTEST_PG_PASS} || ''; 21 22my $tester = dbixcsl_common_tests->new( 23 vendor => 'Pg', 24 auto_inc_pk => 'SERIAL NOT NULL PRIMARY KEY', 25 dsn => $dsn, 26 user => $user, 27 password => $password, 28 loader_options => { preserve_case => 1 }, 29 connect_info_opts => { 30 pg_enable_utf8 => 1, 31 on_connect_do => [ 'SET client_min_messages=WARNING' ], 32 }, 33 quote_char => '"', 34 default_is_deferrable => 0, 35 default_on_clause => 'NO ACTION', 36 data_types => { 37 # http://www.postgresql.org/docs/7.4/interactive/datatype.html 38 # 39 # Numeric Types 40 boolean => { data_type => 'boolean' }, 41 bool => { data_type => 'boolean' }, 42 'bool default false' 43 => { data_type => 'boolean', default_value => \'false' }, 44 'bool default true' 45 => { data_type => 'boolean', default_value => \'true' }, 46 'bool default 0::bool' 47 => { data_type => 'boolean', default_value => \'false' }, 48 'bool default 1::bool' 49 => { data_type => 'boolean', default_value => \'true' }, 50 51 bigint => { data_type => 'bigint' }, 52 int8 => { data_type => 'bigint' }, 53 bigserial => { data_type => 'bigint', is_auto_increment => 1 }, 54 serial8 => { data_type => 'bigint', is_auto_increment => 1 }, 55 integer => { data_type => 'integer' }, 56 int => { data_type => 'integer' }, 57 int4 => { data_type => 'integer' }, 58 serial => { data_type => 'integer', is_auto_increment => 1 }, 59 serial4 => { data_type => 'integer', is_auto_increment => 1 }, 60 smallint => { data_type => 'smallint' }, 61 int2 => { data_type => 'smallint' }, 62 63 money => { data_type => 'money' }, 64 65 'double precision' => { data_type => 'double precision' }, 66 float8 => { data_type => 'double precision' }, 67 real => { data_type => 'real' }, 68 float4 => { data_type => 'real' }, 69 'float(24)' => { data_type => 'real' }, 70 'float(25)' => { data_type => 'double precision' }, 71 'float(53)' => { data_type => 'double precision' }, 72 float => { data_type => 'double precision' }, 73 74 numeric => { data_type => 'numeric' }, 75 decimal => { data_type => 'numeric' }, 76 'numeric(6,3)' => { data_type => 'numeric', size => [6,3] }, 77 'decimal(6,3)' => { data_type => 'numeric', size => [6,3] }, 78 79 # Bit String Types 80 'bit varying(2)' => { data_type => 'varbit', size => 2 }, 81 'varbit(2)' => { data_type => 'varbit', size => 2 }, 82 'varbit' => { data_type => 'varbit' }, 83 bit => { data_type => 'bit', size => 1 }, 84 'bit(3)' => { data_type => 'bit', size => 3 }, 85 86 # Network Types 87 inet => { data_type => 'inet' }, 88 cidr => { data_type => 'cidr' }, 89 macaddr => { data_type => 'macaddr' }, 90 91 # Geometric Types 92 point => { data_type => 'point' }, 93 line => { data_type => 'line' }, 94 lseg => { data_type => 'lseg' }, 95 box => { data_type => 'box' }, 96 path => { data_type => 'path' }, 97 polygon => { data_type => 'polygon' }, 98 circle => { data_type => 'circle' }, 99 100 # Character Types 101 'character varying(2)' => { data_type => 'varchar', size => 2 }, 102 'varchar(2)' => { data_type => 'varchar', size => 2 }, 103 'character(2)' => { data_type => 'char', size => 2 }, 104 'char(2)' => { data_type => 'char', size => 2 }, 105 # check that default null is correctly rewritten 106 'char(3) default null' => { data_type => 'char', size => 3, 107 default_value => \'null' }, 108 'character' => { data_type => 'char', size => 1 }, 109 'char' => { data_type => 'char', size => 1 }, 110 text => { data_type => 'text' }, 111 # varchar with no size has unlimited size, we rewrite to 'text' 112 varchar => { data_type => 'text', 113 original => { data_type => 'varchar' } }, 114 # check default null again (to make sure ref is safe) 115 'varchar(3) default null' => { data_type => 'varchar', size => 3, 116 default_value => \'null' }, 117 118 # Datetime Types 119 date => { data_type => 'date' }, 120 interval => { data_type => 'interval' }, 121 'interval(2)' => { data_type => 'interval', size => 2 }, 122 time => { data_type => 'time' }, 123 'time(2)' => { data_type => 'time', size => 2 }, 124 'time without time zone' => { data_type => 'time' }, 125 'time(2) without time zone' => { data_type => 'time', size => 2 }, 126 'time with time zone' => { data_type => 'time with time zone' }, 127 'time(2) with time zone' => { data_type => 'time with time zone', size => 2 }, 128 timestamp => { data_type => 'timestamp' }, 129 'timestamp default now()' 130 => { data_type => 'timestamp', default_value => \'current_timestamp', 131 original => { default_value => \'now()' } }, 132 'timestamp(2)' => { data_type => 'timestamp', size => 2 }, 133 'timestamp without time zone' => { data_type => 'timestamp' }, 134 'timestamp(2) without time zone' => { data_type => 'timestamp', size => 2 }, 135 136 'timestamp with time zone' => { data_type => 'timestamp with time zone' }, 137 'timestamp(2) with time zone' => { data_type => 'timestamp with time zone', size => 2 }, 138 139 # Blob Types 140 bytea => { data_type => 'bytea' }, 141 142 # Enum Types 143 pg_loader_test_enum => { data_type => 'enum', extra => { custom_type_name => 'pg_loader_test_enum', 144 list => [ qw/foo bar baz/] } }, 145 }, 146 pre_create => [ 147 q{ 148 CREATE TYPE pg_loader_test_enum AS ENUM ( 149 'foo', 'bar', 'baz' 150 ) 151 }, 152 ], 153 extra => { 154 create => [ 155 q{ 156 CREATE SCHEMA dbicsl_test 157 }, 158 q{ 159 CREATE SEQUENCE dbicsl_test.myseq 160 }, 161 q{ 162 CREATE TABLE pg_loader_test1 ( 163 id INTEGER NOT NULL DEFAULT nextval('dbicsl_test.myseq') PRIMARY KEY, 164 value VARCHAR(100) 165 ) 166 }, 167 qq{ 168 COMMENT ON TABLE pg_loader_test1 IS 'The\15\12Table ∑' 169 }, 170 qq{ 171 COMMENT ON COLUMN pg_loader_test1.value IS 'The\15\12Column' 172 }, 173 q{ 174 CREATE TABLE pg_loader_test2 ( 175 id SERIAL PRIMARY KEY, 176 value VARCHAR(100) 177 ) 178 }, 179 q{ 180 COMMENT ON TABLE pg_loader_test2 IS 'very very very very very very very very very very very very very very very very very very very very very very very very very very very very very very very very very very very very very very very very very long comment' 181 }, 182 q{ 183 CREATE SCHEMA "dbicsl-test" 184 }, 185 q{ 186 CREATE TABLE "dbicsl-test".pg_loader_test4 ( 187 id SERIAL PRIMARY KEY, 188 value VARCHAR(100) 189 ) 190 }, 191 q{ 192 CREATE TABLE "dbicsl-test".pg_loader_test5 ( 193 id SERIAL PRIMARY KEY, 194 value VARCHAR(100), 195 four_id INTEGER REFERENCES "dbicsl-test".pg_loader_test4 (id), 196 CONSTRAINT loader_test5_uniq UNIQUE (four_id) 197 ) 198 }, 199 q{ 200 CREATE SCHEMA "dbicsl.test" 201 }, 202 q{ 203 CREATE TABLE "dbicsl.test".pg_loader_test5 ( 204 pk SERIAL PRIMARY KEY, 205 value VARCHAR(100), 206 four_id INTEGER REFERENCES "dbicsl-test".pg_loader_test4 (id), 207 CONSTRAINT loader_test5_uniq UNIQUE (four_id) 208 ) 209 }, 210 q{ 211 CREATE TABLE "dbicsl.test".pg_loader_test6 ( 212 id SERIAL PRIMARY KEY, 213 value VARCHAR(100), 214 pg_loader_test4_id INTEGER REFERENCES "dbicsl-test".pg_loader_test4 (id) 215 ) 216 }, 217 q{ 218 CREATE TABLE "dbicsl.test".pg_loader_test7 ( 219 id SERIAL PRIMARY KEY, 220 value VARCHAR(100), 221 six_id INTEGER UNIQUE REFERENCES "dbicsl.test".pg_loader_test6 (id) 222 ) 223 }, 224 q{ 225 CREATE TABLE "dbicsl-test".pg_loader_test8 ( 226 id SERIAL PRIMARY KEY, 227 value VARCHAR(100), 228 pg_loader_test7_id INTEGER REFERENCES "dbicsl.test".pg_loader_test7 (id) 229 ) 230 }, 231 # 4 through 8 are used for the multi-schema tests 232 q{ 233 create table pg_loader_test9 ( 234 id bigserial primary key 235 ) 236 }, 237 q{ 238 create table pg_loader_test10 ( 239 id bigserial primary key, 240 nine_id int, 241 foreign key (nine_id) references pg_loader_test9(id) 242 on delete restrict on update set null deferrable 243 ) 244 }, 245 ], 246 pre_drop_ddl => [ 247 'DROP SCHEMA dbicsl_test CASCADE', 248 'DROP SCHEMA "dbicsl-test" CASCADE', 249 'DROP SCHEMA "dbicsl.test" CASCADE', 250 'DROP TYPE pg_loader_test_enum', 251 ], 252 drop => [ qw/pg_loader_test1 pg_loader_test2 pg_loader_test9 pg_loader_test10/ ], 253 count => 8 + 30 * 2, 254 run => sub { 255 my ($schema, $monikers, $classes) = @_; 256 257 is $schema->source($monikers->{pg_loader_test1})->column_info('id')->{sequence}, 258 'dbicsl_test.myseq', 259 'qualified sequence detected'; 260 261 my $class = $classes->{pg_loader_test1}; 262 my $filename = $schema->loader->get_dump_filename($class); 263 264 my $code = slurp_file $filename; 265 266 like $code, qr/^=head1 NAME\n\n^$class - The\nTable ∑\n\n^=cut\n/m, 267 'table comment'; 268 269 like $code, qr/^=head2 value\n\n(.+:.+\n)+\nThe\nColumn\n\n/m, 270 'column comment and attrs'; 271 272 $class = $classes->{pg_loader_test2}; 273 $filename = $schema->loader->get_dump_filename($class); 274 275 $code = slurp_file $filename; 276 277 like $code, qr/^=head1 NAME\n\n^$class\n\n=head1 DESCRIPTION\n\n^very very very very very very very very very very very very very very very very very very very very very very very very very very very very very very very very very very very very very very very very very long comment\n\n^=cut\n/m, 278 'long table comment is in DESCRIPTION'; 279 280 # test on delete/update fk clause introspection 281 ok ((my $rel_info = $schema->source('PgLoaderTest10')->relationship_info('nine')), 282 'got rel info'); 283 284 is $rel_info->{attrs}{on_delete}, 'RESTRICT', 285 'ON DELETE clause introspected correctly'; 286 287 is $rel_info->{attrs}{on_update}, 'SET NULL', 288 'ON UPDATE clause introspected correctly'; 289 290 is $rel_info->{attrs}{is_deferrable}, 1, 291 'DEFERRABLE clause introspected correctly'; 292 293 foreach my $db_schema (['dbicsl-test', 'dbicsl.test'], '%') { 294 lives_and { 295 rmtree EXTRA_DUMP_DIR; 296 297 my @warns; 298 local $SIG{__WARN__} = sub { 299 push @warns, $_[0] unless $_[0] =~ /\bcollides\b/; 300 }; 301 302 make_schema_at( 303 'PGMultiSchema', 304 { 305 naming => 'current', 306 db_schema => $db_schema, 307 preserve_case => 1, 308 dump_directory => EXTRA_DUMP_DIR, 309 quiet => 1, 310 }, 311 [ $dsn, $user, $password, { 312 on_connect_do => [ 'SET client_min_messages=WARNING' ], 313 } ], 314 ); 315 316 diag join "\n", @warns if @warns; 317 318 is @warns, 0; 319 } 'dumped schema for "dbicsl-test" and "dbicsl.test" schemas with no warnings'; 320 321 my ($test_schema, $rsrc, $rs, $row, %uniqs, $rel_info); 322 323 lives_and { 324 ok $test_schema = PGMultiSchema->connect($dsn, $user, $password, { 325 on_connect_do => [ 'SET client_min_messages=WARNING' ], 326 }); 327 } 'connected test schema'; 328 329 lives_and { 330 ok $rsrc = $test_schema->source('PgLoaderTest4'); 331 } 'got source for table in schema name with dash'; 332 333 is try { $rsrc->column_info('id')->{is_auto_increment} }, 1, 334 'column in schema name with dash'; 335 336 is try { $rsrc->column_info('value')->{data_type} }, 'varchar', 337 'column in schema name with dash'; 338 339 is try { $rsrc->column_info('value')->{size} }, 100, 340 'column in schema name with dash'; 341 342 lives_and { 343 ok $rs = $test_schema->resultset('PgLoaderTest4'); 344 } 'got resultset for table in schema name with dash'; 345 346 lives_and { 347 ok $row = $rs->create({ value => 'foo' }); 348 } 'executed SQL on table in schema name with dash'; 349 350 $rel_info = try { $rsrc->relationship_info('dbicsl_dash_test_pg_loader_test5') }; 351 352 is_deeply $rel_info->{cond}, { 353 'foreign.four_id' => 'self.id' 354 }, 'relationship in schema name with dash'; 355 356 is $rel_info->{attrs}{accessor}, 'single', 357 'relationship in schema name with dash'; 358 359 is $rel_info->{attrs}{join_type}, 'LEFT', 360 'relationship in schema name with dash'; 361 362 lives_and { 363 ok $rsrc = $test_schema->source('DbicslDashTestPgLoaderTest5'); 364 } 'got source for table in schema name with dash'; 365 366 %uniqs = try { $rsrc->unique_constraints }; 367 368 is keys %uniqs, 2, 369 'got unique and primary constraint in schema name with dash'; 370 371 delete $uniqs{primary}; 372 373 is_deeply ((values %uniqs)[0], ['four_id'], 374 'unique constraint is correct in schema name with dash'); 375 376 lives_and { 377 ok $rsrc = $test_schema->source('PgLoaderTest6'); 378 } 'got source for table in schema name with dot'; 379 380 is try { $rsrc->column_info('id')->{is_auto_increment} }, 1, 381 'column in schema name with dot introspected correctly'; 382 383 is try { $rsrc->column_info('value')->{data_type} }, 'varchar', 384 'column in schema name with dot introspected correctly'; 385 386 is try { $rsrc->column_info('value')->{size} }, 100, 387 'column in schema name with dot introspected correctly'; 388 389 lives_and { 390 ok $rs = $test_schema->resultset('PgLoaderTest6'); 391 } 'got resultset for table in schema name with dot'; 392 393 lives_and { 394 ok $row = $rs->create({ value => 'foo' }); 395 } 'executed SQL on table in schema name with dot'; 396 397 $rel_info = try { $rsrc->relationship_info('pg_loader_test7') }; 398 399 is_deeply $rel_info->{cond}, { 400 'foreign.six_id' => 'self.id' 401 }, 'relationship in schema name with dot'; 402 403 is $rel_info->{attrs}{accessor}, 'single', 404 'relationship in schema name with dot'; 405 406 is $rel_info->{attrs}{join_type}, 'LEFT', 407 'relationship in schema name with dot'; 408 409 lives_and { 410 ok $rsrc = $test_schema->source('PgLoaderTest7'); 411 } 'got source for table in schema name with dot'; 412 413 %uniqs = try { $rsrc->unique_constraints }; 414 415 is keys %uniqs, 2, 416 'got unique and primary constraint in schema name with dot'; 417 418 delete $uniqs{primary}; 419 420 is_deeply ((values %uniqs)[0], ['six_id'], 421 'unique constraint is correct in schema name with dot'); 422 423 lives_and { 424 ok $test_schema->source('PgLoaderTest6') 425 ->has_relationship('pg_loader_test4'); 426 } 'cross-schema relationship in multi-db_schema'; 427 428 lives_and { 429 ok $test_schema->source('PgLoaderTest4') 430 ->has_relationship('pg_loader_test6s'); 431 } 'cross-schema relationship in multi-db_schema'; 432 433 lives_and { 434 ok $test_schema->source('PgLoaderTest8') 435 ->has_relationship('pg_loader_test7'); 436 } 'cross-schema relationship in multi-db_schema'; 437 438 lives_and { 439 ok $test_schema->source('PgLoaderTest7') 440 ->has_relationship('pg_loader_test8s'); 441 } 'cross-schema relationship in multi-db_schema'; 442 } 443 }, 444 }, 445); 446 447if( !$dsn || !$user ) { 448 $tester->skip_tests('You need to set the DBICTEST_PG_DSN, _USER, and _PASS environment variables'); 449} 450else { 451 $tester->run_tests(); 452} 453 454END { 455 rmtree EXTRA_DUMP_DIR unless $ENV{SCHEMA_LOADER_TESTS_NOCLEANUP}; 456} 457# vim:et sw=4 sts=4 tw=0: 458