c7397ac6107fb47fb3490ce320cdb8de102495cf
[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Parser / XML / XMI / Rational.pm
1 package SQL::Translator::Parser::XML::XMI::Rational;
2
3 # -------------------------------------------------------------------
4 # $Id: Rational.pm,v 1.3 2003-10-02 01:40:06 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         return unless $end;
137         # Find the fkey op
138         my ($refop) = grep { $_->{name} eq $end->{otherEnd}{name} }
139                 @{$end->{otherEnd}{participant}{operations}};
140         return unless $refop;
141
142         $data->{reference_table} = $end->{otherEnd}{participant}{name};
143         $data->{reference_fields} = [ map("$_->{name}", _parameters_in($refop->{parameters})) ];
144         return $data;
145 }
146
147 1; #---------------------------------------------------------------------------
148
149 __END__
150
151 =pod
152
153 =head1 SYNOPSIS
154
155   use SQL::Translator;
156   use SQL::Translator::Parser::XML::XMI;
157
158   my $translator     = SQL::Translator->new(
159       from           => 'XML-XMI-Rational',
160       to             => 'MySQL',
161       filename       => 'schema.xmi',
162       show_warnings  => 1,
163       add_drop_table => 1,
164   );
165
166   print $obj->translate;
167
168 =head1 DESCRIPTION
169
170 Translates Schema described using Rational Software's UML Data Modeling Profile.
171 Finding good information on this profile seems to be very difficult so this
172 is based on a vague white paper and notes in vendors docs!
173
174 Below is a summary of what this parser thinks the profile looks like.
175
176 B<Tables> Are classes marked with <<Table>> stereotype.
177
178 B<Fields> Attributes stereotyped with <<Column>> or one of the key stereotypes.
179 Additional info is added using tagged values of C<dataType>, C<size> and
180 C<nullable>. Default value is given using normal UML default value for the
181 attribute.
182
183 B<Keys> Key fields are marked with <<PK>>, <<FK>> or <<PFK>>. Note that this is
184 really to make it obvious on the diagram, you must still add the constraints.
185 (This parser will also automatically add the constraint for single field pkeys
186 for attributes marked with PK but I think this is out of spec.)
187
188 B<Constraints> Stereotyped operations, with the names of the parameters
189 indicating which fields it applies to. Can use <<PK>>, <<FK>>, <<Unique>> or
190 <<Index>>.
191
192 B<Relationships> You can model the relationships in the diagram and have the
193 translator add the foreign key constraints for you. The forign keys are defined
194 as <<FK>> operations as show above. To show which table they point to join the
195 class to the taget classwith an association where the role names are the names
196 of the constraints to join.
197
198 e.g.
199
200  +------------------------------------------------------+
201  |                      <<Table>>                       |
202  |                         Foo                          |
203  +------------------------------------------------------+
204  | <<PK>>     fooID { dataType=INT size=10 nullable=0 } |
205  | <<Column>> name { dataType=VARCHAR size=255 }        |
206  | <<Column>> description { dataType=TEXT }             |
207  +------------------------------------------------------+
208  | <<PK>>     pkcon( fooID )                             |
209  | <<Unique>> con2( name )                              |
210  +------------------------------------------------------+
211                            |
212                            | pkcon
213                            |
214                            |
215                            |
216                            |
217                            | fkcon
218                            |
219  +------------------------------------------------------+
220  |                      <<Table>>                       |
221  |                         Bar                          |
222  +------------------------------------------------------+
223  | <<PK>>     barID { dataType=INT size=10 nullable=0 } |
224  | <<FK>>     fooID { dataType=INT size=10 nullable=0 } |
225  | <<Column>> name  { dataType=VARCHAR size=255 }       |
226  +------------------------------------------------------+
227  | <<PK>>     pkcon( barID )                            |
228  | <<FK>>     fkcon( fooID )                            |
229  +------------------------------------------------------+
230
231  CREATE TABLE Foo (
232    fooID INT(10) NOT NULL,
233    name VARCHAR(255),
234    description TEXT,
235    PRIMARY KEY (fooID),
236    UNIQUE con2 (name)
237  );
238
239  CREATE TABLE Bar (
240    barID INT(10) NOT NULL,
241    fooID INT(10) NOT NULL,
242    name VARCHAR(255),
243    PRIMARY KEY (fooID),
244    FOREIGN KEY fkcon (fooID) REFERENCES Foo (fooID)
245  );
246
247 =head1 ARGS
248
249 =head1 BUGS
250
251 =head1 TODO
252
253 The Rational profile also defines ways to model stuff above tables such as the
254 actuall db.
255
256 =head1 AUTHOR
257
258 Mark D. Addison E<lt>mark.addison@itn.co.ukE<gt>.
259
260 =head1 SEE ALSO
261
262 perl(1), SQL::Translator::Parser::XML::XMI
263
264 =cut