[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 SQL::Translator;
use SQL::Translator::Schema::Constants;

# 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_do, $test->{on_delete_do},
	"    on_delete_do is '$test->{on_delete_do}'" )
	if exists $test->{on_delete_do};
	
	is( $con->on_update_do, $test->{on_update_do},
	"    on_update_do is '$test->{on_update_do}'" )
	if exists $test->{on_update_do};
}

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,..
#=============================================================================

plan tests => 92;

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