1 package SQL::Translator::Parser::XML::XMI::SQLFairy;
3 # -------------------------------------------------------------------
4 # $Id: SQLFairy.pm,v 1.5 2003-10-17 19:49:47 dlc 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.5 $ =~ /(\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
159 # Take an attribute and return the field data for it
162 my $dataType = $attr->{dataType};
164 my %data = ( name => $attr->{name} );
167 = _resolve_tag($TAGS{data_type},[$attr,$dataType])
168 || $dataType->{name};
170 $data{size} = _resolve_tag($TAGS{size},[$attr,$dataType]);
173 = _resolve_tag($TAGS{default_value},[$attr,$dataType])
174 || $attr->{initialValue};
176 my $is_nullable = _resolve_tag($TAGS{is_nullable},[$attr,$dataType]);
177 my $required = _resolve_tag($TAGS{required},[$attr,$dataType]);
179 = defined $is_nullable ? $is_nullable
180 : ( defined $required ? ($required ? 0 : 1) : undef);
182 $data{is_auto_increment}
183 = $attr->{_map_taggedValues}{$TAGS{is_auto_increment}}{dataValue}
184 || $dataType->{_map_taggedValues}{$TAGS{is_auto_increment}}{dataValue}
191 foreach ( keys %{$attr->{_map_taggedValues}} ) {$tagnames{$_}++; }
192 delete @tagnames{@TAGS{qw/data_type size default_value is_nullable required is_auto_increment/}}; # Remove the tags we have already done
194 my $val = $attr->{_map_taggedValues}{$_}{dataValue};
198 $data{extra} = \%extra;
203 # Add a pkey to a table for the class
205 my ($class,$table) = @_;
208 foreach ( split(",", $pargs->{derive_pkey}) ) {
209 if ( $_ eq "stereotype" ) {
210 @pkeys = map $_->{name},
211 grep($_->{stereotype} eq "PK", @{$class->{attributes}});
213 elsif( $_ eq "first" ) {
214 @pkeys = $class->{attributes}[0]{name} unless @pkeys;
216 elsif( $_ eq "auto" ) {
217 if ( my %data = %{$pargs->{auto_pkey}} ) {
218 $data{name} = $data{name}->($class,$table);
219 my $field = $table->add_field(%data) or die $table->error;
220 @pkeys = $field->name;
226 $table->add_constraint(
227 type => "PRIMARY KEY",
229 ) or die $table->error;
232 # Maps a 1:M association into the schema
236 my @ends = @{$assoc->{associationEnds}};
237 my ($end1) = grep $_->{multiplicity}{rangeUpper} == 1, @ends;
238 my $endm = $end1->{otherEnd};
239 my $table1 = $schema->get_table($end1->{participant}{name});
240 my $tablem = $schema->get_table($endm->{participant}{name});
243 # Export 1end pkey to many end
245 my $con = $table1->primary_key;
246 my @flds = $con->fields;
248 my $fld = $table1->get_field($_);
250 $data{$_} = $fld->$_()
251 foreach (qw/name size data_type default_value is_nullable/);
252 $data{extra} = { $fld->extra }; # Copy extra hash
253 $data{is_unique} = 0; # FKey on many join so not unique
254 $data{is_nullable} = $end1->{multiplicity}{rangeLower} == 0 ? 1 : 0;
255 # 0:m - allow nulluable on fkey
256 # 1:m - dont allow nullable
258 $tablem->add_field(%data) or die $tablem->error;
259 # Export the pkey if full composite (ie identity) relationship
260 $tablem->primary_key($_) if $end1->{aggregation} eq "composite";
264 # Add fkey constraint to many end
266 $tablem->add_constraint(
267 type => "FOREIGN_KEY",
269 reference_table => $table1->{name},
270 reference_fields => [@flds],
271 ) or die $schema->error;
274 # Maps m:n into schema by building a link table.
278 my @end = @{$assoc->{associationEnds}};
280 # Create the link table
281 my $name = $end[0]->{participant}{name}."_".$end[1]->{participant}{name};
282 my $link_table = $schema->add_table( name => $name )
283 or die "Schema Error: ".$schema->error;
285 # Export the pkey(s) from the ends into the link table
288 my $table = $schema->get_table($_->{participant}{name});
289 my @fkeys = $table->primary_key->fields;
292 my $fld = $table->get_field($_);
294 $data{$_} = $fld->$_()
296 qw/name size data_type default_value is_nullable is_unique/);
297 $data{is_auto_increment} = 0;
298 $data{extra} = { $fld->extra }; # Copy
299 $link_table->add_field(%data) or die $table->error;
301 $link_table->add_constraint(
302 type => "FOREIGN_KEY",
304 reference_table => $table->{name},
305 reference_fields => [@fkeys],
306 ) or die $schema->error;
309 # Add pkey constraint
310 $link_table->add_constraint( type => "PRIMARY KEY", fields => [@pkeys] )
311 or die $link_table->error;
314 # Add fkeys to our participants
316 1; #---------------------------------------------------------------------------
325 use SQL::Translator::Parser::XML::XMI;
327 my $translator = SQL::Translator->new(
328 from => 'XML-XMI-SQLFairy',
330 filename => 'schema.xmi',
333 print $obj->translate;
337 Converts Class diagrams to Schema trying to use standard UML features as much
338 as possible, with the minimum use of extension mechanisms (tagged values and
339 stereotypes) for the database details. The idea is to treat the object model
340 like a logical database model and map that to a physical model (the sql). Also
341 tries to make this mapping as configurable as possible and support all the
342 schema features of SQLFairy.
346 Classes, all of them! (TODO More control over which tables to do.)
350 The attributes of the class will be converted to fields of the same name.
354 Database datatypes are modeled using tagged values; sqlfDataType,
355 sqlfSize, sqlfIsNullable and sqlfIsAutoIncrement added to the attribute.
356 The default value is the UML initial value of the attribute or can be overridden
357 using a sqlfDefaultValue tagged value if you want to have a different default
358 in the database then the object uses.
360 For more advanced datatype modeling you can use UML data types by adding the
361 tagged values to the UML data types in your model and then giving your
362 attributes those datatypes. Any tagged values set on attributes will override
363 any they get from their datatype. This allows you to use UML datatypes like
364 domains. If no sqlfDataType is given then the name of the UMLDataType is used.
368 If no attribute is marked explicity on the Class as a pkey then one is added.
369 The default is an INT(10) auto number named after the class with ID on the end.
370 For many cases this is enough as you don't normally need to model pkeys
371 explicitly in your object models as its a database thing.
373 The pkey created can be controlled by setting the C<auto_pkey> parser arg to a
374 hash ref describing the field. The name key is a sub that gets given a ref to
375 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;
385 is_auto_increment => 1,
388 NB You need to return a unique name for the key if it will be used to build
389 relationships as it will be exported to other tables (see Relationships).
391 You can also set them explicitly by marking attributes with a <<PK>> stereotype.
392 Add to multiple attribs to make multi column keys. Usefull when your object
393 contains an attribute that makes a good candidate for a pkey, e.g. email.
399 Associations where one ends multiplicty is '1' or '0..1' and the other end's
400 multplicity is more than 1 e.g '*', '0..*', '1..*', '0..3', '4..42' etc.
402 The pkey field from the 1 end is added to the table for the class at the many
403 end as a foreign key with is_unique and auto number turned off.
405 If the 1 end is multiplicity '0..1' (ie a 0:m join) then the the fkey is made
406 nullable, if its multiplicity '1' (1:m) then its made not nullable.
408 If the association is a composition then the created fkey is made part of the
409 many ends pkey. ie It exports the pkey to create an identity join.
413 Model using a standard m:n association and the parser will automatically create
414 a link table for you in the Schema by exporting pkeys from the tables at
419 TODO An example to help make sense of the above! Probably based on the test.
429 Use Role names from associations as field names for exported keys when building
434 Support for the format_X_name subs in the Translator and format subs for
435 generating the link table name in m:n joins.
441 Mark D. Addison E<lt>mark.addison@itn.co.ukE<gt>.
445 perl(1), SQL::Translator::Parser::XML::XMI