#!/usr/bin/perl -w use strict; use Test::More(); my $Lib_Dir = 't/cg-lib'; unless(-d $Lib_Dir) { mkdir($Lib_Dir); } if(-d $Lib_Dir) { Test::More->import(tests => 2 + (4 * 4)); } else { Test::More->import(skip_all => "Could not mkdir($Lib_Dir) - $!"); } require 't/test-lib.pl'; use_ok('Rose::DB::Object'); use_ok('Rose::DB::Object::Loader'); my $Include_Tables = '^(?:' . join('|', qw(product_colors prices products colors vendors)) . ')$'; $Include_Tables = qr($Include_Tables); my %Column_Defs = ( pg => { id => q(id => { type => 'serial', not_null => 1 },), vendor_id => q(vendor_id => { type => 'integer', not_null => 1 },), }, mysql => { id => q(id => { type => 'serial', not_null => 1 },), vendor_id => q(vendor_id => { type => 'integer', default => '', not_null => 1 },), }, sqlite => { id => q(id => { type => 'serial' },), vendor_id => q(vendor_id => { type => 'integer', not_null => 1 },), }, informix => { id => q(id => { type => 'serial', not_null => 1 },), vendor_id => q(vendor_id => { type => 'integer', not_null => 1 },), }, ); use Config; my $Perl = $^X; if($^O ne 'VMS') { $Perl .= $Config{'_exe'} unless($Perl =~ /$Config{'_exe'}$/i); } # # Tests # foreach my $db_type (qw(pg mysql informix sqlite)) { unless(have_db($db_type)) { SKIP: { skip("$db_type tests", 4) } next; } Rose::DB::Object::Metadata->unregister_all_classes; Rose::DB->default_type($db_type); if($db_type eq 'mysql') { my $serial = Rose::DB->new->dbh->{'Driver'}{'Version'} >= 4.002 ? 'serial' : 'integer'; $Column_Defs{'mysql'}{'id'} = qq(id => { type => '$serial', not_null => 1 },); } my $class_prefix = 'My' . ucfirst($db_type); my $loader = Rose::DB::Object::Loader->new( db_class => 'Rose::DB', class_prefix => $class_prefix, module_preamble => "# My Preamble\n", module_postamble => 'This will be hidden', include_tables => $Include_Tables); $loader->make_modules(module_dir => $Lib_Dir, braces => 'bsd', indent => 2, module_postamble => sub { no warnings 'uninitialized'; "# My Postamble for " . $_[0]->class . " ($_[1])\n"; }); my $mylsq_5_51 = ($db_type eq 'mysql' && Rose::DB->new->database_version >= 5_000_051) ? 1 : 0; # XXX: Lame if(slurp("$Lib_Dir/$class_prefix/Product.pm") !~ /default => '', /) # $mylsq_5_51 { $Column_Defs{$db_type}{'vendor_id'} =~ s/default => '', //; } my $unique_keys; no warnings 'uninitialized'; my($v1, $v2, $v3) = split(/\./, $DBD::Pg::VERSION); if($db_type eq 'pg' && (($v1 >= 2 && $v2 >= 19) || $v1 > 2)) { $unique_keys = qq([ 'name' ],\n [ 'name', 'vendor_id' ],); } else { $unique_keys = qq([ 'name', 'vendor_id' ],\n [ 'name' ],); } is(slurp("$Lib_Dir/$class_prefix/Product.pm"), <<"EOF", "Product 1 - $db_type"); # My Preamble package ${class_prefix}::Product; use strict; use base qw(${class_prefix}::DB::Object::AutoBaseNNN); __PACKAGE__->meta->setup ( table => 'products', columns => [ $Column_Defs{$db_type}{'id'} name => { type => 'varchar', length => 255 }, $Column_Defs{$db_type}{'vendor_id'} ], primary_key_columns => [ 'id' ], unique_keys => [ $unique_keys ], foreign_keys => [ vendor => { class => '${class_prefix}::Vendor', key_columns => { vendor_id => 'id' }, }, ], relationships => [ colors => { map_class => '${class_prefix}::ProductColor', map_from => 'product', map_to => 'color', type => 'many to many', }, prices => { class => '${class_prefix}::Price', column_map => { id => 'product_id' }, type => 'one to many', }, ], ); 1; # My Postamble for ${class_prefix}::Product () EOF is(slurp("$Lib_Dir/$class_prefix/Product/Manager.pm"), <<"EOF", "Product Manager 1 - $db_type"); # My Preamble package ${class_prefix}::Product::Manager; use strict; use base qw(Rose::DB::Object::Manager); use ${class_prefix}::Product; sub object_class { '${class_prefix}::Product' } __PACKAGE__->make_manager_methods('products'); 1; # My Postamble for ${class_prefix}::Product (${class_prefix}::Product::Manager) EOF is(slurp("$Lib_Dir/$class_prefix/Color.pm"), <<"EOF", "Color 1 - $db_type"); # My Preamble package ${class_prefix}::Color; use strict; use base qw(${class_prefix}::DB::Object::AutoBaseNNN); __PACKAGE__->meta->setup ( table => 'colors', columns => [ code => { type => 'character', length => 3, not_null => 1 }, name => { type => 'varchar', length => 255 }, ], primary_key_columns => [ 'code' ], unique_key => [ 'name' ], relationships => [ products => { map_class => '${class_prefix}::ProductColor', map_from => 'color', map_to => 'product', type => 'many to many', }, ], ); 1; # My Postamble for ${class_prefix}::Color () EOF unshift(@INC, $Lib_Dir); # Test actual code by running external script with db type arg my($ok, $script_fh); # Perl 5.8.x and later support the FILEHANDLE,MODE,EXPR,LIST form of # open, but not (apparently) on Windows if($Config{'version'} =~ /^5\.([89]|1\d)\./ && $^O !~ /Win32/i) { $ok = open($script_fh, '-|', $Perl, 't/make-modules.ext', $db_type); } else { $ok = open($script_fh, "$Perl t/make-modules.ext $db_type |"); } if($ok) { chomp(my $line = <$script_fh>); close($script_fh); is($line, 'V1; IS: 1.25, DE: 4.25; green, red; red: CC1', "external test - $db_type"); } else { ok(0, "Failed to open external script for $db_type - $!"); } shift(@INC); } BEGIN { require 't/test-lib.pl'; # # PostgreSQL # if(have_db('pg_admin')) { my $dbh = get_dbh('pg_admin'); # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE product_colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); } $dbh->do(<<"EOF"); CREATE TABLE vendors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) ) EOF $dbh->do(<<"EOF"); CREATE TABLE colors ( code CHAR(3) NOT NULL PRIMARY KEY, name VARCHAR(255), UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE products ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255), vendor_id INT NOT NULL REFERENCES vendors (id), UNIQUE(name, vendor_id), UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE prices ( price_id SERIAL NOT NULL PRIMARY KEY, product_id INT NOT NULL REFERENCES products (id), region CHAR(2) NOT NULL DEFAULT 'US', price DECIMAL(10,2) NOT NULL ) EOF $dbh->do(<<"EOF"); CREATE TABLE product_colors ( id SERIAL NOT NULL PRIMARY KEY, product_id INT NOT NULL REFERENCES products (id), color_code CHAR(3) NOT NULL REFERENCES colors (code) ) EOF $dbh->disconnect; } # # MySQL # eval { my $db = get_db('mysql_admin'); my $dbh = $db->retain_dbh or die Rose::DB->error; my $db_version = $db->database_version; die "MySQL version too old" unless($db_version >= 4_000_000); CLEAR: { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE product_colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); } # Foreign key stuff requires InnoDB support $dbh->do(<<"EOF"); CREATE TABLE vendors ( id INT AUTO_INCREMENT PRIMARY KEY, name VARCHAR(255) ) ENGINE=InnoDB EOF # MySQL will silently ignore the "ENGINE=InnoDB" part and create # a MyISAM table instead. MySQL is evil! Now we have to manually # check to make sure an InnoDB table was really created. my $db_name = $db->database; my $sth = $dbh->prepare("SHOW TABLE STATUS FROM `$db_name` LIKE ?"); $sth->execute('vendors'); my $info = $sth->fetchrow_hashref; no warnings 'uninitialized'; unless(lc $info->{'Type'} eq 'innodb' || lc $info->{'Engine'} eq 'innodb') { die "Missing InnoDB support"; } }; if($@) { have_db(mysql_admin => 0); have_db(mysql => 0); } if(have_db('mysql_admin')) { my $dbh = get_dbh('mysql_admin'); $dbh->do(<<"EOF"); CREATE TABLE colors ( code CHAR(3) NOT NULL PRIMARY KEY, name VARCHAR(255), UNIQUE(name) ) ENGINE=InnoDB EOF $dbh->do(<<"EOF"); CREATE TABLE products ( id INT AUTO_INCREMENT PRIMARY KEY, name VARCHAR(255), vendor_id INT NOT NULL, UNIQUE(name, vendor_id), UNIQUE(name), INDEX(vendor_id), FOREIGN KEY (vendor_id) REFERENCES vendors (id) ) ENGINE=InnoDB EOF $dbh->do(<<"EOF"); CREATE TABLE prices ( price_id INT AUTO_INCREMENT PRIMARY KEY, product_id INT NOT NULL, region CHAR(2) NOT NULL DEFAULT 'US', price DECIMAL(10,2) NOT NULL, INDEX(product_id), FOREIGN KEY (product_id) REFERENCES products (id) ) ENGINE=InnoDB EOF $dbh->do(<<"EOF"); CREATE TABLE product_colors ( id INT AUTO_INCREMENT PRIMARY KEY, product_id INT NOT NULL, color_code CHAR(3) NOT NULL, INDEX(product_id), INDEX(color_code), FOREIGN KEY (product_id) REFERENCES products (id), FOREIGN KEY (color_code) REFERENCES colors (code) ) ENGINE=InnoDB EOF $dbh->disconnect; } # # Informix # if(have_db('informix_admin')) { my $dbh = get_dbh('informix_admin'); # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE product_colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); } $dbh->do(<<"EOF"); CREATE TABLE vendors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) ) EOF $dbh->do(<<"EOF"); CREATE TABLE colors ( code CHAR(3) NOT NULL PRIMARY KEY, name VARCHAR(255), UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE products ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255), vendor_id INT NOT NULL REFERENCES vendors (id), UNIQUE(name, vendor_id), UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE prices ( price_id SERIAL NOT NULL PRIMARY KEY, product_id INT NOT NULL REFERENCES products (id), region CHAR(2) DEFAULT 'US' NOT NULL, price DECIMAL(10,2) NOT NULL ) EOF $dbh->do(<<"EOF"); CREATE TABLE product_colors ( id SERIAL NOT NULL PRIMARY KEY, product_id INT NOT NULL REFERENCES products (id), color_code CHAR(3) NOT NULL REFERENCES colors (code) ) EOF $dbh->disconnect; } # # SQLite # if(have_db('sqlite_admin')) { my $dbh = get_dbh('sqlite_admin'); # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE product_colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); } $dbh->do(<<"EOF"); CREATE TABLE vendors ( id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(255) ) EOF $dbh->do(<<"EOF"); CREATE TABLE colors ( code CHAR(3) NOT NULL PRIMARY KEY, name VARCHAR(255), UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE products ( id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(255), vendor_id INT NOT NULL REFERENCES vendors (id), UNIQUE(name, vendor_id), UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE prices ( price_id INTEGER PRIMARY KEY AUTOINCREMENT, product_id INT NOT NULL REFERENCES products (id), region CHAR(2) NOT NULL DEFAULT 'US', price DECIMAL(10,2) NOT NULL ) EOF $dbh->do(<<"EOF"); CREATE TABLE product_colors ( id INTEGER PRIMARY KEY AUTOINCREMENT, product_id INT NOT NULL REFERENCES products (id), color_code CHAR(3) NOT NULL REFERENCES colors (code) ) EOF $dbh->disconnect; } } sub slurp { my($path) = shift; return undef unless(-e $path); open(my $fh, $path) or die "Could not open '$path' - $!"; my $data = do { local $/; <$fh> }; # Normalize auto-numbered base classes for($data) { s/::DB::Object::AutoBase\d+/::DB::Object::AutoBaseNNN/g; # MySQL 4.1.2 apparently defaults INTEGER NOT NULL columns to 0 s/default => '0',/default => '',/; } return $data; } END { eval 'require File::Path'; # Delete the lib dir unless($@) { File::Path::rmtree($Lib_Dir, 0, 1); } # Delete test tables if(have_db('pg_admin')) { my $dbh = get_dbh('pg_admin'); $dbh->do('DROP TABLE product_colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); $dbh->disconnect; } if(have_db('mysql_admin')) { my $dbh = get_dbh('mysql_admin'); $dbh->do('DROP TABLE product_colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); $dbh->disconnect; } if(have_db('informix_admin')) { my $dbh = get_dbh('informix_admin'); $dbh->do('DROP TABLE product_colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); $dbh->disconnect; } if(have_db('sqlite_admin')) { my $dbh = get_dbh('sqlite_admin'); $dbh->do('DROP TABLE product_colors'); $dbh->do('DROP TABLE prices'); $dbh->do('DROP TABLE products'); $dbh->do('DROP TABLE colors'); $dbh->do('DROP TABLE vendors'); $dbh->disconnect; } }