[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Parser / XML / XMI / Rational.pm

package SQL::Translator::Parser::XML::XMI::Rational;

# -------------------------------------------------------------------
# $Id$
# -------------------------------------------------------------------
# Copyright (C) 2003 Mark Addison <mark.addison@itn.co.uk>,
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as
# published by the Free Software Foundation; version 2.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
# 02111-1307  USA
# -------------------------------------------------------------------

=head1 NAME

SQL::Translator::Parser::XML::XMI::Rational - Create Schema using Rational's UML
Data Modeling Profile.

=cut

use strict;

use vars qw[ $DEBUG $VERSION @EXPORT_OK ];
$VERSION = sprintf "%d.%02d", q$Revision$ =~ /(\d+)\.(\d+)/;
$DEBUG   = 0 unless defined $DEBUG;
use Exporter;
use base qw(Exporter);
@EXPORT_OK = qw(parse);

use SQL::Translator::Parser::XML::XMI;
use SQL::Translator::Utils 'debug';

# Set the parg for the conversion sub then use the XMI parser
sub parse {
    my ( $translator ) = @_;
    local $DEBUG  = $translator->debug;
    my $pargs = $translator->parser_args;
	$pargs->{classes2schema} = \&classes2schema;
	return SQL::Translator::Parser::XML::XMI::parse(@_);
}

sub _parameters_in {
	my $params = shift;
	return grep {$_->{kind} ne "return"} @$params;
}

sub classes2schema {
	my ($schema, $classes) = @_;

	foreach my $class (@$classes) {
        next unless $class->{stereotype} eq "Table";

		# Add the table
        debug "Adding class: $class->{name}";
        my $table = $schema->add_table( name => $class->{name} )
            or die "Schema Error: ".$schema->error;

        #
        # Fields from Class attributes
        #
        foreach my $attr ( @{$class->{attributes}} ) {
			next unless $attr->{stereotype} eq "Column"
				or $attr->{stereotype} eq "PK"
				or $attr->{stereotype} eq "FK"
				or $attr->{stereotype} eq "PFK";

			my $ispk =
			    $attr->{stereotype} eq "PK" or $attr->{stereotype} eq "PFK"
				? 1 : 0;
			my %data = (
                name           => $attr->{name},
                data_type      => $attr->{datatype},
                is_primary_key => $ispk,
            );
			$data{default_value} = $attr->{initialValue}
				if exists $attr->{initialValue};
			$data{data_type} = $attr->{_map_taggedValues}{dataType}{dataValue}
				|| $attr->{datatype};
			$data{size} = $attr->{_map_taggedValues}{size}{dataValue};
			$data{is_nullable}=$attr->{_map_taggedValues}{nullable}{dataValue};

            my $field = $table->add_field( %data ) or die $schema->error;
            $table->primary_key( $field->name ) if $data{'is_primary_key'};
		}

		#
		# Constraints and indexes from Operations
		#
        foreach my $op ( @{$class->{operations}} ) {
			next unless my $stereo = $op->{stereotype};
			my @fields = map {$_->{name}} grep {$_->{kind} ne "return"} @{$op->{parameters}};
			my %data = (
                name      => $op->{name},
                type      => "",
				fields    => [@fields],
            );

			# Work out type and any other data
			if ( $stereo eq "Unique" ) {
				$data{type} = "UNIQUE";
			}
			elsif ( $stereo eq "PK" ) {
				$data{type} = "PRIMARY_KEY";
			}
			# Work out the ref table
			elsif ( $stereo eq "FK" ) {
				$data{type} = "FOREIGN_KEY";
				_add_fkey_refs($class,$op,\%data);
			}

			# Add the constraint or index
			if ( $data{type} ) {
				$table->add_constraint( %data ) or die $schema->error;
			}
			elsif ( $stereo eq "Index" ) {
            	$data{type} = "NORMAL";
				$table->add_index( %data ) or die $schema->error;
			}

		} # Ops loop

    } # Classes loop
}

use Data::Dumper;
sub _add_fkey_refs {
	my ($class,$op,$data) = @_;

	# Find the association ends
	my ($end) = grep { $_->{name} eq $op->{name} } @{$class->{associationEnds}};
	return unless $end;
	# Find the fkey op
	my ($refop) = grep { $_->{name} eq $end->{otherEnd}{name} }
		@{$end->{otherEnd}{participant}{operations}};
	return unless $refop;

	$data->{reference_table} = $end->{otherEnd}{participant}{name};
	$data->{reference_fields} = [ map("$_->{name}", _parameters_in($refop->{parameters})) ];
	return $data;
}

1; #---------------------------------------------------------------------------

__END__

=pod

=head1 SYNOPSIS

  use SQL::Translator;
  use SQL::Translator::Parser::XML::XMI;

  my $translator     = SQL::Translator->new(
      from           => 'XML-XMI-Rational',
      to             => 'MySQL',
      filename       => 'schema.xmi',
      show_warnings  => 1,
      add_drop_table => 1,
  );

  print $obj->translate;

=head1 DESCRIPTION

Translates Schema described using Rational Software's UML Data Modeling Profile.
Finding good information on this profile seems to be very difficult so this
is based on a vague white paper and notes in vendors docs!

Below is a summary of what this parser thinks the profile looks like.

B<Tables> Are classes marked with <<Table>> stereotype.

B<Fields> Attributes stereotyped with <<Column>> or one of the key stereotypes.
Additional info is added using tagged values of C<dataType>, C<size> and
C<nullable>. Default value is given using normal UML default value for the
attribute.

B<Keys> Key fields are marked with <<PK>>, <<FK>> or <<PFK>>. Note that this is
really to make it obvious on the diagram, you must still add the constraints.
(This parser will also automatically add the constraint for single field pkeys
for attributes marked with PK but I think this is out of spec.)

B<Constraints> Stereotyped operations, with the names of the parameters
indicating which fields it applies to. Can use <<PK>>, <<FK>>, <<Unique>> or
<<Index>>.

B<Relationships> You can model the relationships in the diagram and have the
translator add the foreign key constraints for you. The forign keys are defined
as <<FK>> operations as show above. To show which table they point to join the
class to the taget classwith an association where the role names are the names
of the constraints to join.

e.g.

 +------------------------------------------------------+
 |                      <<Table>>                       |
 |                         Foo                          |
 +------------------------------------------------------+
 | <<PK>>     fooID { dataType=INT size=10 nullable=0 } |
 | <<Column>> name { dataType=VARCHAR size=255 }        |
 | <<Column>> description { dataType=TEXT }             |
 +------------------------------------------------------+
 | <<PK>>     pkcon( fooID )                             |
 | <<Unique>> con2( name )                              |
 +------------------------------------------------------+
                           |
                           | pkcon
                           |
                           |
                           |
                           |
                           | fkcon
                           |
 +------------------------------------------------------+
 |                      <<Table>>                       |
 |                         Bar                          |
 +------------------------------------------------------+
 | <<PK>>     barID { dataType=INT size=10 nullable=0 } |
 | <<FK>>     fooID { dataType=INT size=10 nullable=0 } |
 | <<Column>> name  { dataType=VARCHAR size=255 }       |
 +------------------------------------------------------+
 | <<PK>>     pkcon( barID )                            |
 | <<FK>>     fkcon( fooID )                            |
 +------------------------------------------------------+

 CREATE TABLE Foo (
   fooID INT(10) NOT NULL,
   name VARCHAR(255),
   description TEXT,
   PRIMARY KEY (fooID),
   UNIQUE con2 (name)
 );

 CREATE TABLE Bar (
   barID INT(10) NOT NULL,
   fooID INT(10) NOT NULL,
   name VARCHAR(255),
   PRIMARY KEY (fooID),
   FOREIGN KEY fkcon (fooID) REFERENCES Foo (fooID)
 );

=head1 ARGS

=head1 BUGS

=head1 TODO

The Rational profile also defines ways to model stuff above tables such as the
actuall db.

=head1 AUTHOR

Mark D. Addison E<lt>mark.addison@itn.co.ukE<gt>.

=head1 SEE ALSO

perl(1), SQL::Translator::Parser::XML::XMI

=cut
Commit	Line	Data
b2a00f50	1	package SQL::Translator::Parser::XML::XMI::Rational;
	2
	3	# -------------------------------------------------------------------
821a0fde	4	# $Id$
b2a00f50	5	# -------------------------------------------------------------------
	6	# Copyright (C) 2003 Mark Addison <mark.addison@itn.co.uk>,
	7	#
	8	# This program is free software; you can redistribute it and/or
	9	# modify it under the terms of the GNU General Public License as
	10	# published by the Free Software Foundation; version 2.
	11	#
	12	# This program is distributed in the hope that it will be useful, but
	13	# WITHOUT ANY WARRANTY; without even the implied warranty of
	14	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
	15	# General Public License for more details.
	16	#
	17	# You should have received a copy of the GNU General Public License
	18	# along with this program; if not, write to the Free Software
	19	# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
	20	# 02111-1307 USA
	21	# -------------------------------------------------------------------
	22
	23	=head1 NAME
	24
	25	SQL::Translator::Parser::XML::XMI::Rational - Create Schema using Rational's UML
	26	Data Modeling Profile.
	27
	28	=cut
	29
	30	use strict;
96f38d80	31
96f38d80	32	use vars qw[ $DEBUG $VERSION @EXPORT_OK ];
821a0fde	33	$VERSION = sprintf "%d.%02d", q$Revision$ =~ /(\d+)\.(\d+)/;
96f38d80	34	$DEBUG = 0 unless defined $DEBUG;
	35	use Exporter;
	36	use base qw(Exporter);
	37	@EXPORT_OK = qw(parse);
	38
b2a00f50	39	use SQL::Translator::Parser::XML::XMI;
	40	use SQL::Translator::Utils 'debug';
	41
	42	# Set the parg for the conversion sub then use the XMI parser
	43	sub parse {
	44	my ( $translator ) = @_;
96f38d80	45	local $DEBUG = $translator->debug;
b2a00f50	46	my $pargs = $translator->parser_args;
	47	$pargs->{classes2schema} = \&classes2schema;
	48	return SQL::Translator::Parser::XML::XMI::parse(@_);
	49	}
	50
a8ae1e5c	51	sub _parameters_in {
	52	my $params = shift;
	53	return grep {$_->{kind} ne "return"} @$params;
	54	}
	55
b2a00f50	56	sub classes2schema {
	57	my ($schema, $classes) = @_;
	58
	59	foreach my $class (@$classes) {
	60	next unless $class->{stereotype} eq "Table";
	61
	62	# Add the table
	63	debug "Adding class: $class->{name}";
	64	my $table = $schema->add_table( name => $class->{name} )
	65	or die "Schema Error: ".$schema->error;
	66
	67	#
	68	# Fields from Class attributes
	69	#
	70	foreach my $attr ( @{$class->{attributes}} ) {
	71	next unless $attr->{stereotype} eq "Column"
	72	or $attr->{stereotype} eq "PK"
	73	or $attr->{stereotype} eq "FK"
	74	or $attr->{stereotype} eq "PFK";
	75
	76	my $ispk =
	77	$attr->{stereotype} eq "PK" or $attr->{stereotype} eq "PFK"
	78	? 1 : 0;
	79	my %data = (
	80	name => $attr->{name},
	81	data_type => $attr->{datatype},
	82	is_primary_key => $ispk,
	83	);
	84	$data{default_value} = $attr->{initialValue}
	85	if exists $attr->{initialValue};
	86	$data{data_type} = $attr->{_map_taggedValues}{dataType}{dataValue}
	87	\|\| $attr->{datatype};
	88	$data{size} = $attr->{_map_taggedValues}{size}{dataValue};
	89	$data{is_nullable}=$attr->{_map_taggedValues}{nullable}{dataValue};
	90
	91	my $field = $table->add_field( %data ) or die $schema->error;
	92	$table->primary_key( $field->name ) if $data{'is_primary_key'};
	93	}
	94
	95	#
	96	# Constraints and indexes from Operations
	97	#
	98	foreach my $op ( @{$class->{operations}} ) {
	99	next unless my $stereo = $op->{stereotype};
	100	my @fields = map {$_->{name}} grep {$_->{kind} ne "return"} @{$op->{parameters}};
	101	my %data = (
	102	name => $op->{name},
	103	type => "",
	104	fields => [@fields],
	105	);
	106
	107	# Work out type and any other data
	108	if ( $stereo eq "Unique" ) {
	109	$data{type} = "UNIQUE";
	110	}
	111	elsif ( $stereo eq "PK" ) {
	112	$data{type} = "PRIMARY_KEY";
	113	}
56c4b15c	114	# Work out the ref table
a8ae1e5c	115	elsif ( $stereo eq "FK" ) {
	116	$data{type} = "FOREIGN_KEY";
	117	_add_fkey_refs($class,$op,\%data);
	118	}
b2a00f50	119
	120	# Add the constraint or index
	121	if ( $data{type} ) {
	122	$table->add_constraint( %data ) or die $schema->error;
	123	}
	124	elsif ( $stereo eq "Index" ) {
	125	$data{type} = "NORMAL";
	126	$table->add_index( %data ) or die $schema->error;
	127	}
	128
b2a00f50	129	} # Ops loop
	130
	131	} # Classes loop
	132	}
	133
a8ae1e5c	134	use Data::Dumper;
	135	sub _add_fkey_refs {
	136	my ($class,$op,$data) = @_;
	137
	138	# Find the association ends
	139	my ($end) = grep { $_->{name} eq $op->{name} } @{$class->{associationEnds}};
a8ae1e5c	140	return unless $end;
	141	# Find the fkey op
	142	my ($refop) = grep { $_->{name} eq $end->{otherEnd}{name} }
	143	@{$end->{otherEnd}{participant}{operations}};
	144	return unless $refop;
	145
	146	$data->{reference_table} = $end->{otherEnd}{participant}{name};
	147	$data->{reference_fields} = [ map("$_->{name}", _parameters_in($refop->{parameters})) ];
	148	return $data;
	149	}
	150
b2a00f50	151	1; #---------------------------------------------------------------------------
	152
	153	__END__
	154
	155	=pod
	156
	157	=head1 SYNOPSIS
	158
	159	use SQL::Translator;
	160	use SQL::Translator::Parser::XML::XMI;
	161
	162	my $translator = SQL::Translator->new(
	163	from => 'XML-XMI-Rational',
	164	to => 'MySQL',
	165	filename => 'schema.xmi',
	166	show_warnings => 1,
	167	add_drop_table => 1,
	168	);
	169
	170	print $obj->translate;
	171
	172	=head1 DESCRIPTION
	173
	174	Translates Schema described using Rational Software's UML Data Modeling Profile.
	175	Finding good information on this profile seems to be very difficult so this
	176	is based on a vague white paper and notes in vendors docs!
	177
	178	Below is a summary of what this parser thinks the profile looks like.
	179
	180	B<Tables> Are classes marked with <<Table>> stereotype.
	181
	182	B<Fields> Attributes stereotyped with <<Column>> or one of the key stereotypes.
	183	Additional info is added using tagged values of C<dataType>, C<size> and
	184	C<nullable>. Default value is given using normal UML default value for the
	185	attribute.
	186
	187	B<Keys> Key fields are marked with <<PK>>, <<FK>> or <<PFK>>. Note that this is
	188	really to make it obvious on the diagram, you must still add the constraints.
	189	(This parser will also automatically add the constraint for single field pkeys
	190	for attributes marked with PK but I think this is out of spec.)
	191
	192	B<Constraints> Stereotyped operations, with the names of the parameters
	193	indicating which fields it applies to. Can use <<PK>>, <<FK>>, <<Unique>> or
	194	<<Index>>.
	195
a8ae1e5c	196	B<Relationships> You can model the relationships in the diagram and have the
	197	translator add the foreign key constraints for you. The forign keys are defined
	198	as <<FK>> operations as show above. To show which table they point to join the
	199	class to the taget classwith an association where the role names are the names
	200	of the constraints to join.
	201
b2a00f50	202	e.g.
	203
	204	+------------------------------------------------------+
	205	\| <<Table>> \|
	206	\| Foo \|
	207	+------------------------------------------------------+
	208	\| <<PK>> fooID { dataType=INT size=10 nullable=0 } \|
	209	\| <<Column>> name { dataType=VARCHAR size=255 } \|
	210	\| <<Column>> description { dataType=TEXT } \|
	211	+------------------------------------------------------+
a8ae1e5c	212	\| <<PK>> pkcon( fooID ) \|
b2a00f50	213	\| <<Unique>> con2( name ) \|
b2a00f50	214	+------------------------------------------------------+
a8ae1e5c	215	\|
	216	\| pkcon
	217	\|
	218	\|
	219	\|
	220	\|
	221	\| fkcon
	222	\|
	223	+------------------------------------------------------+
	224	\| <<Table>> \|
	225	\| Bar \|
	226	+------------------------------------------------------+
	227	\| <<PK>> barID { dataType=INT size=10 nullable=0 } \|
	228	\| <<FK>> fooID { dataType=INT size=10 nullable=0 } \|
	229	\| <<Column>> name { dataType=VARCHAR size=255 } \|
	230	+------------------------------------------------------+
	231	\| <<PK>> pkcon( barID ) \|
	232	\| <<FK>> fkcon( fooID ) \|
	233	+------------------------------------------------------+
b2a00f50	234
	235	CREATE TABLE Foo (
	236	fooID INT(10) NOT NULL,
	237	name VARCHAR(255),
	238	description TEXT,
	239	PRIMARY KEY (fooID),
a8ae1e5c	240	UNIQUE con2 (name)
	241	);
	242
	243	CREATE TABLE Bar (
	244	barID INT(10) NOT NULL,
	245	fooID INT(10) NOT NULL,
	246	name VARCHAR(255),
	247	PRIMARY KEY (fooID),
	248	FOREIGN KEY fkcon (fooID) REFERENCES Foo (fooID)
b2a00f50	249	);
	250
	251	=head1 ARGS
	252
	253	=head1 BUGS
	254
	255	=head1 TODO
	256
a8ae1e5c	257	The Rational profile also defines ways to model stuff above tables such as the
a8ae1e5c	258	actuall db.
b2a00f50	259
	260	=head1 AUTHOR
	261
	262	Mark D. Addison E<lt>mark.addison@itn.co.ukE<gt>.
	263
	264	=head1 SEE ALSO
	265
	266	perl(1), SQL::Translator::Parser::XML::XMI
	267
	268	=cut