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

   1 package SQL::Translator::Parser::XML::XMI::Rational;
   2
   3 # -------------------------------------------------------------------
   4 # $Id: Rational.pm,v 1.2 2003-10-01 17:47:02 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 _parameters_in {
  43         my $params = shift;
  44         return grep {$_->{kind} ne "return"} @$params;
  45 }
  46
  47 sub classes2schema {
  48         my ($schema, $classes) = @_;
  49
  50         foreach my $class (@$classes) {
  51         next unless $class->{stereotype} eq "Table";
  52
  53                 # Add the table
  54         debug "Adding class: $class->{name}";
  55         my $table = $schema->add_table( name => $class->{name} )
  56             or die "Schema Error: ".$schema->error;
  57
  58         #
  59         # Fields from Class attributes
  60         #
  61         foreach my $attr ( @{$class->{attributes}} ) {
  62                         next unless $attr->{stereotype} eq "Column"
  63                                 or $attr->{stereotype} eq "PK"
  64                                 or $attr->{stereotype} eq "FK"
  65                                 or $attr->{stereotype} eq "PFK";
  66
  67                         my $ispk =
  68                             $attr->{stereotype} eq "PK" or $attr->{stereotype} eq "PFK"
  69                                 ? 1 : 0;
  70                         my %data = (
  71                 name           => $attr->{name},
  72                 data_type      => $attr->{datatype},
  73                 is_primary_key => $ispk,
  74             );
  75                         $data{default_value} = $attr->{initialValue}
  76                                 if exists $attr->{initialValue};
  77                         $data{data_type} = $attr->{_map_taggedValues}{dataType}{dataValue}
  78                                 || $attr->{datatype};
  79                         $data{size} = $attr->{_map_taggedValues}{size}{dataValue};
  80                         $data{is_nullable}=$attr->{_map_taggedValues}{nullable}{dataValue};
  81
  82             my $field = $table->add_field( %data ) or die $schema->error;
  83             $table->primary_key( $field->name ) if $data{'is_primary_key'};
  84                 }
  85
  86                 #
  87                 # Constraints and indexes from Operations
  88                 #
  89         foreach my $op ( @{$class->{operations}} ) {
  90                         next unless my $stereo = $op->{stereotype};
  91                         my @fields = map {$_->{name}} grep {$_->{kind} ne "return"} @{$op->{parameters}};
  92                         my %data = (
  93                 name      => $op->{name},
  94                 type      => "",
  95                                 fields    => [@fields],
  96             );
  97
  98                         # Work out type and any other data
  99                         if ( $stereo eq "Unique" ) {
 100                                 $data{type} = "UNIQUE";
 101                         }
 102                         elsif ( $stereo eq "PK" ) {
 103                                 $data{type} = "PRIMARY_KEY";
 104                         }
 105                         # TODO We need to work out the ref table
 106                         elsif ( $stereo eq "FK" ) {
 107                                 $data{type} = "FOREIGN_KEY";
 108                                 _add_fkey_refs($class,$op,\%data);
 109                         }
 110
 111                         # Add the constraint or index
 112                         if ( $data{type} ) {
 113                                 $table->add_constraint( %data ) or die $schema->error;
 114                         }
 115                         elsif ( $stereo eq "Index" ) {
 116                 $data{type} = "NORMAL";
 117                                 $table->add_index( %data ) or die $schema->error;
 118                         }
 119
 120                 } # Ops loop
 121
 122     } # Classes loop
 123 }
 124
 125 use Data::Dumper;
 126 sub _add_fkey_refs {
 127         my ($class,$op,$data) = @_;
 128
 129         # Find the association ends
 130         my ($end) = grep { $_->{name} eq $op->{name} } @{$class->{associationEnds}};
 131         #my $end;
 132         #foreach $end ( @{$class->{associationEnds}} ) {
 133         #       warn "END: $end->{name} $op->{name}\n";
 134         #       last if $end->{name} eq $op->{name};
 135         #}
 136 warn "END: ",Dumper($end),"\n";
 137         return unless $end;
 138         # Find the fkey op
 139         my ($refop) = grep { $_->{name} eq $end->{otherEnd}{name} }
 140                 @{$end->{otherEnd}{participant}{operations}};
 141         return unless $refop;
 142
 143         $data->{reference_table} = $end->{otherEnd}{participant}{name};
 144         $data->{reference_fields} = [ map("$_->{name}", _parameters_in($refop->{parameters})) ];
 145         return $data;
 146 }
 147
 148 1; #---------------------------------------------------------------------------
 149
 150 __END__
 151
 152 =pod
 153
 154 =head1 SYNOPSIS
 155
 156   use SQL::Translator;
 157   use SQL::Translator::Parser::XML::XMI;
 158
 159   my $translator     = SQL::Translator->new(
 160       from           => 'XML-XMI-Rational',
 161       to             => 'MySQL',
 162       filename       => 'schema.xmi',
 163       show_warnings  => 1,
 164       add_drop_table => 1,
 165   );
 166
 167   print $obj->translate;
 168
 169 =head1 DESCRIPTION
 170
 171 Translates Schema described using Rational Software's UML Data Modeling Profile.
 172 Finding good information on this profile seems to be very difficult so this
 173 is based on a vague white paper and notes in vendors docs!
 174
 175 Below is a summary of what this parser thinks the profile looks like.
 176
 177 B<Tables> Are classes marked with <<Table>> stereotype.
 178
 179 B<Fields> Attributes stereotyped with <<Column>> or one of the key stereotypes.
 180 Additional info is added using tagged values of C<dataType>, C<size> and
 181 C<nullable>. Default value is given using normal UML default value for the
 182 attribute.
 183
 184 B<Keys> Key fields are marked with <<PK>>, <<FK>> or <<PFK>>. Note that this is
 185 really to make it obvious on the diagram, you must still add the constraints.
 186 (This parser will also automatically add the constraint for single field pkeys
 187 for attributes marked with PK but I think this is out of spec.)
 188
 189 B<Constraints> Stereotyped operations, with the names of the parameters
 190 indicating which fields it applies to. Can use <<PK>>, <<FK>>, <<Unique>> or
 191 <<Index>>.
 192
 193 B<Relationships> You can model the relationships in the diagram and have the
 194 translator add the foreign key constraints for you. The forign keys are defined
 195 as <<FK>> operations as show above. To show which table they point to join the
 196 class to the taget classwith an association where the role names are the names
 197 of the constraints to join.
 198
 199 e.g.
 200
 201  +------------------------------------------------------+
 202  |                      <<Table>>                       |
 203  |                         Foo                          |
 204  +------------------------------------------------------+
 205  | <<PK>>     fooID { dataType=INT size=10 nullable=0 } |
 206  | <<Column>> name { dataType=VARCHAR size=255 }        |
 207  | <<Column>> description { dataType=TEXT }             |
 208  +------------------------------------------------------+
 209  | <<PK>>     pkcon( fooID )                             |
 210  | <<Unique>> con2( name )                              |
 211  +------------------------------------------------------+
 212                            |
 213                            | pkcon
 214                            |
 215                            |
 216                            |
 217                            |
 218                            | fkcon
 219                            |
 220  +------------------------------------------------------+
 221  |                      <<Table>>                       |
 222  |                         Bar                          |
 223  +------------------------------------------------------+
 224  | <<PK>>     barID { dataType=INT size=10 nullable=0 } |
 225  | <<FK>>     fooID { dataType=INT size=10 nullable=0 } |
 226  | <<Column>> name  { dataType=VARCHAR size=255 }       |
 227  +------------------------------------------------------+
 228  | <<PK>>     pkcon( barID )                            |
 229  | <<FK>>     fkcon( fooID )                            |
 230  +------------------------------------------------------+
 231
 232  CREATE TABLE Foo (
 233    fooID INT(10) NOT NULL,
 234    name VARCHAR(255),
 235    description TEXT,
 236    PRIMARY KEY (fooID),
 237    UNIQUE con2 (name)
 238  );
 239
 240  CREATE TABLE Bar (
 241    barID INT(10) NOT NULL,
 242    fooID INT(10) NOT NULL,
 243    name VARCHAR(255),
 244    PRIMARY KEY (fooID),
 245    FOREIGN KEY fkcon (fooID) REFERENCES Foo (fooID)
 246  );
 247
 248 =head1 ARGS
 249
 250 =head1 BUGS
 251
 252 =head1 TODO
 253
 254 The Rational profile also defines ways to model stuff above tables such as the
 255 actuall db.
 256
 257 =head1 AUTHOR
 258
 259 Mark D. Addison E<lt>mark.addison@itn.co.ukE<gt>.
 260
 261 =head1 SEE ALSO
 262
 263 perl(1), SQL::Translator::Parser::XML::XMI
 264
 265 =cut