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));
}
}