The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
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));
    }
}