[dbsrgits/SQL-Translator.git] / t / 23xml-xmi-parser-rational.t

#!/usr/bin/perl -w 
# vim:filetype=perl

# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'

use strict;
use FindBin qw/$Bin/;
use Data::Dumper;

# run with -d for debug
my %opt;
BEGIN { map { $opt{$_}=1 if s/^-// } @ARGV; }
use constant DEBUG => (exists $opt{d} ? 1 : 0);

use Test::More;
use Test::Exception;
use Test::SQL::Translator qw(maybe_plan);
use SQL::Translator;
use SQL::Translator::Schema::Constants;

BEGIN {
    maybe_plan(92,
        'SQL::Translator::Parser::XML::XMI::Rational',
        'SQL::Translator::Producer::MySQL');
}

# Usefull test subs for the schema objs
#=============================================================================

sub test_field {
    my ($f1,$test) = @_;

	is( $f1->name, $test->{name}, "  Field name '$test->{name}'" );
    
	is( $f1->data_type, $test->{data_type}, "    Type is '$test->{data_type}'" )
	if exists $test->{data_type};
    
	is( $f1->size, $test->{size}, "    Size is '$test->{size}'" )
	if exists $test->{size};
    
	is( $f1->default_value, $test->{default_value},
	"    Default value is ".(defined($test->{default_value}) ? "'$test->{default_value}'" : "UNDEF" ) )
	if exists $test->{default_value};
	
	is( $f1->is_nullable, $test->{is_nullable}, 
		"    ".($test->{is_nullable} ? 'can' : 'cannot').' be null' )
	if exists $test->{is_nullable};
    
	is( $f1->is_unique, $test->{is_unique}, 
		"    ".($test->{is_unique} ? 'can' : 'cannot').' be unique' )
	if exists $test->{is_unique};
    
	is( $f1->is_primary_key, $test->{is_primary_key}, 
		"    is ".($test->{is_primary_key} ? '' : 'not').' a primary_key' )
	if exists $test->{is_primary_key};
    
	is( $f1->is_foreign_key, $test->{is_foreign_key}, 
		"    is ".($test->{is_foreign_key} ? '' : 'not').' a foreign_key' )
	if exists $test->{is_foreign_key};
    
	is( $f1->is_auto_increment, $test->{is_auto_increment}, 
	"    is ".($test->{is_auto_increment} ?  '' : 'not').' an auto_increment' )
	if exists $test->{is_auto_increment};
}

sub constraint_ok {
    my ($con,$test) = @_;
	#$test->{name} ||= "<anon>";

	if ( exists $test->{name} ) {
		is( $con->name, $test->{name}, "  Constraint '$test->{name}'" );
	}
	else {
		ok( $con, "  Constraint" );
	}
	
	is( $con->type, $test->{type}, "    type is '$test->{type}'" )
	if exists $test->{type};
	
	is( $con->table->name, $test->{table}, "    table is '$test->{table}'" )
	if exists $test->{table};
	
	is( join(",",$con->fields), $test->{fields},
	"    fields is '$test->{fields}'" )
	if exists $test->{fields};
	
	is( $con->reference_table, $test->{reference_table},
	"    reference_table is '$test->{reference_table}'" )
	if exists $test->{reference_table};
	
	is( join(",",$con->reference_fields), $test->{reference_fields},
	"    reference_fields is '$test->{reference_fields}'" )
	if exists $test->{reference_fields};
	
	is( $con->match_type, $test->{match_type},
	"    match_type is '$test->{match_type}'" )
	if exists $test->{match_type};
	
	is( $con->on_delete, $test->{on_delete},
	"    on_delete is '$test->{on_delete}'" )
	if exists $test->{on_delete};
	
	is( $con->on_update, $test->{on_update},
	"    on_update is '$test->{on_update}'" )
	if exists $test->{on_update};
}

sub test_table {
    my $tbl = shift;
    my %arg = @_;
	$arg{constraints} ||= [];
    my $name = $arg{name} || die "Need a table name to test.";
    
	my @fldnames = map { $_->{name} } @{$arg{fields}};
	is_deeply( [ map {$_->name}   $tbl->get_fields ],
               [ map {$_->{name}} @{$arg{fields}} ],
               "Table $name\'s fields" );
    foreach ( @{$arg{fields}} ) {
        my $name = $_->{name} || die "Need a field name to test.";
        test_field( $tbl->get_field($name), $_ );
    }
	
	if ( my @tcons = @{$arg{constraints}} ) {
		my @cons = $tbl->get_constraints;
		is(scalar(@cons), scalar(@tcons),
		"Table $name has ".scalar(@tcons)." Constraints");
		foreach ( @cons ) {
			my $ans = { table => $tbl->name, %{shift @tcons}};
			constraint_ok( $_, $ans  );
		}
	}
}

# Testing 1,2,3,..
#=============================================================================

my $testschema = "$Bin/data/xmi/OrderDB.rationalprofile.poseidon2.xmi";
die "Can't find test schema $testschema" unless -e $testschema;

my $obj;
$obj = SQL::Translator->new(
    filename => $testschema,
    from     => 'XML-XMI-Rational',
    to       => 'MySQL',
    debug          => DEBUG,
    show_warnings  => 1,
    add_drop_table => 0,
);
my $sql = $obj->translate;
print $sql if DEBUG;

#
# Test the schema
#
my $scma = $obj->schema;
is( $scma->is_valid, 1, 'Schema is valid' );
my @tblnames = map {$_->name} $scma->get_tables;
is(scalar(@{$scma->get_tables}), scalar(@tblnames), "Right number of tables");
is_deeply( \@tblnames, [qw/Order OrderLine Customer/]
    ,"tables");

test_table( $scma->get_table("Customer"),
    name => "Customer",
    fields => [
    {
        name => "customerID",
        data_type => "INT",
		size => 10,
        default_value => undef,
        is_nullable => 0,
        is_primary_key => 1,
    },
    {
        name => "name",
        data_type => "VARCHAR",
		size => 255,
        default_value => undef,
        is_nullable => 0,
        is_primary_key => 0,
    },
    {
        name => "email",
        data_type => "VARCHAR",
		size => 255,
        default_value => undef,
        is_nullable => 1,
        is_primary_key => 0,
    },
    ],
	constraints => [
		{
			type => "PRIMARY KEY",
			fields => "customerID",
		},
		{
			name => "UniqueEmail",
			type => "UNIQUE",
			fields => "email",
		},
	],
);

test_table( $scma->get_table("Order"),
    name => "Order",
    fields => [
    {
        name => "orderID",
        data_type => "INT",
		size => 10,
        default_value => undef,
        is_nullable => 0,
        is_primary_key => 1,
    },
    {
        name => "customerID",
        data_type => "INT",
		size => 10,
        default_value => undef,
        is_nullable => 0,
        is_primary_key => 0,
        is_foreign_key => 1,
    },
    {
        name => "orderDate",
        data_type => "DATE",
        default_value => undef,
        is_nullable => 0,
        is_primary_key => 0,
    },
    ],
	constraints => [
		{
			type => "PRIMARY KEY",
			fields => "orderID",
		},
		{
			type => "FOREIGN KEY",
			fields => "customerID",
			reference_table => "Customer",
			reference_fields => "customerID",
		},
	],
	# TODO
	#indexes => [
	#	{
	#		name => "idxOrderDate",
	#		type => "INDEX",
	#		fields => "orderDate",
	#	},
	#],
);


test_table( $scma->get_table("OrderLine"),
    name => "OrderLine",
    fields => [
    {
        name => "lineNumber",
        data_type => "INT",
		size => 10,
        default_value => 1,
        is_nullable => 0,
        is_primary_key => 1,
    },
    {
        name => "orderID",
        data_type => "INT",
		size => 10,
        default_value => undef,
        is_nullable => 0,
        is_primary_key => 0,
        is_foreign_key => 1,
    },
    {
        name => "quantity",
        data_type => "INT",
		size => 2,
        default_value => 1,
        is_nullable => 0,
        is_primary_key => 0,
    },
    ],
	constraints => [
		{
			type => "PRIMARY KEY",
			fields => "lineNumber,orderID",
		},
		{
			type => "FOREIGN KEY",
			fields => "orderID",
			reference_table => "Order",
			reference_fields => "orderID",
		},
	],
);
Commit	Line	Data
c76749e1	1	#!/usr/bin/perl -w
	2	# vim:filetype=perl
	3
	4	# Before `make install' is performed this script should be runnable with
	5	# `make test'. After `make install' it should work as `perl test.pl'
	6
	7	use strict;
	8	use FindBin qw/$Bin/;
	9	use Data::Dumper;
	10
	11	# run with -d for debug
	12	my %opt;
	13	BEGIN { map { $opt{$_}=1 if s/^-// } @ARGV; }
	14	use constant DEBUG => (exists $opt{d} ? 1 : 0);
	15
	16	use Test::More;
	17	use Test::Exception;
2d691ec1	18	use Test::SQL::Translator qw(maybe_plan);
c76749e1	19	use SQL::Translator;
	20	use SQL::Translator::Schema::Constants;
	21
2d691ec1	22	BEGIN {
	23	maybe_plan(92,
	24	'SQL::Translator::Parser::XML::XMI::Rational',
	25	'SQL::Translator::Producer::MySQL');
	26	}
	27
c76749e1	28	# Usefull test subs for the schema objs
	29	#=============================================================================
	30
	31	sub test_field {
	32	my ($f1,$test) = @_;
	33
	34	is( $f1->name, $test->{name}, " Field name '$test->{name}'" );
	35
	36	is( $f1->data_type, $test->{data_type}, " Type is '$test->{data_type}'" )
	37	if exists $test->{data_type};
	38
	39	is( $f1->size, $test->{size}, " Size is '$test->{size}'" )
	40	if exists $test->{size};
	41
	42	is( $f1->default_value, $test->{default_value},
	43	" Default value is ".(defined($test->{default_value}) ? "'$test->{default_value}'" : "UNDEF" ) )
	44	if exists $test->{default_value};
	45
	46	is( $f1->is_nullable, $test->{is_nullable},
	47	" ".($test->{is_nullable} ? 'can' : 'cannot').' be null' )
	48	if exists $test->{is_nullable};
	49
	50	is( $f1->is_unique, $test->{is_unique},
	51	" ".($test->{is_unique} ? 'can' : 'cannot').' be unique' )
	52	if exists $test->{is_unique};
	53
	54	is( $f1->is_primary_key, $test->{is_primary_key},
	55	" is ".($test->{is_primary_key} ? '' : 'not').' a primary_key' )
	56	if exists $test->{is_primary_key};
	57
	58	is( $f1->is_foreign_key, $test->{is_foreign_key},
	59	" is ".($test->{is_foreign_key} ? '' : 'not').' a foreign_key' )
	60	if exists $test->{is_foreign_key};
	61
	62	is( $f1->is_auto_increment, $test->{is_auto_increment},
	63	" is ".($test->{is_auto_increment} ? '' : 'not').' an auto_increment' )
	64	if exists $test->{is_auto_increment};
	65	}
	66
	67	sub constraint_ok {
	68	my ($con,$test) = @_;
	69	#$test->{name} \|\|= "<anon>";
	70
	71	if ( exists $test->{name} ) {
	72	is( $con->name, $test->{name}, " Constraint '$test->{name}'" );
	73	}
	74	else {
	75	ok( $con, " Constraint" );
	76	}
	77
	78	is( $con->type, $test->{type}, " type is '$test->{type}'" )
	79	if exists $test->{type};
	80
	81	is( $con->table->name, $test->{table}, " table is '$test->{table}'" )
	82	if exists $test->{table};
	83
	84	is( join(",",$con->fields), $test->{fields},
	85	" fields is '$test->{fields}'" )
	86	if exists $test->{fields};
	87
	88	is( $con->reference_table, $test->{reference_table},
	89	" reference_table is '$test->{reference_table}'" )
	90	if exists $test->{reference_table};
	91
92	is( join(",",$con->reference_fields), $test->{reference_fields},
93	" reference_fields is '$test->{reference_fields}'" )
94	if exists $test->{reference_fields};
95
96	is( $con->match_type, $test->{match_type},
97	" match_type is '$test->{match_type}'" )
98	if exists $test->{match_type};
99
100684f3	100	is( $con->on_delete, $test->{on_delete},
	101	" on_delete is '$test->{on_delete}'" )
	102	if exists $test->{on_delete};
c76749e1	103
100684f3	104	is( $con->on_update, $test->{on_update},
	105	" on_update is '$test->{on_update}'" )
	106	if exists $test->{on_update};
c76749e1	107	}
	108
	109	sub test_table {
	110	my $tbl = shift;
	111	my %arg = @_;
	112	$arg{constraints} \|\|= [];
	113	my $name = $arg{name} \|\| die "Need a table name to test.";
	114
	115	my @fldnames = map { $_->{name} } @{$arg{fields}};
	116	is_deeply( [ map {$_->name} $tbl->get_fields ],
	117	[ map {$_->{name}} @{$arg{fields}} ],
	118	"Table $name\'s fields" );
	119	foreach ( @{$arg{fields}} ) {
	120	my $name = $_->{name} \|\| die "Need a field name to test.";
	121	test_field( $tbl->get_field($name), $_ );
	122	}
	123
	124	if ( my @tcons = @{$arg{constraints}} ) {
	125	my @cons = $tbl->get_constraints;
	126	is(scalar(@cons), scalar(@tcons),
	127	"Table $name has ".scalar(@tcons)." Constraints");
	128	foreach ( @cons ) {
	129	my $ans = { table => $tbl->name, %{shift @tcons}};
	130	constraint_ok( $_, $ans );
	131	}
	132	}
	133	}
	134
	135	# Testing 1,2,3,..
	136	#=============================================================================
	137
c76749e1	138	my $testschema = "$Bin/data/xmi/OrderDB.rationalprofile.poseidon2.xmi";
	139	die "Can't find test schema $testschema" unless -e $testschema;
	140
	141	my $obj;
	142	$obj = SQL::Translator->new(
	143	filename => $testschema,
	144	from => 'XML-XMI-Rational',
	145	to => 'MySQL',
	146	debug => DEBUG,
	147	show_warnings => 1,
	148	add_drop_table => 0,
	149	);
	150	my $sql = $obj->translate;
	151	print $sql if DEBUG;
	152
	153	#
	154	# Test the schema
	155	#
	156	my $scma = $obj->schema;
	157	is( $scma->is_valid, 1, 'Schema is valid' );
	158	my @tblnames = map {$_->name} $scma->get_tables;
	159	is(scalar(@{$scma->get_tables}), scalar(@tblnames), "Right number of tables");
	160	is_deeply( \@tblnames, [qw/Order OrderLine Customer/]
	161	,"tables");
	162
	163	test_table( $scma->get_table("Customer"),
	164	name => "Customer",
	165	fields => [
	166	{
	167	name => "customerID",
	168	data_type => "INT",
	169	size => 10,
	170	default_value => undef,
	171	is_nullable => 0,
	172	is_primary_key => 1,
	173	},
	174	{
	175	name => "name",
	176	data_type => "VARCHAR",
	177	size => 255,
	178	default_value => undef,
	179	is_nullable => 0,
	180	is_primary_key => 0,
	181	},
	182	{
	183	name => "email",
	184	data_type => "VARCHAR",
	185	size => 255,
	186	default_value => undef,
	187	is_nullable => 1,
	188	is_primary_key => 0,
	189	},
	190	],
	191	constraints => [
	192	{
	193	type => "PRIMARY KEY",
	194	fields => "customerID",
	195	},
	196	{
	197	name => "UniqueEmail",
	198	type => "UNIQUE",
	199	fields => "email",
	200	},
	201	],
202	);
203
204	test_table( $scma->get_table("Order"),
205	name => "Order",
206	fields => [
207	{
208	name => "orderID",
209	data_type => "INT",
210	size => 10,
211	default_value => undef,
212	is_nullable => 0,
213	is_primary_key => 1,
214	},
215	{
216	name => "customerID",
217	data_type => "INT",
218	size => 10,
219	default_value => undef,
220	is_nullable => 0,
221	is_primary_key => 0,
222	is_foreign_key => 1,
223	},
224	{
225	name => "orderDate",
226	data_type => "DATE",
227	default_value => undef,
228	is_nullable => 0,
229	is_primary_key => 0,
230	},
231	],
232	constraints => [
233	{
234	type => "PRIMARY KEY",
235	fields => "orderID",
236	},
237	{
238	type => "FOREIGN KEY",
239	fields => "customerID",
240	reference_table => "Customer",
241	reference_fields => "customerID",
242	},
243	],
244	# TODO
245	#indexes => [
246	# {
247	# name => "idxOrderDate",
248	# type => "INDEX",
249	# fields => "orderDate",
250	# },
251	#],
252	);
253
254
255	test_table( $scma->get_table("OrderLine"),
256	name => "OrderLine",
257	fields => [
258	{
259	name => "lineNumber",
260	data_type => "INT",
261	size => 10,
262	default_value => 1,
263	is_nullable => 0,
264	is_primary_key => 1,
265	},
266	{
267	name => "orderID",
268	data_type => "INT",
269	size => 10,
270	default_value => undef,
271	is_nullable => 0,
272	is_primary_key => 0,
273	is_foreign_key => 1,
274	},
275	{
276	name => "quantity",
277	data_type => "INT",
278	size => 2,
279	default_value => 1,
280	is_nullable => 0,
281	is_primary_key => 0,
282	},
283	],
284	constraints => [
285	{
286	type => "PRIMARY KEY",
287	fields => "lineNumber,orderID",
288	},
289	{
290	type => "FOREIGN KEY",
291	fields => "orderID",
292	reference_table => "Order",
293	reference_fields => "orderID",
294	},
295	],
296	);