lib/SQL/Translator/Parser/XML/XMI/Rational.pm

   1 package SQL::Translator::Parser::XML::XMI::Rational;
   2
   3 # -------------------------------------------------------------------
   4 # $Id: Rational.pm,v 1.1 2003-09-22 11:41:07 grommit Exp $
   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;
  31 use SQL::Translator::Parser::XML::XMI;
  32 use SQL::Translator::Utils 'debug';
  33
  34 # Set the parg for the conversion sub then use the XMI parser
  35 sub parse {
  36     my ( $translator ) = @_;
  37     my $pargs = $translator->parser_args;
  38         $pargs->{classes2schema} = \&classes2schema;
  39         return SQL::Translator::Parser::XML::XMI::parse(@_);
  40 }
  41
  42 sub classes2schema {
  43         my ($schema, $classes) = @_;
  44
  45         foreach my $class (@$classes) {
  46         next unless $class->{stereotype} eq "Table";
  47
  48                 # Add the table
  49         debug "Adding class: $class->{name}";
  50         my $table = $schema->add_table( name => $class->{name} )
  51             or die "Schema Error: ".$schema->error;
  52
  53         #
  54         # Fields from Class attributes
  55         #
  56         foreach my $attr ( @{$class->{attributes}} ) {
  57                         next unless $attr->{stereotype} eq "Column"
  58                                 or $attr->{stereotype} eq "PK"
  59                                 or $attr->{stereotype} eq "FK"
  60                                 or $attr->{stereotype} eq "PFK";
  61
  62                         my $ispk =
  63                             $attr->{stereotype} eq "PK" or $attr->{stereotype} eq "PFK"
  64                                 ? 1 : 0;
  65                         my %data = (
  66                 name           => $attr->{name},
  67                 data_type      => $attr->{datatype},
  68                 is_primary_key => $ispk,
  69             );
  70                         $data{default_value} = $attr->{initialValue}
  71                                 if exists $attr->{initialValue};
  72                         $data{data_type} = $attr->{_map_taggedValues}{dataType}{dataValue}
  73                                 || $attr->{datatype};
  74                         $data{size} = $attr->{_map_taggedValues}{size}{dataValue};
  75                         $data{is_nullable}=$attr->{_map_taggedValues}{nullable}{dataValue};
  76
  77             my $field = $table->add_field( %data ) or die $schema->error;
  78             $table->primary_key( $field->name ) if $data{'is_primary_key'};
  79                 }
  80
  81                 #
  82                 # Constraints and indexes from Operations
  83                 #
  84         foreach my $op ( @{$class->{operations}} ) {
  85                         next unless my $stereo = $op->{stereotype};
  86                         my @fields = map {$_->{name}} grep {$_->{kind} ne "return"} @{$op->{parameters}};
  87                         my %data = (
  88                 name      => $op->{name},
  89                 type      => "",
  90                                 fields    => [@fields],
  91             );
  92
  93                         # Work out type and any other data
  94                         if ( $stereo eq "Unique" ) {
  95                                 $data{type} = "UNIQUE";
  96                         }
  97                         elsif ( $stereo eq "PK" ) {
  98                                 $data{type} = "PRIMARY_KEY";
  99                         }
 100                         # TODO We need to work out the ref table
 101                         #elsif ( $stereo eq "FK" ) {
 102                         #       $data{type} = "FOREIGN_KEY";
 103                         #}
 104
 105                         # Add the constraint or index
 106                         if ( $data{type} ) {
 107                                 $table->add_constraint( %data ) or die $schema->error;
 108                         }
 109                         elsif ( $stereo eq "Index" ) {
 110                 $data{type} = "NORMAL";
 111                                 $table->add_index( %data ) or die $schema->error;
 112                         }
 113
 114
 115                 } # Ops loop
 116
 117     } # Classes loop
 118 }
 119
 120 1; #---------------------------------------------------------------------------
 121
 122 __END__
 123
 124 =pod
 125
 126 =head1 SYNOPSIS
 127
 128   use SQL::Translator;
 129   use SQL::Translator::Parser::XML::XMI;
 130
 131   my $translator     = SQL::Translator->new(
 132       from           => 'XML-XMI-Rational',
 133       to             => 'MySQL',
 134       filename       => 'schema.xmi',
 135       show_warnings  => 1,
 136       add_drop_table => 1,
 137   );
 138
 139   print $obj->translate;
 140
 141 =head1 DESCRIPTION
 142
 143 Translates Schema described using Rational Software's UML Data Modeling Profile.
 144 Finding good information on this profile seems to be very difficult so this
 145 is based on a vague white paper and notes in vendors docs!
 146
 147 Below is a summary of what this parser thinks the profile looks like.
 148
 149 B<Tables> Are classes marked with <<Table>> stereotype.
 150
 151 B<Fields> Attributes stereotyped with <<Column>> or one of the key stereotypes.
 152 Additional info is added using tagged values of C<dataType>, C<size> and
 153 C<nullable>. Default value is given using normal UML default value for the
 154 attribute.
 155
 156 B<Keys> Key fields are marked with <<PK>>, <<FK>> or <<PFK>>. Note that this is
 157 really to make it obvious on the diagram, you must still add the constraints.
 158 (This parser will also automatically add the constraint for single field pkeys
 159 for attributes marked with PK but I think this is out of spec.)
 160
 161 B<Constraints> Stereotyped operations, with the names of the parameters
 162 indicating which fields it applies to. Can use <<PK>>, <<FK>>, <<Unique>> or
 163 <<Index>>.
 164
 165 e.g.
 166
 167  +------------------------------------------------------+
 168  |                      <<Table>>                       |
 169  |                         Foo                          |
 170  +------------------------------------------------------+
 171  | <<PK>>     fooID { dataType=INT size=10 nullable=0 } |
 172  | <<Column>> name { dataType=VARCHAR size=255 }        |
 173  | <<Column>> description { dataType=TEXT }             |
 174  +------------------------------------------------------+
 175  | <<PK>>     con1( fooID )                             |
 176  | <<Unique>> con2( name )                              |
 177  +------------------------------------------------------+
 178
 179  CREATE TABLE Foo (
 180    fooID INT(10) NOT NULL,
 181    name VARCHAR(255),
 182    description TEXT,
 183    PRIMARY KEY (fooID),
 184    UNIQUE (name)
 185  );
 186
 187 =head1 ARGS
 188
 189 =head1 BUGS
 190
 191 =head1 TODO
 192
 193 Relationships from associations.
 194
 195 =head1 AUTHOR
 196
 197 Mark D. Addison E<lt>mark.addison@itn.co.ukE<gt>.
 198
 199 =head1 SEE ALSO
 200
 201 perl(1), SQL::Translator::Parser::XML::XMI
 202
 203 =cut