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

   1 package SQL::Translator::Parser::XML::XMI::Rational;
   2
   3 # -------------------------------------------------------------------
   4 # $Id$
   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
  32 use vars qw[ $DEBUG $VERSION @EXPORT_OK ];
  33 $VERSION = sprintf "%d.%02d", q$Revision$ =~ /(\d+)\.(\d+)/;
  34 $DEBUG   = 0 unless defined $DEBUG;
  35 use Exporter;
  36 use base qw(Exporter);
  37 @EXPORT_OK = qw(parse);
  38
  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 ) = @_;
  45     local $DEBUG  = $translator->debug;
  46     my $pargs = $translator->parser_args;
  47         $pargs->{classes2schema} = \&classes2schema;
  48         return SQL::Translator::Parser::XML::XMI::parse(@_);
  49 }
  50
  51 sub _parameters_in {
  52         my $params = shift;
  53         return grep {$_->{kind} ne "return"} @$params;
  54 }
  55
  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                         }
 114                         # Work out the ref table
 115                         elsif ( $stereo eq "FK" ) {
 116                                 $data{type} = "FOREIGN_KEY";
 117                                 _add_fkey_refs($class,$op,\%data);
 118                         }
 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
 129                 } # Ops loop
 130
 131     } # Classes loop
 132 }
 133
 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}};
 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
 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
 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
 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  +------------------------------------------------------+
 212  | <<PK>>     pkcon( fooID )                             |
 213  | <<Unique>> con2( name )                              |
 214  +------------------------------------------------------+
 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  +------------------------------------------------------+
 234
 235  CREATE TABLE Foo (
 236    fooID INT(10) NOT NULL,
 237    name VARCHAR(255),
 238    description TEXT,
 239    PRIMARY KEY (fooID),
 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)
 249  );
 250
 251 =head1 ARGS
 252
 253 =head1 BUGS
 254
 255 =head1 TODO
 256
 257 The Rational profile also defines ways to model stuff above tables such as the
 258 actuall db.
 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