use strict; use warnings; use Test::More; use File::Basename; use File::Temp; use Cwd; use lib Cwd::abs_path(File::Basename::dirname(__FILE__)."/../../../lib"); # for UR our $initial_dir; our $tempdir; BEGIN { eval "use Archive::Tar"; if (1) { plan skip_all => 'this always fails during cpanm install for an unknown reason', } elsif ($INC{"UR.pm"} =~ /blib/) { plan skip_all => 'skip running during install', exit; } elsif ($@ =~ qr(Can't locate Archive/Tar.pm in \@INC)) { plan skip_all => 'Archive::Tar does not exist on the system'; exit; } else { plan tests => 36; } $initial_dir = Cwd::cwd; my $tarfile = Cwd::abs_path(File::Basename::dirname(__FILE__).'/02_update_classes.tar.gz'); $tempdir = File::Temp::tempdir(CLEANUP => 1); chdir($tempdir); my $tar = Archive::Tar->new($tarfile); ok($tar->extract, 'Extract initial filesystem'); } END { chdir $initial_dir; # so File::Temp can clean up the tempdir } use lib $tempdir.'/namespace'; use lib $tempdir.'/classes'; use lib $tempdir.'/data_source'; use lib $tempdir.'/more_classes'; use URTAlternate; UR::DBI->no_commit(0); # UR's test harness defaults to no_commit = 1 my $cmd = UR::Namespace::Command::Update::ClassesFromDb->create(namespace_name => 'URTAlternate'); ok($cmd, 'Create update classes command'); $cmd->queue_status_messages(1); $cmd->queue_warning_messages(1); $cmd->queue_error_messages(1); $cmd->dump_status_messages(0); $cmd->dump_warning_messages(0); $cmd->dump_error_messages(0); ok($cmd->execute, 'execute update classes with no changes'); my $messages = join("\n",$cmd->status_messages()); like($messages, qr(Updating namespace: URTAlternate), 'Status message showing namespace'); like($messages, qr(Found data sources: TheDB), 'Found the data source'); like($messages, qr(No data schema changes), 'No schema changes'); like($messages, qr(No class changes), 'No class changes'); my @messages = $cmd->warning_messages(); is(scalar(@messages), 0, 'no warning messages'); @messages = $cmd->error_messages(); is(scalar(@messages), 0, 'no error messages'); my $dbh = URTAlternate::DataSource::TheDB->get_default_handle(); ok($dbh, 'Got handle for database'); ok($dbh->do('CREATE TABLE employee (employee_id integer NOT NULL PRIMARY KEY REFERENCES person(person_id), office varchar NOT NULL)'), 'Add employee table'); ok($dbh->do('ALTER TABLE car ADD COLUMN owner_id integer REFERENCES person(person_id)'), 'Add owner_id column to car table'); ok($dbh->commit, 'commit table changes'); # SQLite seems to have an issue where "PRAGMA foreign_key_list()" doesn't return # the newly added foreign key info from the ALTER TABLE car. Workaround is to disconnect # and re-connect URTAlternate::DataSource::TheDB->disconnect_default_handle(); $dbh = URTAlternate::DataSource::TheDB->get_default_handle(); my $sth = $dbh->prepare("PRAGMA foreign_key_list(car)"); $sth->execute(); my $data = $sth->fetchall_arrayref(); $cmd = UR::Namespace::Command::Update::ClassesFromDb->create(namespace_name => 'URTAlternate', _override_no_commit_for_filesystem_items => 1); ok($cmd, 'Create update classes command after adding table'); $cmd->dump_status_messages(1); $cmd->dump_warning_messages(1); $cmd->dump_error_messages(1); $cmd->dump_status_messages(0); $cmd->dump_warning_messages(0); $cmd->dump_error_messages(0); ok($cmd->execute(), 'execute update classes after changes'); ok(-f "${tempdir}/namespace/URTAlternate.pm", 'Namespace module exists'); ok(-f "${tempdir}/data_source/URTAlternate/DataSource/TheDB.pm", 'Data source module exists'); ok(-f "${tempdir}/classes/URTAlternate/Person.pm", 'Person module exists'); ok(-f "${tempdir}/more_classes/URTAlternate/Car.pm", 'Car module exists'); ok(-f "${tempdir}/namespace/URTAlternate/Employee.pm", 'Employee module exists'); # new stuff gets created in the namespace dir foreach my $class_props ( [ 'URTAlternate::Person' => ['person_id', 'name'] ], [ 'URTAlternate::Car' => ['car_id', 'make', 'model', 'owner_id', 'person_owner'] ], [ 'URTAlternate::Employee' => ['employee_id', 'office', 'person_employee'] ] ) { my($class_name, $expected_properties) = @$class_props; my $class_meta = $class_name->__meta__; ok($class_meta, "Got class metaobject for $class_name"); my %expected_properties = map { $_ => 1 } @$expected_properties; my %got_properties = map { $_->property_name => 1 } UR::Object::Property->get(class_name => $class_name); foreach my $property ( keys %expected_properties ) { ok(delete $got_properties{$property}, "Found property $property for class $class_name"); } ok(!scalar(keys %got_properties), 'no extra properties'); if (keys %got_properties) { diag('Extra properties that were not expected: ', join(', ', keys %got_properties)); } }