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