--- /dev/null
+package SQL::Translator::Parser::XML::XMI::Rational;
+
+# -------------------------------------------------------------------
+# $Id: Rational.pm,v 1.1 2003-09-22 11:41:07 grommit Exp $
+# -------------------------------------------------------------------
+# 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 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 ) = @_;
+ my $pargs = $translator->parser_args;
+ $pargs->{classes2schema} = \&classes2schema;
+ return SQL::Translator::Parser::XML::XMI::parse(@_);
+}
+
+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";
+ }
+ # TODO We need to work out the ref table
+ #elsif ( $stereo eq "FK" ) {
+ # $data{type} = "FOREIGN_KEY";
+ #}
+
+ # 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
+}
+
+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>>.
+
+e.g.
+
+ +------------------------------------------------------+
+ | <<Table>> |
+ | Foo |
+ +------------------------------------------------------+
+ | <<PK>> fooID { dataType=INT size=10 nullable=0 } |
+ | <<Column>> name { dataType=VARCHAR size=255 } |
+ | <<Column>> description { dataType=TEXT } |
+ +------------------------------------------------------+
+ | <<PK>> con1( fooID ) |
+ | <<Unique>> con2( name ) |
+ +------------------------------------------------------+
+
+ CREATE TABLE Foo (
+ fooID INT(10) NOT NULL,
+ name VARCHAR(255),
+ description TEXT,
+ PRIMARY KEY (fooID),
+ UNIQUE (name)
+ );
+
+=head1 ARGS
+
+=head1 BUGS
+
+=head1 TODO
+
+Relationships from associations.
+
+=head1 AUTHOR
+
+Mark D. Addison E<lt>mark.addison@itn.co.ukE<gt>.
+
+=head1 SEE ALSO
+
+perl(1), SQL::Translator::Parser::XML::XMI
+
+=cut
projects / dbsrgits/SQL-Translator.git / blobdiff