The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/env perl

use strict;
use warnings;

#BEGIN { $ENV{UR_CONTEXT_BASE} = "URT::Context::Testing" };

use File::Basename;
use lib File::Basename::dirname(__FILE__)."/../..";
use URT;
use DBI;
use IO::Pipe;
use Test::More;

if ($^O eq 'darwin') {
    plan skip_all => 'known to fail OS X'
}
elsif ($INC{"UR.pm"} =~ /blib/) {
    plan skip_all => 'skip running during install',
}
else {
    plan tests => 87;
}

use UR::Namespace::Command::Update::ClassesFromDb;
UR::DBI->no_commit(1);

# This can only be run with the cwd at the top of the URT namespace

require Cwd;
my $namespace_dir = URT->get_base_directory_name;
my $working_dir = Cwd::abs_path();
if ($working_dir ne $namespace_dir) {
    if (-d $namespace_dir) {
        chdir($namespace_dir);
    } else {
        die "Cannot determine URT's namespace directory, exiting";
    }
}


cleanup_files();

sub cleanup_files {
    #unlink $sqlite_file;
    #$DB::single = 1;
    my $namespace_dir = URT->get_base_directory_name;

    for my $filename (
        qw|
            Car.pm
            Employee.pm
            Person.pm
            .deleted/Car.pm
            .deleted/Employee.pm
            .deleted/Person.pm
        |
    ) {
        if (-e "$namespace_dir/$filename") {
            #warn "unlinking $filename\n";
            unlink "$namespace_dir/$filename";
        }
    }
}

UR::Namespace::Command::Update::ClassesFromDb->dump_error_messages(1);
UR::Namespace::Command::Update::ClassesFromDb->dump_warning_messages(1);
UR::Namespace::Command::Update::ClassesFromDb->dump_status_messages(0);
UR::Namespace::Command::Update::ClassesFromDb->status_messages_callback(
    sub {
        my $self = shift;
        my $msg = shift;
        print "   $msg\n";
        return 1;
    }
);

# We launch a similar command multiple times.

my($delegate_class,$create_params) = UR::Namespace::Command::Update::ClassesFromDb->resolve_class_and_params_for_argv(qw(--data-source URT::DataSource::SomeSQLite));
ok($delegate_class, "Resolving parameters for update: class is $delegate_class");
my $command_obj = sub {
    my $command_obj = $delegate_class->create(%$create_params, _override_no_commit_for_filesystem_items => 1);
    ok($command_obj, "created new command for " . join(" ", @_));
    ok($command_obj->execute(), "executed new command for " . join(" ",@_));
    return $command_obj->result;
};
bless ($command_obj,"DummyExecutor");
sub DummyExecutor::execute {
    shift->(@_);
}

ok($command_obj, "Created a dummy command object for updating the classes");

my $ds_class = 'URT::DataSource::SomeSQLite';  # The datasource we'll be making tables in
$ds_class->class;
my $dbh = $ds_class->get_default_handle();
ok($dbh, 'Got database handle');

# This wrapper to get_changes filters out things like the command-line parameters
# until that bug is fixed.

my $trans;
sub get_changes {
    my @changes =
        grep { $_->changed_class_name ne 'UR::Namespace::Command::Update::ClassesFromDb' }
        grep { $_->changed_class_name ne "UR::Namespace::CommandParam" }
        grep { $_->changed_class_name ne 'UR::DataSource::Meta' && substr($_->changed_aspect,0,1) ne '_'}
        grep { $_->changed_aspect ne 'query' }
        $trans->get_change_summary();
    return @changes;
}

sub cached_dd_objects {
    my $cx = UR::Context->current;
    my @obj =
        grep { ref($_) =~ /::DB::/ }
        $cx->all_objects_loaded('UR::Object'), $cx->all_objects_loaded('UR::Object::Ghost');
}

sub cached_dd_object_count {
    my $cx = UR::Context->current;
    my @obj =
        grep { ref($_) =~ /::DB::/ }
        $cx->all_objects_loaded('UR::Object'), $cx->all_objects_loaded('UR::Object::Ghost');
    return scalar(@obj);
}

sub cached_class_object_count {
    my $cx = UR::Context->current;
    my @obj =
        grep { ref($_) =~ /UR::Object::/ }
        $cx->all_objects_loaded('UR::Object'), $cx->all_objects_loaded('UR::Object::Ghost');
    return scalar(@obj);
}

sub cached_person_dd_objects {
    my $cx = UR::Context->current;
    my @obj =
        grep { $_->{table_name} eq "person" }
        grep { ref($_) =~ /::DB::/ }
        $cx->all_objects_loaded('UR::Object'), $cx->all_objects_loaded('UR::Object::Ghost');
}

sub cached_person_summary {
    my @obj = map { ref($_) . "\t" . $_->{id} } cached_person_dd_objects();
    return @obj;
}

sub undo_log_summary {
    my @c = do { no warnings; reverse @UR::Context::Transaction::change_log; };
    return
        map { $_->{changed_class_name} . "\t" . $_->{changed_id} . "\t" . $_->{changed_aspect} }
        grep { not ($_->{changed_class_name} =~ /^UR::Object/ and $_->{changed_aspect} eq "load") }
        @c;
}


# Hack - These get filled in at the bottom initialize_check_changes_data_structure()
our($check_changes_1, $check_changes_2, $check_changes_3);
# Empty schema

$trans = UR::Context::Transaction->begin();
ok($trans, "began transaction");

    ok($command_obj->execute(),'Executing update on an empty schema');

    my @changes = get_changes();
    is(scalar(@changes),0, "zero changes for an empty schema");

    # note this for comparison in future tests.
    my $expected_dd_object_count = cached_dd_object_count();

    # don't rollback

# Make a table

ok($dbh->do('CREATE TABLE person (person_id integer NOT NULL PRIMARY KEY, name varchar)'), 'Create person table');
$trans = UR::Context::Transaction->begin();
ok($trans, "CREATED PERSON and began transaction");

        ok($command_obj->execute(),'Executing update after creating person table');

        initialize_check_change_data_structures();
        @changes = get_changes();
        # FIXME The test should probably break out each type of changed thing and check
        # that the counts of each type are correct, and not just the count of all changes
        my $changes_as_hash = convert_change_list_for_checking(@changes);
        is_deeply($changes_as_hash, $check_changes_1, "Change list is correct");

        my $personclass = UR::Object::Type->get('URT::Person');
        isa_ok($personclass, 'UR::Object::Type');  # FIXME why isn't this a UR::Object::Type
        ok($personclass->module_source_lines, 'Person class module has at least one line');
        is($personclass->class_name, 'URT::Person', 'Person class class_name is correct');
        is($personclass->table_name, 'person', 'Person class table_name is correct');
        is($UR::Context::current->resolve_data_sources_for_class_meta_and_rule($personclass)->id, $ds_class, 'Person class data_source is correct');
        is_deeply([sort $personclass->direct_column_names],
                ['name','person_id'],
                'Person object has all the right columns');
        is_deeply([$personclass->direct_id_column_names],
                ['person_id'],
                'Person object has all the right id column names');

        # Another test case should make sure the other class introspection methods like inherited_property_names,
        # all_table_names, etc work correctly for all kinds of objects

        my $module_path = $personclass->module_path;
        ok($module_path, "got a module path");
        ok(-f $module_path, 'Person.pm module exists');

        ok(! UR::Object::Type->get('URT::NonExistantClass'), 'Correctly cannot load a non-existant class');

        $trans->rollback;
        ok($trans->isa("UR::DeletedRef"), "rolled-back transaction");
        is(cached_dd_object_count(), $expected_dd_object_count, "no data dictionary objects cached after rollback");

# Make the employee and car tables refer to person, and add a column to person

ok($dbh->do('CREATE TABLE employee (employee_id integer NOT NULL PRIMARY KEY CONSTRAINT fk_person_id REFERENCES person(person_id), rank integer)'), 'Employee inherits from Person');
ok($dbh->do('ALTER TABLE person ADD COLUMN postal_address varchar'), 'Add column to Person');
ok($dbh->do('CREATE TABLE car (car_id integer NOT NULL PRIMARY KEY, owner_id integer NOT NULL CONSTRAINT fk_person_id2 REFERENCES person(person_id), make varchar, model varchar, color varchar, cost number)'), 'Create car table');

$trans = UR::Context::Transaction->begin();
ok($trans, "CREATED EMPLOYEE AND CAR AND UPDATED PERSON and began transaction");

    ok($command_obj->execute(), 'Updating schema');
    @changes = get_changes();
    $changes_as_hash = convert_change_list_for_checking(@changes);
    is_deeply($changes_as_hash, $check_changes_2, "Change list is correct");

    # Verify the Person.pm and Employee.pm modules exist

    $personclass = UR::Object::Type->get('URT::Person');
    ok($personclass, 'Person class loaded');

    my %got = map { $_ => 1} $personclass->direct_column_names;
    is_deeply(\%got,
            { name => 1, person_id => 1, postal_address => 1 },
            'Person object has all the right columns');
    %got = map { $_ => 1 } $personclass->all_property_names;
    is_deeply(\%got,
            { name => 1, person_id => 1, postal_address => 1 },
            'Person object has all the right properties');
    %got = map { $_ => 1 } $personclass->direct_id_column_names;
    is_deeply(\%got,
            { person_id => 1 },
            'Person object has all the right id column names');

    my $employeeclass = UR::Object::Type->get('URT::Employee');
    ok($employeeclass, 'Employee class loaded');
    isa_ok($employeeclass, 'UR::Object::Type');

    # There is no standardized way to spot inheritance from the schema.
    # The developer can reclassify in the source, and subsequent updates would respect it.
    # FIXME: test for this.
    # What about if one class' primary keys are all foreign keys to all of another class' primary keys?
    # FIXME - what about foreign keys not involving primary keys?  Make object accessor properties

    ok(! $employeeclass->isa('URT::Car'), 'Employee class is correctly not a Car');
    ok($employeeclass->module_source_lines, 'Employee class module has at least one line');

    %got = map { $_ => 1 } $employeeclass->direct_column_names;
    is_deeply(\%got,
            { employee_id => 1, rank => 1 },
            'Employee object has all the right columns');
    %got = map { $_ => 1 } $employeeclass->all_property_names;
    is_deeply(\%got,
            { employee_id => 1, person_employee => 1, rank => 1 },
            'Employee object has all the right properties');
    %got = map { $_ => 1 } $employeeclass->direct_id_column_names;
    is_deeply(\%got,
             { employee_id => 1 },
            'Employee object has all the right id column names');
    ok($employeeclass->table_name eq 'employee', 'URT::Employee object comes from the employee table');


    my $carclass = UR::Object::Type->get('URT::Car');
    ok($carclass, 'Car class loaded');
    is($carclass->class_name,'URT::Car', "class name is set correctly");
    isa_ok($carclass,'UR::Object::Type');
    ok(! $carclass->class_name->isa('URT::Person'), 'Car class is correctly not a Person');

    %got = map { $_ => 1 } $carclass->direct_column_names;
    is_deeply(\%got,
            { car_id => 1, color => 1, cost => 1, make => 1, model => 1, owner_id => 1 },
            'Car object has all the right columns');
    %got = map { $_ => 1 } $carclass->all_property_names;
    is_deeply(\%got, 
            { car_id => 1, color => 1, cost => 1, make => 1, model => 1, owner_id => 1, person_owner => 1 },
            'Car object has all the right properties');
    %got = map { $_ => 1 } $carclass->direct_id_column_names;
    is_deeply(\%got,
            { car_id => 1 },
            'Car object has all the right id column names');
        ok($carclass->table_name eq 'car', 'Car object comes from the car table');

    $trans->rollback;
    ok($trans->isa("UR::DeletedRef"), "rolled-back transaction");
    is(cached_dd_object_count(), $expected_dd_object_count, "no data dictionary objects cached after rollback");

# Drop a table

ok($dbh->do('DROP TABLE car'),'Removed Car table');
$trans = UR::Context::Transaction->begin();
ok($trans, "DROPPED CAR and began transaction");

    ok($command_obj->execute(), 'Updating schema');
    @changes = get_changes();
    $changes_as_hash = convert_change_list_for_checking(@changes);
    is_deeply($changes_as_hash, $check_changes_3, "Change list is correct");

    ok($personclass = UR::Object::Type->get('URT::Person'),'Loaded Person class');
    ok($employeeclass = UR::Object::Type->get('URT::Employee'), 'Loaded Employee class');

    $carclass = UR::Object::Type->get('URT::Car');
    ok(!$carclass, 'Car class is correctly not loaded');

    $trans->rollback;
    ok($trans->isa("UR::DeletedRef"), "rolled-back transaction");
    is(cached_dd_object_count(), $expected_dd_object_count, "no data dictionary objects cached after rollback");


# Drop a constraint
# SQLite doesn't support altering a table to drop a constraint, so we need to
# drop the table and recreate it without the constraint
#ok($dbh->do('DROP TABLE employee'), 'Temporarily dropping table employee');
#ok($dbh->do('CREATE TABLE employee (employee_id integer NOT NULL PRIMARY KEY, rank integer)'), 'Recreate Employee without constraint');
#$trans = UR::Context::Transaction->begin();
#ok($trans, "Changed EMPLOYEE and began transaction");
#
#    ok($command_obj->execute(), 'Updating schema');
#    my @o = UR::DataSource::RDBMS::FkConstraint->get(namespace => 'URT');
#print "\n\n*** Got ",scalar(@o)," FkConstraints\n";
#    @changes = get_changes();
#    $changes_as_hash = convert_change_list_for_checking(@changes);
#


# Drop the other two tables

ok($dbh->do('DROP TABLE employee'),'Removed employee table');
ok($dbh->do('DROP TABLE person'),'Removed person table');
ok($dbh->do('CREATE TABLE person (person_id integer NOT NULL PRIMARY KEY, postal_address varchar)'), 'Replaced table person w/o column "name".');
    #ok($dbh->do('ALTER TABLE person DROP column name'),'Removed the name column from the person table'); ##<won't work
$trans = UR::Context::Transaction->begin();
ok($trans, "DROPPED EMPLOYEE AND UPDATED PERSON began transaction");

    ok($command_obj->execute(), 'Updating schema');
    @changes = get_changes();
    is(scalar(@changes), 15, "found changes for two more dropped tables");

$trans = UR::Context::Transaction->begin();
ok($trans, "Restarted transaction since some data is not really sync'd at sync_filesystem");
ok($command_obj->execute(), 'Updating schema anew.');


    ok(! UR::Object::Type->get('URT::Employee'), 'Correctly could not load Employee class');
    ok(! UR::Object::Type->get('URT::Car'),'Correctly could not load Car class');

    $personclass = UR::Object::Type->get('URT::Person');
    unless ($personclass) {
        #$DB::single = 1;
    }
    $personclass->ungenerate;
    #$DB::single = 1;
    $personclass->generate;
    ok($personclass, 'Person class loaded');
    is_deeply([sort $personclass->direct_column_names],
            ['person_id','postal_address'],
            'Person object has all the right columns');
    is_deeply([sort $personclass->class_name->__meta__->all_property_names],
            ['person_id','postal_address'],
            'Person object has all the right properties');
    is_deeply([$personclass->direct_id_column_names],
            ['person_id'],
            'Person object has all the right id column names');

    $trans->rollback;
    ok($trans->isa("UR::DeletedRef"), "rolled-back transaction");
    is(cached_dd_object_count(), $expected_dd_object_count, "no data dictionary objects cached after rollback");

# Clean up after now-defunct class module files and SQLIte DB file

cleanup_files();

sub child_db_interaction {
my $dbfile = shift;

    my $pid;
    my $result = IO::Pipe->new();
    my $to_child = IO::Pipe->new();
    if ($pid = fork()) {
        $to_child->writer;
        $to_child->autoflush(1);
        $result->reader();
        my @commands = map {$_ . "\n"} @_;

        foreach my $cmd ( @commands ) {
            $to_child->print($cmd);

            my $result = $result->getline();
            chomp($result);
            my($retval,$string,$dbierr) = split(';',$result);
            return undef unless $retval;
        }

        $to_child->print("exit\n");
        waitpid($pid,0);
        return 1;

    } else {
        $to_child->reader();
        $result->writer();
        $result->autoflush(1);

        my $dbh = DBI->connect("dbi:SQLite:dbname=$dbfile","","");
        unless ($dbh) {
            $result->print("0;can't connect;$DBI::errstr\n");
            exit(1);
        }

        while(my $sql = $to_child->getline()) {
            chomp($sql);
            last if ($sql eq 'exit' || !$sql);

            my $sth = $dbh->prepare($sql);
            unless ($sth) {
                $result->print("0;prepare failed;$DBI::errstr\n");
                $result->print("0;prepare failed;$DBI::errstr\n");
                next;
            }
            my $retval = $sth->execute();
            if ($retval) {
                $result->print($retval . "\n");
            } else {
                $result->print("0;execute failed;$DBI::errstr\n");
            }
        }
        $dbh->commit();

        exit(0);
    } # end child
}


# Convert the list of changes to a data structure matching the expected changes
sub convert_change_list_for_checking {
    my(@changes_list) = @_;
    my $changes = {};
    foreach my $change ( @changes_list ) {
        my $changed_class_name = $change->{'changed_class_name'};
        my $changed_id = $change->{'changed_id'};
        my $changed_aspect = $change->{'changed_aspect'};
        next if $changed_aspect eq 'query';
        my $undo_data = $change->{'undo_data'};
        if (exists $changes->{$changed_class_name}->{$changed_id}->{$changed_aspect}) {
            die "Two types of changes for the same thing in the same transaction!?";
        }


        $changes->{$changed_class_name}->{$changed_id}->{$changed_aspect} = defined($undo_data);
    }

    return $changes;
}
    

    
# These expected change data structures work like this:
# Based on the UR::Change objects, the first level hash key is
# the changed_class_name, second level key is the changed_id,
# the third level key is the changed_aspect, and the final value
# is whether the undo_data is defined or not.
#
# Note that because of the way this testcase works, by creating a
# transaction, updating metadata, and the rolling back the transaction,
# all these metadata objects are always "created" as new, and not
# modifications of existing things.
#
# There should probably be tests for the usual case where you would be
# updating existing classes based on DB changes

# Changes after creating the person table and running ur update classes

sub initialize_check_change_data_structures {
    my $sqlite_owner = 'main';
    $check_changes_1 = {
    'UR::DataSource::RDBMS::Table' => {
        "URT::DataSource::SomeSQLite\t$sqlite_owner\tperson" => {
            create => '',    # Meta DB object is created for the person table
            er_type => '',    # And ur update classes fills in an er_type
         },
    },
    'UR::DataSource::RDBMS::TableColumn' => {
        # The (new) person table has 2 (new) columns, person_id and name
        "URT::DataSource::SomeSQLite\t$sqlite_owner\tperson\tperson_id" => {
            create => ''
        },
        "URT::DataSource::SomeSQLite\t$sqlite_owner\tperson\tname" => {
            create => ''
        },
    },
    'UR::DataSource::RDBMS::PkConstraintColumn' => {
        # person_id is the first and only primary column constraint
        "URT::DataSource::SomeSQLite\t$sqlite_owner\tperson\tperson_id\t1" => {
            create => ''
        },
    },
    'UR::Object::Type' => {
        # A new metaclass gets created for the person table
        'URT::Person::Type' => {
            create => ''
        },
    },
    'URT::Person::Type' => {
        'URT::Person' => {
            create => '', # And then the class that goes with the table
            rewrite_module_header => 1, # And a record that we wrote a perl module on the filesystem
        },
    },
    'UR::Object::Property' => {
        # Two new properties for the person class, name and person_id
        "URT::Person\tname" => {
            create => ''
        }, 
        "URT::Person\tperson_id" => {
            create => '',
            is_id  => '',   # Created as an ID property
        },
    },
};
                        

# Changes after creating the car and employee tables, and adding postal_address column to person
    $check_changes_2 = {
    'UR::DataSource::RDBMS::Table' => {
        # 3 tables: person, employee and car
        "URT::DataSource::SomeSQLite\t$sqlite_owner\tperson" => {
            create => '',
            er_type => '',
        },
        "URT::DataSource::SomeSQLite\t$sqlite_owner\temployee" => {
            create => '',
            er_type => '',
        },
        "URT::DataSource::SomeSQLite\t$sqlite_owner\tcar" => {
            create => '',
            er_type => '',
        },
    },

    'UR::DataSource::RDBMS::TableColumn' => {
        # Table person now has 3 columns: person_id, name and postal_address
        "URT::DataSource::SomeSQLite\t$sqlite_owner\tperson\tperson_id" => {
            create => '',
        },
        "URT::DataSource::SomeSQLite\t$sqlite_owner\tperson\tname" => {
            create => '',
        },
        "URT::DataSource::SomeSQLite\t$sqlite_owner\tperson\tpostal_address" => {
            create => '',
        },
        # table employee has 2 columns: employee_id and rank
        "URT::DataSource::SomeSQLite\t$sqlite_owner\temployee\temployee_id" => {
            create => '',
        },
        "URT::DataSource::SomeSQLite\t$sqlite_owner\temployee\trank" => {
            create => '',
        },
        # table car has these columns: car_id, make, model, color and cost
        "URT::DataSource::SomeSQLite\t$sqlite_owner\tcar\tcar_id" => {
            create => '',
        },
        "URT::DataSource::SomeSQLite\t$sqlite_owner\tcar\tmake" => {
            create => '',
        },
        "URT::DataSource::SomeSQLite\t$sqlite_owner\tcar\tmodel" => {
            create => '',
        },
        "URT::DataSource::SomeSQLite\t$sqlite_owner\tcar\tcolor" => {
            create => '',
        },
        "URT::DataSource::SomeSQLite\t$sqlite_owner\tcar\tcost" => {
            create => '',
        },
        "URT::DataSource::SomeSQLite\t$sqlite_owner\tcar\towner_id" => {
            create => '',
        },
    },

    'UR::DataSource::RDBMS::FkConstraint' => {
       # Both employee and car tables have foreign keys to person
        "URT::DataSource::SomeSQLite\t$sqlite_owner\t$sqlite_owner\temployee\tperson\tfk_person_id" => {
            create => '',
        },
        "URT::DataSource::SomeSQLite\t$sqlite_owner\t$sqlite_owner\tcar\tperson\tfk_person_id2" => {
            create => '',
        },
    },

    'UR::DataSource::RDBMS::FkConstraintColumn' => {
        # The employee table FK points from employee_id to person_id
        "URT::DataSource::SomeSQLite\t$sqlite_owner\temployee\tfk_person_id\temployee_id" => {
            create => '',
        },
        # The car table FK points from owner_id to person_id
        "URT::DataSource::SomeSQLite\t$sqlite_owner\tcar\tfk_person_id2\towner_id" => {
            create => '',
        }
    },

    'UR::DataSource::RDBMS::PkConstraintColumn' => {
        # All three tables have PK constraints for their ID columns
        "URT::DataSource::SomeSQLite\t$sqlite_owner\tperson\tperson_id\t1" => {
            create => '',
        },
        "URT::DataSource::SomeSQLite\t$sqlite_owner\temployee\temployee_id\t1" => {
            create => '',
        },
        "URT::DataSource::SomeSQLite\t$sqlite_owner\tcar\tcar_id\t1" => {
            create => '',
        },
    },

    # running ur update classes makes 3 new classes
    'UR::Object::Type' => {
        "URT::Car::Type" => {
            create => '',
        },
        "URT::Employee::Type" => {
            create => '',
        },
        "URT::Person::Type" => {
            create => '',
        },
    },
  
    # Each class has a property for the respective tablecolumn
    'UR::Object::Property' => {
        "URT::Car\tcar_id" => {
            create => '',
            is_id  => '',
        },
        "URT::Car\tcolor" => {
            create => '',
        },
        "URT::Car\tcost" => {
            create => '',
        },
        "URT::Car\tmake" => {
            create => '',
        },
        "URT::Car\tmodel" => {
            create => '',
        },
        "URT::Car\towner_id" => {
            create => '',
        },
        "URT::Car\tperson_owner" => {
            create => '',
        },

        "URT::Employee\temployee_id" => {
           create => '',
           is_id  => '',
        },
        "URT::Employee\trank" => {
           create => '',
        },
        "URT::Employee\tperson_employee" => {
            create => '',
        },

        "URT::Person\tname" => {
           create => '',
        },
        "URT::Person\tperson_id" => {
           create => '',
           is_id  => '',
        },
        "URT::Person\tpostal_address" => {
           create => '',
        },
    },

    # There a record of creating an instance of each class, and 
    # that we wrote a perl module on the filesystem
    'URT::Car::Type' => {
        'URT::Car' => {
            create => '',
            rewrite_module_header => 1,
        },
    },
    'URT::Employee::Type' => {
        'URT::Employee' => {
            create => '',
            rewrite_module_header => 1,
        },
    },
    'URT::Person::Type' => {
        'URT::Person' => {
            create => '',
            rewrite_module_header => 1,
        },
    },

    # Because we rolled back the previous transaction, the old metadata
    # objects became ghosts.  This is suboptimal and makes little sense
    # but there it is...
    'UR::DataSource::RDBMS::Table::Ghost' => {
        "URT::DataSource::SomeSQLite\t$sqlite_owner\tperson" => {
            delete => 1,
        },
    },
    'UR::DataSource::RDBMS::TableColumn::Ghost' => {
        "URT::DataSource::SomeSQLite\t$sqlite_owner\tperson\tperson_id" => {
            delete => 1,
        },
        "URT::DataSource::SomeSQLite\t$sqlite_owner\tperson\tname" => {
            delete => 1,
        },
    },
    'UR::DataSource::RDBMS::PkConstraintColumn::Ghost' => {
        "URT::DataSource::SomeSQLite\t$sqlite_owner\tperson\tperson_id\t1" => {
            delete => 1,
        },
    },
};



# After removing the car table
    $check_changes_3 = {
    # FIXME Why are there no ghost objects for the dropped car stuff?

    'UR::DataSource::RDBMS::Table' => {
        "URT::DataSource::SomeSQLite\t$sqlite_owner\temployee" => {
            create => '',
            er_type => '',
        },
        "URT::DataSource::SomeSQLite\t$sqlite_owner\tperson" => {
            create => '',
            er_type => '',
        },
    },

    'UR::DataSource::RDBMS::TableColumn' => {
        "URT::DataSource::SomeSQLite\t$sqlite_owner\temployee\temployee_id" => {
            create => '',
        },
        "URT::DataSource::SomeSQLite\t$sqlite_owner\temployee\trank" => {
            create => '',
        },
        "URT::DataSource::SomeSQLite\t$sqlite_owner\tperson\tperson_id" => {
            create => '',
        },
        "URT::DataSource::SomeSQLite\t$sqlite_owner\tperson\tname" => {
            create => '',
        },
        "URT::DataSource::SomeSQLite\t$sqlite_owner\tperson\tpostal_address" => {
            create => '',
        },
    },

    'UR::DataSource::RDBMS::FkConstraint' => {
        "URT::DataSource::SomeSQLite\t$sqlite_owner\t$sqlite_owner\temployee\tperson\tfk_person_id" => {
            create => '',
        },
    },

    'UR::DataSource::RDBMS::FkConstraintColumn' => {
        "URT::DataSource::SomeSQLite\t$sqlite_owner\temployee\tfk_person_id\temployee_id" => {
            create => '',
        },
    },

    'UR::DataSource::RDBMS::PkConstraintColumn' => {
        "URT::DataSource::SomeSQLite\t$sqlite_owner\temployee\temployee_id\t1" => {
            create => '',
        },
        "URT::DataSource::SomeSQLite\t$sqlite_owner\tperson\tperson_id\t1" => {
            create => '',
        },
    },


    'URT::Employee::Type' => {
        'URT::Employee' => {
            create => '',
            rewrite_module_header => 1,
        },
    },
    'URT::Person::Type' => {  
        'URT::Person' => {
           create => '',
            rewrite_module_header => 1,
        },
    },

    'UR::Object::Type' => {
        'URT::Person::Type' => {
            create => '',
        },
        'URT::Employee::Type' => {
            create => '',
        },
    },

    'UR::Object::Property' => {
        "URT::Employee\temployee_id" => {
            create => '',
            is_id  => '',
        },
        "URT::Employee\trank" => {
            create => '',
        },
        "URT::Employee\tperson_employee" => {
            create => '',
        },

        "URT::Person\tperson_id" => {
            create => '',
            is_id  => '',
        },
        "URT::Person\tname" => {
            create => '',
        },
        "URT::Person\tpostal_address" => {
            create => '',
        },
    },

    'UR::DataSource::RDBMS::Table::Ghost' => {
        "URT::DataSource::SomeSQLite\t$sqlite_owner\tperson" => {
            delete => 1,
        },
        "URT::DataSource::SomeSQLite\t$sqlite_owner\temployee" => {
            delete => 1,
        },
    },
    'UR::DataSource::RDBMS::TableColumn::Ghost' => {
        "URT::DataSource::SomeSQLite\t$sqlite_owner\temployee\temployee_id" => {
            delete => 1,
        },
        "URT::DataSource::SomeSQLite\t$sqlite_owner\temployee\trank" => {
            delete => 1,
        },
        "URT::DataSource::SomeSQLite\t$sqlite_owner\tperson\tperson_id" => {
            delete => 1,
        },
        "URT::DataSource::SomeSQLite\t$sqlite_owner\tperson\tname" => {
            delete => 1,
        },
        "URT::DataSource::SomeSQLite\t$sqlite_owner\tperson\tpostal_address" => {
            delete => 1,
        },
    },
    'UR::DataSource::RDBMS::FkConstraint::Ghost' => {
        "URT::DataSource::SomeSQLite\t$sqlite_owner\t$sqlite_owner\temployee\tperson\tfk_person_id" => {
            delete => 1,
        },
    },
    'UR::DataSource::RDBMS::FkConstraintColumn::Ghost' => {
        "URT::DataSource::SomeSQLite\t$sqlite_owner\temployee\tfk_person_id\temployee_id" => {
            delete => 1,
        },
    },
    'UR::DataSource::RDBMS::PkConstraintColumn::Ghost' => {
        "URT::DataSource::SomeSQLite\t$sqlite_owner\temployee\temployee_id\t1" => {
            delete => 1,
        },
        "URT::DataSource::SomeSQLite\t$sqlite_owner\tperson\tperson_id\t1" => {
            delete => 1,
        },
    },

};
}

1;