1#!/usr/bin/perl -w 2 3use strict; 4 5use Test::More(); 6 7my $Lib_Dir = 't/cg-lib'; 8 9unless(-d $Lib_Dir) 10{ 11 mkdir($Lib_Dir); 12} 13 14if(-d $Lib_Dir) 15{ 16 Test::More->import(tests => 2 + (4 * 4)); 17} 18else 19{ 20 Test::More->import(skip_all => "Could not mkdir($Lib_Dir) - $!"); 21} 22 23require 't/test-lib.pl'; 24use_ok('Rose::DB::Object'); 25use_ok('Rose::DB::Object::Loader'); 26 27my $Include_Tables = '^(?:' . join('|', 28 qw(product_colors prices products colors vendors)) . ')$'; 29$Include_Tables = qr($Include_Tables); 30 31my %Column_Defs = 32( 33 pg => 34 { 35 id => q(id => { type => 'serial', not_null => 1 },), 36 vendor_id => q(vendor_id => { type => 'integer', not_null => 1 },), 37 }, 38 39 mysql => 40 { 41 id => q(id => { type => 'serial', not_null => 1 },), 42 vendor_id => q(vendor_id => { type => 'integer', default => '', not_null => 1 },), 43 }, 44 45 sqlite => 46 { 47 id => q(id => { type => 'serial' },), 48 vendor_id => q(vendor_id => { type => 'integer', not_null => 1 },), 49 }, 50 51 informix => 52 { 53 id => q(id => { type => 'serial', not_null => 1 },), 54 vendor_id => q(vendor_id => { type => 'integer', not_null => 1 },), 55 }, 56); 57 58use Config; 59 60my $Perl = $^X; 61 62if($^O ne 'VMS') 63{ 64 $Perl .= $Config{'_exe'} unless($Perl =~ /$Config{'_exe'}$/i); 65} 66 67# 68# Tests 69# 70 71foreach my $db_type (qw(pg mysql informix sqlite)) 72{ 73 unless(have_db($db_type)) 74 { 75 SKIP: { skip("$db_type tests", 4) } 76 next; 77 } 78 79 Rose::DB::Object::Metadata->unregister_all_classes; 80 81 Rose::DB->default_type($db_type); 82 83 if($db_type eq 'mysql') 84 { 85 my $serial = Rose::DB->new->dbh->{'Driver'}{'Version'} >= 4.002 ? 'serial' : 'integer'; 86 $Column_Defs{'mysql'}{'id'} = qq(id => { type => '$serial', not_null => 1 },); 87 } 88 89 my $class_prefix = 'My' . ucfirst($db_type); 90 91 my $loader = 92 Rose::DB::Object::Loader->new( 93 db_class => 'Rose::DB', 94 class_prefix => $class_prefix, 95 module_preamble => "# My Preamble\n", 96 module_postamble => 'This will be hidden', 97 include_tables => $Include_Tables); 98 99 $loader->make_modules(module_dir => $Lib_Dir, 100 braces => 'bsd', 101 indent => 2, 102 module_postamble => 103 sub 104 { 105 no warnings 'uninitialized'; 106 "# My Postamble for " . $_[0]->class . " ($_[1])\n"; 107 }); 108 109 my $mylsq_5_51 = ($db_type eq 'mysql' && Rose::DB->new->database_version >= 5_000_051) ? 1 : 0; 110 111 # XXX: Lame 112 if(slurp("$Lib_Dir/$class_prefix/Product.pm") !~ /default => '', /) # $mylsq_5_51 113 { 114 $Column_Defs{$db_type}{'vendor_id'} =~ s/default => '', //; 115 } 116 117 my $unique_keys; 118 119 no warnings 'uninitialized'; 120 my($v1, $v2, $v3) = split(/\./, $DBD::Pg::VERSION); 121 122 if($db_type eq 'pg' && (($v1 >= 2 && $v2 >= 19) || $v1 > 2)) 123 { 124 $unique_keys = qq([ 'name' ],\n [ 'name', 'vendor_id' ],); 125 } 126 else 127 { 128 $unique_keys = qq([ 'name', 'vendor_id' ],\n [ 'name' ],); 129 } 130 131 is(slurp("$Lib_Dir/$class_prefix/Product.pm"), <<"EOF", "Product 1 - $db_type"); 132# My Preamble 133package ${class_prefix}::Product; 134 135use strict; 136 137use base qw(${class_prefix}::DB::Object::AutoBaseNNN); 138 139__PACKAGE__->meta->setup 140( 141 table => 'products', 142 143 columns => 144 [ 145 $Column_Defs{$db_type}{'id'} 146 name => { type => 'varchar', length => 255 }, 147 $Column_Defs{$db_type}{'vendor_id'} 148 ], 149 150 primary_key_columns => [ 'id' ], 151 152 unique_keys => 153 [ 154 $unique_keys 155 ], 156 157 foreign_keys => 158 [ 159 vendor => 160 { 161 class => '${class_prefix}::Vendor', 162 key_columns => { vendor_id => 'id' }, 163 }, 164 ], 165 166 relationships => 167 [ 168 colors => 169 { 170 map_class => '${class_prefix}::ProductColor', 171 map_from => 'product', 172 map_to => 'color', 173 type => 'many to many', 174 }, 175 176 prices => 177 { 178 class => '${class_prefix}::Price', 179 column_map => { id => 'product_id' }, 180 type => 'one to many', 181 }, 182 ], 183); 184 1851; 186 187# My Postamble for ${class_prefix}::Product () 188EOF 189 190 is(slurp("$Lib_Dir/$class_prefix/Product/Manager.pm"), <<"EOF", "Product Manager 1 - $db_type"); 191# My Preamble 192package ${class_prefix}::Product::Manager; 193 194use strict; 195 196use base qw(Rose::DB::Object::Manager); 197 198use ${class_prefix}::Product; 199 200sub object_class { '${class_prefix}::Product' } 201 202__PACKAGE__->make_manager_methods('products'); 203 2041; 205 206# My Postamble for ${class_prefix}::Product (${class_prefix}::Product::Manager) 207EOF 208 209 is(slurp("$Lib_Dir/$class_prefix/Color.pm"), <<"EOF", "Color 1 - $db_type"); 210# My Preamble 211package ${class_prefix}::Color; 212 213use strict; 214 215use base qw(${class_prefix}::DB::Object::AutoBaseNNN); 216 217__PACKAGE__->meta->setup 218( 219 table => 'colors', 220 221 columns => 222 [ 223 code => { type => 'character', length => 3, not_null => 1 }, 224 name => { type => 'varchar', length => 255 }, 225 ], 226 227 primary_key_columns => [ 'code' ], 228 229 unique_key => [ 'name' ], 230 231 relationships => 232 [ 233 products => 234 { 235 map_class => '${class_prefix}::ProductColor', 236 map_from => 'color', 237 map_to => 'product', 238 type => 'many to many', 239 }, 240 ], 241); 242 2431; 244 245# My Postamble for ${class_prefix}::Color () 246EOF 247 248 unshift(@INC, $Lib_Dir); 249 250 # Test actual code by running external script with db type arg 251 252 my($ok, $script_fh); 253 254 # Perl 5.8.x and later support the FILEHANDLE,MODE,EXPR,LIST form of 255 # open, but not (apparently) on Windows 256 if($Config{'version'} =~ /^5\.([89]|1\d)\./ && $^O !~ /Win32/i) 257 { 258 $ok = open($script_fh, '-|', $Perl, 't/make-modules.ext', $db_type); 259 } 260 else 261 { 262 $ok = open($script_fh, "$Perl t/make-modules.ext $db_type |"); 263 } 264 265 if($ok) 266 { 267 chomp(my $line = <$script_fh>); 268 close($script_fh); 269 is($line, 'V1; IS: 1.25, DE: 4.25; green, red; red: CC1', "external test - $db_type"); 270 } 271 else 272 { 273 ok(0, "Failed to open external script for $db_type - $!"); 274 } 275 276 shift(@INC); 277} 278 279BEGIN 280{ 281 require 't/test-lib.pl'; 282 283 # 284 # PostgreSQL 285 # 286 287 if(have_db('pg_admin')) 288 { 289 my $dbh = get_dbh('pg_admin'); 290 291 # Drop existing tables, ignoring errors 292 { 293 local $dbh->{'RaiseError'} = 0; 294 local $dbh->{'PrintError'} = 0; 295 $dbh->do('DROP TABLE product_colors CASCADE'); 296 $dbh->do('DROP TABLE prices CASCADE'); 297 $dbh->do('DROP TABLE products CASCADE'); 298 $dbh->do('DROP TABLE colors CASCADE'); 299 $dbh->do('DROP TABLE vendors CASCADE'); 300 } 301 302 $dbh->do(<<"EOF"); 303CREATE TABLE vendors 304( 305 id SERIAL NOT NULL PRIMARY KEY, 306 name VARCHAR(255) 307) 308EOF 309 310 $dbh->do(<<"EOF"); 311CREATE TABLE colors 312( 313 code CHAR(3) NOT NULL PRIMARY KEY, 314 name VARCHAR(255), 315 UNIQUE(name) 316) 317EOF 318 319 $dbh->do(<<"EOF"); 320CREATE TABLE products 321( 322 id SERIAL NOT NULL PRIMARY KEY, 323 name VARCHAR(255), 324 vendor_id INT NOT NULL REFERENCES vendors (id), 325 326 UNIQUE(name, vendor_id), 327 UNIQUE(name) 328) 329EOF 330 331 $dbh->do(<<"EOF"); 332CREATE TABLE prices 333( 334 price_id SERIAL NOT NULL PRIMARY KEY, 335 product_id INT NOT NULL REFERENCES products (id), 336 region CHAR(2) NOT NULL DEFAULT 'US', 337 price DECIMAL(10,2) NOT NULL 338) 339EOF 340 341 $dbh->do(<<"EOF"); 342CREATE TABLE product_colors 343( 344 id SERIAL NOT NULL PRIMARY KEY, 345 product_id INT NOT NULL REFERENCES products (id), 346 color_code CHAR(3) NOT NULL REFERENCES colors (code) 347) 348EOF 349 350 $dbh->disconnect; 351 } 352 353 # 354 # MySQL 355 # 356 357 eval 358 { 359 my $db = get_db('mysql_admin'); 360 my $dbh = $db->retain_dbh or die Rose::DB->error; 361 my $db_version = $db->database_version; 362 363 die "MySQL version too old" unless($db_version >= 4_000_000); 364 365 CLEAR: 366 { 367 local $dbh->{'RaiseError'} = 0; 368 local $dbh->{'PrintError'} = 0; 369 $dbh->do('DROP TABLE product_colors CASCADE'); 370 $dbh->do('DROP TABLE prices CASCADE'); 371 $dbh->do('DROP TABLE products CASCADE'); 372 $dbh->do('DROP TABLE colors CASCADE'); 373 $dbh->do('DROP TABLE vendors CASCADE'); 374 } 375 376 # Foreign key stuff requires InnoDB support 377 $dbh->do(<<"EOF"); 378CREATE TABLE vendors 379( 380 id INT AUTO_INCREMENT PRIMARY KEY, 381 name VARCHAR(255) 382) 383ENGINE=InnoDB 384EOF 385 386 # MySQL will silently ignore the "ENGINE=InnoDB" part and create 387 # a MyISAM table instead. MySQL is evil! Now we have to manually 388 # check to make sure an InnoDB table was really created. 389 my $db_name = $db->database; 390 my $sth = $dbh->prepare("SHOW TABLE STATUS FROM `$db_name` LIKE ?"); 391 $sth->execute('vendors'); 392 my $info = $sth->fetchrow_hashref; 393 394 no warnings 'uninitialized'; 395 unless(lc $info->{'Type'} eq 'innodb' || lc $info->{'Engine'} eq 'innodb') 396 { 397 die "Missing InnoDB support"; 398 } 399 }; 400 401 if($@) 402 { 403 have_db(mysql_admin => 0); 404 have_db(mysql => 0); 405 } 406 407 if(have_db('mysql_admin')) 408 { 409 my $dbh = get_dbh('mysql_admin'); 410 411 $dbh->do(<<"EOF"); 412CREATE TABLE colors 413( 414 code CHAR(3) NOT NULL PRIMARY KEY, 415 name VARCHAR(255), 416 UNIQUE(name) 417) 418ENGINE=InnoDB 419EOF 420 421 $dbh->do(<<"EOF"); 422CREATE TABLE products 423( 424 id INT AUTO_INCREMENT PRIMARY KEY, 425 name VARCHAR(255), 426 vendor_id INT NOT NULL, 427 428 UNIQUE(name, vendor_id), 429 UNIQUE(name), 430 431 INDEX(vendor_id), 432 433 FOREIGN KEY (vendor_id) REFERENCES vendors (id) 434) 435ENGINE=InnoDB 436EOF 437 438 $dbh->do(<<"EOF"); 439CREATE TABLE prices 440( 441 price_id INT AUTO_INCREMENT PRIMARY KEY, 442 product_id INT NOT NULL, 443 region CHAR(2) NOT NULL DEFAULT 'US', 444 price DECIMAL(10,2) NOT NULL, 445 446 INDEX(product_id), 447 448 FOREIGN KEY (product_id) REFERENCES products (id) 449) 450ENGINE=InnoDB 451EOF 452 453 $dbh->do(<<"EOF"); 454CREATE TABLE product_colors 455( 456 id INT AUTO_INCREMENT PRIMARY KEY, 457 product_id INT NOT NULL, 458 color_code CHAR(3) NOT NULL, 459 460 INDEX(product_id), 461 INDEX(color_code), 462 463 FOREIGN KEY (product_id) REFERENCES products (id), 464 FOREIGN KEY (color_code) REFERENCES colors (code) 465) 466ENGINE=InnoDB 467EOF 468 469 $dbh->disconnect; 470 } 471 472 # 473 # Informix 474 # 475 476 if(have_db('informix_admin')) 477 { 478 my $dbh = get_dbh('informix_admin'); 479 480 # Drop existing tables, ignoring errors 481 { 482 local $dbh->{'RaiseError'} = 0; 483 local $dbh->{'PrintError'} = 0; 484 $dbh->do('DROP TABLE product_colors CASCADE'); 485 $dbh->do('DROP TABLE prices CASCADE'); 486 $dbh->do('DROP TABLE products CASCADE'); 487 $dbh->do('DROP TABLE colors CASCADE'); 488 $dbh->do('DROP TABLE vendors CASCADE'); 489 } 490 491 $dbh->do(<<"EOF"); 492CREATE TABLE vendors 493( 494 id SERIAL NOT NULL PRIMARY KEY, 495 name VARCHAR(255) 496) 497EOF 498 499 $dbh->do(<<"EOF"); 500CREATE TABLE colors 501( 502 code CHAR(3) NOT NULL PRIMARY KEY, 503 name VARCHAR(255), 504 UNIQUE(name) 505) 506EOF 507 508 $dbh->do(<<"EOF"); 509CREATE TABLE products 510( 511 id SERIAL NOT NULL PRIMARY KEY, 512 name VARCHAR(255), 513 vendor_id INT NOT NULL REFERENCES vendors (id), 514 515 UNIQUE(name, vendor_id), 516 UNIQUE(name) 517) 518EOF 519 520 $dbh->do(<<"EOF"); 521CREATE TABLE prices 522( 523 price_id SERIAL NOT NULL PRIMARY KEY, 524 product_id INT NOT NULL REFERENCES products (id), 525 region CHAR(2) DEFAULT 'US' NOT NULL, 526 price DECIMAL(10,2) NOT NULL 527) 528EOF 529 530 $dbh->do(<<"EOF"); 531CREATE TABLE product_colors 532( 533 id SERIAL NOT NULL PRIMARY KEY, 534 product_id INT NOT NULL REFERENCES products (id), 535 color_code CHAR(3) NOT NULL REFERENCES colors (code) 536) 537EOF 538 539 $dbh->disconnect; 540 } 541 542 # 543 # SQLite 544 # 545 546 if(have_db('sqlite_admin')) 547 { 548 my $dbh = get_dbh('sqlite_admin'); 549 550 # Drop existing tables, ignoring errors 551 { 552 local $dbh->{'RaiseError'} = 0; 553 local $dbh->{'PrintError'} = 0; 554 $dbh->do('DROP TABLE product_colors CASCADE'); 555 $dbh->do('DROP TABLE prices CASCADE'); 556 $dbh->do('DROP TABLE products CASCADE'); 557 $dbh->do('DROP TABLE colors CASCADE'); 558 $dbh->do('DROP TABLE vendors CASCADE'); 559 } 560 561 $dbh->do(<<"EOF"); 562CREATE TABLE vendors 563( 564 id INTEGER PRIMARY KEY AUTOINCREMENT, 565 name VARCHAR(255) 566) 567EOF 568 569 $dbh->do(<<"EOF"); 570CREATE TABLE colors 571( 572 code CHAR(3) NOT NULL PRIMARY KEY, 573 name VARCHAR(255), 574 UNIQUE(name) 575) 576EOF 577 578 $dbh->do(<<"EOF"); 579CREATE TABLE products 580( 581 id INTEGER PRIMARY KEY AUTOINCREMENT, 582 name VARCHAR(255), 583 vendor_id INT NOT NULL REFERENCES vendors (id), 584 585 UNIQUE(name, vendor_id), 586 UNIQUE(name) 587) 588EOF 589 590 $dbh->do(<<"EOF"); 591CREATE TABLE prices 592( 593 price_id INTEGER PRIMARY KEY AUTOINCREMENT, 594 product_id INT NOT NULL REFERENCES products (id), 595 region CHAR(2) NOT NULL DEFAULT 'US', 596 price DECIMAL(10,2) NOT NULL 597) 598EOF 599 600 $dbh->do(<<"EOF"); 601CREATE TABLE product_colors 602( 603 id INTEGER PRIMARY KEY AUTOINCREMENT, 604 product_id INT NOT NULL REFERENCES products (id), 605 color_code CHAR(3) NOT NULL REFERENCES colors (code) 606) 607EOF 608 609 $dbh->disconnect; 610 } 611} 612 613sub slurp 614{ 615 my($path) = shift; 616 617 return undef unless(-e $path); 618 619 open(my $fh, $path) or die "Could not open '$path' - $!"; 620 my $data = do { local $/; <$fh> }; 621 622 # Normalize auto-numbered base classes 623 for($data) 624 { 625 s/::DB::Object::AutoBase\d+/::DB::Object::AutoBaseNNN/g; 626 # MySQL 4.1.2 apparently defaults INTEGER NOT NULL columns to 0 627 s/default => '0',/default => '',/; 628 } 629 630 return $data; 631} 632 633END 634{ 635 eval 'require File::Path'; 636 637 # Delete the lib dir 638 unless($@) 639 { 640 File::Path::rmtree($Lib_Dir, 0, 1); 641 } 642 643 # Delete test tables 644 645 if(have_db('pg_admin')) 646 { 647 my $dbh = get_dbh('pg_admin'); 648 649 $dbh->do('DROP TABLE product_colors CASCADE'); 650 $dbh->do('DROP TABLE prices CASCADE'); 651 $dbh->do('DROP TABLE products CASCADE'); 652 $dbh->do('DROP TABLE colors CASCADE'); 653 $dbh->do('DROP TABLE vendors CASCADE'); 654 655 $dbh->disconnect; 656 } 657 658 if(have_db('mysql_admin')) 659 { 660 my $dbh = get_dbh('mysql_admin'); 661 662 $dbh->do('DROP TABLE product_colors CASCADE'); 663 $dbh->do('DROP TABLE prices CASCADE'); 664 $dbh->do('DROP TABLE products CASCADE'); 665 $dbh->do('DROP TABLE colors CASCADE'); 666 $dbh->do('DROP TABLE vendors CASCADE'); 667 668 $dbh->disconnect; 669 } 670 671 if(have_db('informix_admin')) 672 { 673 my $dbh = get_dbh('informix_admin'); 674 675 $dbh->do('DROP TABLE product_colors CASCADE'); 676 $dbh->do('DROP TABLE prices CASCADE'); 677 $dbh->do('DROP TABLE products CASCADE'); 678 $dbh->do('DROP TABLE colors CASCADE'); 679 $dbh->do('DROP TABLE vendors CASCADE'); 680 681 $dbh->disconnect; 682 } 683 684 if(have_db('sqlite_admin')) 685 { 686 my $dbh = get_dbh('sqlite_admin'); 687 688 $dbh->do('DROP TABLE product_colors'); 689 $dbh->do('DROP TABLE prices'); 690 $dbh->do('DROP TABLE products'); 691 $dbh->do('DROP TABLE colors'); 692 $dbh->do('DROP TABLE vendors'); 693 694 $dbh->disconnect; 695 } 696} 697