1 package SQL::Translator::Parser::XML::XMI::SQLFairy;
3 # -------------------------------------------------------------------
4 # $Id: SQLFairy.pm,v 1.3 2003-10-14 23:19:43 grommit Exp $
5 # -------------------------------------------------------------------
6 # Copyright (C) 2003 Mark Addison <mark.addison@itn.co.uk>,
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.
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.
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
21 # -------------------------------------------------------------------
25 SQL::Translator::Parser::XML::XMI::SQLFairy - Create Schema from UML Models.
31 use vars qw[ $DEBUG $VERSION @EXPORT_OK ];
32 $VERSION = sprintf "%d.%02d", q$Revision: 1.3 $ =~ /(\d+)\.(\d+)/;
33 $DEBUG = 0 unless defined $DEBUG;
35 use base qw(Exporter);
36 @EXPORT_OK = qw(parse);
39 use SQL::Translator::Parser::XML::XMI;
40 use SQL::Translator::Utils 'debug';
42 # Globals for the subs to use, set in parse() and classes2schema()
44 # TODO Should we be giving classes2schema the schema or should they use their
45 # parse() to get it. Obj parsers maybe?
46 #our ($schema,$pargs);
47 use vars qw[ $schema $pargs ];
49 # Set the parg for the conversion sub then use the XMI parser
51 my ( $translator ) = @_;
52 local $DEBUG = $translator->debug;
53 local $pargs = $translator->parser_args;
54 #local $schema = $translator->schema;
55 $pargs->{classes2schema} = \&classes2schema;
56 $pargs->{derive_pkey} ||= "stereotype,auto,first";
57 $pargs->{auto_pkey} ||= {
65 is_auto_increment => 1,
68 return SQL::Translator::Parser::XML::XMI::parse(@_);
73 # TODO We could make the tag names a parser arg so people can use their own.
75 $TAGS{data_type} = "sqlfDataType";
76 $TAGS{size} = "sqlfSize";
77 $TAGS{is_nullable} = "sqlfIsNullable";
78 $TAGS{required} = "sqlfRequired";
79 $TAGS{is_auto_increment} = "sqlfIsAutoIncrement";
80 $TAGS{default_value} = "sqlfDefaultValue";
84 return grep {$_->{kind} ne "return"} @$params;
88 my ($tag, $things) = @_;
90 return $_->{_map_taggedValues}{$tag}{dataValue}
91 if exists $_->{_map_taggedValues}{$tag}{dataValue};
98 local $schema = shift;
102 # Create tablles from Classes and collect their associations
105 foreach my $class (@$classes) {
107 debug "Adding class: $class->{name}";
108 my $table = $schema->add_table( name => $class->{name} )
109 or die "Schema Error: ".$schema->error;
111 # Only collect the associations for classes that are tables. Use a hash
112 # so we only get them once
113 $associations{$_->{"xmi.id"}} = $_
114 foreach map $_->{association}, @{$class->{associationEnds}};
117 # Fields from Class attributes
120 push @flds, attr2field($_) for @{$class->{attributes}};
121 # TODO Filter this e.g no abstract attr or stereotype check
123 my $extra = delete $_->{extra};
124 my $field = $table->add_field( %$_ ) or die $schema->error;
125 $field->extra(%$extra) if $extra;
129 add_pkey($class,$table);
133 # Relationships from Associations
135 foreach my $assoc (values %associations) {
136 my @end = @{$assoc->{associationEnds}};
138 $end[0]->{multiplicity}{rangeUpper} == 1
139 && $end[1]->{multiplicity}{rangeUpper} == 1
142 warn "Sorry, 1:1 associations not yet implimented for xmi.id=".$assoc->{"xmi.id"}."\n";
145 $end[0]->{multiplicity}{rangeUpper} == 1
146 || $end[1]->{multiplicity}{rangeUpper} == 1
155 #warn "Sorry, n:m associations not yet implimented for xmi.id=".$assoc->{"xmi.id"}."\n";
162 # Take an attribute and return the field data for it
165 my $dataType = $attr->{dataType};
167 my %data = ( name => $attr->{name} );
170 = _resolve_tag($TAGS{data_type},[$attr,$dataType])
171 || $dataType->{name};
173 $data{size} = _resolve_tag($TAGS{size},[$attr,$dataType]);
176 = _resolve_tag($TAGS{default_value},[$attr,$dataType])
177 || $attr->{initialValue};
179 my $is_nullable = _resolve_tag($TAGS{is_nullable},[$attr,$dataType]);
180 my $required = _resolve_tag($TAGS{required},[$attr,$dataType]);
182 = defined $is_nullable ? $is_nullable
183 : ( defined $required ? ($required ? 0 : 1) : undef);
185 $data{is_auto_increment}
186 = $attr->{_map_taggedValues}{$TAGS{is_auto_increment}}{dataValue}
187 || $dataType->{_map_taggedValues}{$TAGS{is_auto_increment}}{dataValue}
194 foreach ( keys %{$attr->{_map_taggedValues}} ) {$tagnames{$_}++; }
195 delete @tagnames{@TAGS{qw/data_type size default_value is_nullable required is_auto_increment/}}; # Remove the tags we have already done
197 my $val = $attr->{_map_taggedValues}{$_}{dataValue};
201 $data{extra} = \%extra;
206 # Add a pkey to a table for the class
208 my ($class,$table) = @_;
211 foreach ( split(",", $pargs->{derive_pkey}) ) {
212 if ( $_ eq "stereotype" ) {
213 @pkeys = map $_->{name},
214 grep($_->{stereotype} eq "PK", @{$class->{attributes}});
216 elsif( $_ eq "first" ) {
217 @pkeys = $class->{attributes}[0]{name} unless @pkeys;
219 elsif( $_ eq "auto" ) {
220 if ( my %data = %{$pargs->{auto_pkey}} ) {
221 $data{name} = $data{name}->($class,$table);
222 my $field = $table->add_field(%data) or die $table->error;
223 @pkeys = $field->name;
229 $table->add_constraint(
230 type => "PRIMARY KEY",
232 ) or die $table->error;
235 # Maps a 1:M association into the schema
239 my @ends = @{$assoc->{associationEnds}};
240 my ($end1) = grep $_->{multiplicity}{rangeUpper} == 1, @ends;
241 my $endm = $end1->{otherEnd};
242 my $table1 = $schema->get_table($end1->{participant}{name});
243 my $tablem = $schema->get_table($endm->{participant}{name});
246 # Export 1end pkey to many end
248 my $con = $table1->primary_key;
249 my @flds = $con->fields;
251 my $fld = $table1->get_field($_);
253 $data{$_} = $fld->$_()
254 foreach (qw/name size data_type default_value is_nullable/);
255 $data{extra} = { $fld->extra }; # Copy extra hash
256 $data{is_unique} = 0; # FKey on many join so not unique
257 $data{is_nullable} = $end1->{multiplicity}{rangeLower} == 0 ? 1 : 0;
258 # 0:m - allow nulluable on fkey
259 # 1:m - dont allow nullable
261 $tablem->add_field(%data) or die $tablem->error;
262 # Export the pkey if full composite (ie identity) relationship
263 $tablem->primary_key($_) if $end1->{aggregation} eq "composite";
267 # Add fkey constraint to many end
269 $tablem->add_constraint(
270 type => "FOREIGN_KEY",
272 reference_table => $table1->{name},
273 reference_fields => [@flds],
274 ) or die $schema->error;
277 # Maps m:n into schema by building a link table.
281 my @end = @{$assoc->{associationEnds}};
283 # Create the link table
284 my $name = $end[0]->{participant}{name}."_".$end[1]->{participant}{name};
285 my $link_table = $schema->add_table( name => $name )
286 or die "Schema Error: ".$schema->error;
288 # Export the pkey(s) from the ends into the link table
291 my $table = $schema->get_table($_->{participant}{name});
292 my @fkeys = $table->primary_key->fields;
295 my $fld = $table->get_field($_);
297 $data{$_} = $fld->$_()
299 qw/name size data_type default_value is_nullable is_unique/);
300 $data{is_auto_increment} = 0;
301 $data{extra} = { $fld->extra }; # Copy
302 $link_table->add_field(%data) or die $table->error;
304 $link_table->add_constraint(
305 type => "FOREIGN_KEY",
307 reference_table => $table->{name},
308 reference_fields => [@fkeys],
309 ) or die $schema->error;
312 # Add pkey constraint
313 $link_table->add_constraint( type => "PRIMARY KEY", fields => [@pkeys] )
314 or die $link_table->error;
317 # Add fkeys to our participants
319 1; #---------------------------------------------------------------------------
328 use SQL::Translator::Parser::XML::XMI;
330 my $translator = SQL::Translator->new(
331 from => 'XML-XMI-SQLFairy',
333 filename => 'schema.xmi',
336 print $obj->translate;
340 Converts Class diagrams to Schema trying to use standard UML features as much
341 as possible, with the minimum use of extension mechanisms (tagged values and
342 stereotypes) for the database details. The idea is to treat the object model
343 like a logical database model and map that to a physical model (the sql). Also
344 tries to make this mapping as configurable as possible and support all the
345 schema features of SQLFairy.
349 Classes, all of them! (TODO More control over which tables to do.)
353 The attributes of the class will be converted to fields of the same name.
357 Database datatypes are modeled using tagged values; sqlfDataType,
358 sqlfSize, sqlfIsNullable and sqlfIsAutoIncrement added to the attribute.
359 The default value is the UML initial value of the attribute or can be overridden
360 using a sqlfDefaultValue tagged value if you want to have a different default
361 in the database then the object uses.
363 For more advanced datatype modeling you can use UML data types by adding the
364 tagged values to the UML data types in your model and then giving your
365 attributes those datatypes. Any tagged values set on attributes will override
366 any they get from their datatype. This allows you to use UML datatypes like
367 domains. If no sqlfDataType is given then the name of the UMLDataType is used.
371 If no attribute is marked explicity on the Class as a pkey then one is added.
372 The default is an INT(10) auto number named after the class with ID on the end.
373 For many cases this is enough as you don't normally need to model pkeys
374 explicitly in your object models as its a database thing.
376 The pkey created can be controlled by setting the C<auto_pkey> parser arg to a
377 hash ref describing the field. The name key is a sub that gets given a ref to
378 the class (from the xmi) and the table it has been mapped to, and should return the pkey name. e.g. the defualt looks like;
388 is_auto_increment => 1,
391 NB You need to return a unique name for the key if it will be used to build
392 relationships as it will be exported to other tables (see Relationships).
394 You can also set them explicitly by marking attributes with a <<PK>> stereotype.
395 Add to multiple attribs to make multi column keys. Usefull when your object
396 contains an attribute that makes a good candidate for a pkey, e.g. email.
400 Modeled using UML associations. Currently only handles 0:m and 1:m joins. That
401 is associations where one ends multiplicty is '1' or '0..1' and the other end's
402 multplicity is more than 1 e.g '*', '0..*', '1..*', '0..3', '4..42' etc.
404 The pkey field from the 1 end is added to the table for the class at the many
405 end as a foreign key with is_unique and auto number turned off.
407 If the 1 end is multiplicity '0..1' (ie a 0:m join) then the the fkey is made
408 nullable, if its multiplicity '1' (1:m) then its made not nullable.
410 If the association is a composition then the created fkey is made part of the
411 many ends pkey. ie It exports the pkey to create an identity join.
415 TODO An example to help make sense of the above! Probably based on the test.
427 Support for the format_X_name subs in the Translator.
433 Mark D. Addison E<lt>mark.addison@itn.co.ukE<gt>.
437 perl(1), SQL::Translator::Parser::XML::XMI