1 package SQL::Translator::Parser::XML::XMI;
3 # -------------------------------------------------------------------
4 # $Id: XMI.pm,v 1.5 2003-09-09 01:37:25 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 - Parser to create Schema from UML
26 Class diagrams stored in XMI format.
31 use SQL::Translator::Parser::XML::XMI;
33 my $translator = SQL::Translator->new(
36 filename => 'schema.xmi',
41 print $obj->translate;
45 =head2 UML Data Modeling
47 To tell the parser which Classes are tables give them a <<Table>> stereotype.
49 Any attributes of the class will be used as fields. The datatype of the
50 attribute must be a UML datatype and not an object, with the datatype's name
51 being used to set the data_type value in the schema.
53 Primary keys are attributes marked with <<PK>> stereotype.
57 The parser has been built using XMI generated by PoseidonUML 2beta, which
58 says it uses UML 2. So the current conformance is down to Poseidon's idea
67 visibilty=public|protected|private
69 What visibilty of stuff to translate. e.g when set to 'public' any private
70 and package Classes will be ignored and not turned into tables. Applies
71 to Classes and Attributes.
73 If not set or false (the default) no checks will be made and everything is
80 # -------------------------------------------------------------------
84 use vars qw[ $DEBUG $VERSION @EXPORT_OK ];
85 $VERSION = sprintf "%d.%02d", q$Revision: 1.5 $ =~ /(\d+)\.(\d+)/;
86 $DEBUG = 0 unless defined $DEBUG;
90 use base qw(Exporter);
91 @EXPORT_OK = qw(parse);
93 use base qw/SQL::Translator::Parser/; # Doesnt do anything at the mo!
94 use SQL::Translator::Utils 'debug';
96 use XML::XPath::XMLParser;
99 #-----------------------------------------------------------------------------
102 # get_classes( XPATHOBJ, ARGS );
104 # XPATHOBJ - An XML::XPath object setup and ready to use. You can also use any
105 # Node to search from as this sub just calls findnodes() on the arg.
107 # ARGS - Name/Value list of args.
109 # xpath => The xpath to use for finding classes. Default is //UML:Classes
110 # which will find all the classes in the XMI.
112 # test => An XPath predicate (ie the bit between [] ) to test the
113 # classes with to decide if we should parse them. ie
114 # test => '@name' would only pass out classes with a name.
115 # Can also give it an array ref and it will and the tests.
116 # It gets tacked onto to xpath so don't put any [] on
117 # xpath if you use test as well.
119 # attribute_test => An XPath predicate to pass onto get_attributes.
122 # _add_xpath_tests $path, [qw/@name xmiVisible("public")/]; # and
123 # _add_xpath_tests $path, [qw/@name xmiVisible("public")/], "or";
124 sub _add_xpath_tests {
125 my ($path,$tests,$join) = @_;
126 return $path unless defined $tests;
127 my @tests = ref($tests) ? @$tests : $tests;
128 return $path unless @tests;
130 return $path."[".join(" $join ", @tests)."]";
135 return "".$xp->findvalue(
136 'xmiDeref(UML:ModelElement.stereotype/UML:Stereotype)/@name');
137 # TODO Test for difference between it existing or being "" ?
144 my $xpath = $args{xpath} ||= '//UML:Class'; # Default: all classes
145 $xpath = _add_xpath_tests $xpath, $args{test};
146 debug "Searching for Classes using:$xpath";
148 my @nodes = $xp->findnodes($xpath);
149 return unless @nodes;
151 for my $classnode (@nodes) {
155 qw/name visibility isSpecification
156 isRoot isLeaf isAbstract isActive/
158 $class->{$_} = $classnode->getAttribute($_);
160 $class->{stereotype} = get_stereotype($classnode);
162 $class->{attributes} = get_attributes( $classnode,
163 xpath => 'UML:Classifier.feature/UML:Attribute',
164 test => $args{attribute_test} );
166 $class->{operations} = get_operations( $classnode,
167 xpath => '//UML:Classifier.feature/UML:Operation',
168 test => $args{operation_test} );
170 push @$classes, $class;
172 return wantarray ? @$classes : $classes;
176 my ($xp, %args) = @_;
178 my $xpath = $args{xpath} ||= '//UML:Classifier.feature/UML:Attribute';
179 $xpath = _add_xpath_tests $xpath, $args{test};
180 debug "Searching for Attributes using:$xpath";
183 foreach my $node ( $xp->findnodes($xpath) ) {
186 foreach (qw/name visibility isSpecification ownerScope/) {
187 $attr->{$_} = $node->getAttribute($_);
189 $attr->{stereotype} = get_stereotype($node);
191 # Get datatype name and the body of the initial value
192 $attr->{datatype} = "".$node->find(
193 'xmiDeref(UML:StructuralFeature.type/UML:DataType)/@name');
194 if ( my @body = $node->findnodes(
195 'UML:Attribute.initialValue/UML:Expression/@body')
197 $attr->{initialValue} = $body[0]->getData;
200 push @$attributes, $attr;
202 return wantarray ? @$attributes : $attributes;
206 my ($xp, %args) = @_;
208 my $xpath = $args{xpath} ||= '//UML:Classifier.feature/UML:Operation';
209 $xpath = _add_xpath_tests $xpath, $args{test};
210 debug "Searching for operations using:$xpath";
213 foreach my $node ( $xp->findnodes($xpath) ) {
216 foreach (qw/name visibility isSpecification ownerScope isQuery
217 concurrency isRoot isLeaf isAbstract/) {
218 $operation->{$_} = $node->getAttribute($_);
220 $operation->{stereotype} = get_stereotype($node);
222 $operation->{parameters} = get_parameters( $node,
223 xpath => 'UML:BehavioralFeature.parameter/UML:Parameter',
224 test => $args{attribute_test}
227 push @$operations, $operation;
229 return wantarray ? @$operations : $operations;
233 my ($xp, %args) = @_;
235 my $xpath = $args{xpath} ||= '//UML:Classifier.feature/UML:Attribute';
236 $xpath = _add_xpath_tests $xpath, $args{test};
237 debug "Searching for Attributes using:$xpath";
240 foreach my $node ( $xp->findnodes($xpath) ) {
243 foreach (qw/name isSpecification kind/) {
244 $parameter->{$_} = $node->getAttribute($_);
246 $parameter->{stereotype} = get_stereotype($node);
248 $parameter->{datatype} = "".$node->find(
249 'xmiDeref(UML:Parameter.type/UML:DataType)/@name');
251 push @$parameters, $parameter;
253 return wantarray ? @$parameters : $parameters;
257 #-----------------------------------------------------------------------------
262 my ( $translator, $data ) = @_;
263 local $DEBUG = $translator->debug;
264 my $schema = $translator->schema;
265 my $pargs = $translator->parser_args;
267 debug "Visibility Level:$pargs->{visibility}" if $DEBUG;
269 my $xp = XML::XPath->new(xml => $data);
270 $xp->set_namespace("UML", "org.omg.xmi.namespace.UML");
273 # - Options to set the initial context node so we don't just
274 # blindly do all the classes. e.g. Select a diag name to do.
277 # Build an XPath for the classes and attributes we want...
279 # Only classes with an id (so we don't get any refs to classes ie
280 # xmi.idref classes). They also need a name to be usefull.
281 my @tests = ('@xmi.id and @name');
282 push @tests, "xmiVisible('$pargs->{visibility}')" if $pargs->{visibility};
284 my $attrib_test = '@name and @xmi.id';
285 $attrib_test .= " and xmiVisible('$pargs->{visibility}')"
286 if $pargs->{visibility};
288 # ...and parse them out
289 my $classes = get_classes( $xp,
290 xpath => "//UML:Class", test => [@tests], attribute_test => $attrib_test);
292 debug "Found ".scalar(@$classes)." Classes: ".join(", ",
293 map {$_->{"name"}} @$classes) if $DEBUG;
294 debug "Classes:",Dumper($classes);
297 # Turn the data from get_classes into a Schema
299 foreach my $class (@$classes) {
300 next unless $class->{stereotype} eq "Table";
303 debug "Adding class: $class->{name}" if $DEBUG;
304 my $table = $schema->add_table( name => $class->{name} )
305 or die "Schema Error: ".$schema->error;
308 # Fields from Class attributes
310 # name data_type size default_value is_nullable
311 # is_auto_increment is_primary_key is_foreign_key comments
313 foreach my $attr ( @{$class->{attributes}} ) {
315 name => $attr->{name},
316 data_type => $attr->{datatype},
317 is_primary_key => $attr->{stereotype} eq "PK" ? 1 : 0,
318 #is_foreign_key => $stereotype eq "FK" ? 1 : 0,
320 $data{default_value} = $attr->{initialValue}
321 if exists $attr->{initialValue};
323 debug "Adding field:",Dumper(\%data);
324 my $field = $table->add_field( %data ) or die $schema->error;
326 $table->primary_key( $field->name ) if $data{'is_primary_key'};
329 # - We should be able to make the table obj spot this when
339 print "ERROR: $@\n" if $@;
345 #=============================================================================
347 # XML::XPath extensions
349 #=============================================================================
351 package XML::XPath::Function;
353 =head1 XMI XPath Functions
355 The Parser adds the following extra XPath functions.
359 Deals with xmi.id/xmi.idref pairs of attributes. You give it an
360 xPath e.g 'UML:ModelElement.stereotype/UML:stereotype' if the the
361 tag it points at has an xmi.idref it looks up the tag with that
362 xmi.id and returns it.
364 If it doesn't have an xmi.id, the path is returned as normal.
368 <UML:ModelElement.stereotype>
369 <UML:Stereotype xmi.idref = 'stTable'/>
370 </UML:ModelElement.stereotype>
372 <UML:Stereotype xmi.id='stTable' name='Table' visibility='public'
373 isAbstract='false' isSpecification='false' isRoot='false' isLeaf='false'>
374 <UML:Stereotype.baseClass>Class</UML:Stereotype.baseClass>
377 Using xmideref(//UML:ModelElement.stereotype/UML:stereotype) would return the
378 <UML:Stereotype xmi.id = '3b4b1e:f762a35f6b:-7fb6' ...> tag.
380 Using xmideref(//UML:ModelElement.stereotype/UML:stereotype)/@name would give
385 is_visible( VISLEVEL )
387 Returns true or false for whether the visibility of something e.g. a Class or
388 Attribute, is visible at the level given. e.g.
390 //UML:Class[xmiVisible('public')] - Find all public classes
391 //UML:Class[xmiVisible('protected')] - Find all public and protected classes
393 Supports the 3 UML visibility levels of public, protected and private.
395 Note: Currently any element tested that doesn't have a visibility="" attribute
396 is assumed to be visible and so xmiVisible will return true. This is probably
397 the wrong thing to do and is very likley to change. It is probably best to
398 throw an error if we try to test something that doesn't do visibility.
404 my ($node, @params) = @_;
406 die "xmiDeref() function takes one or no parameters\n";
409 my $nodeset = shift(@params);
410 return $nodeset unless $nodeset->size;
411 $node = $nodeset->get_node(1);
413 die "xmiDeref() needs an Element node."
414 unless $node->isa("XML::XPath::Node::Element");
416 my $id = $node->getAttribute("xmi.idref") or return $node;
417 return $node->getRootNode->find('//*[@xmi.id="'.$id.'"]');
429 my ($node, @params) = @_;
430 if (@params < 1 or @params > 2) {
431 die "xmiVisible() function takes 1 or 2 parameters\n";
433 elsif (@params == 2) {
434 my $nodeset = shift(@params);
435 return unless $nodeset->size;
436 $node = $nodeset->get_node(1);
438 die "xmiVisible() needs an Element node."
439 unless $node->isa("XML::XPath::Node::Element");
441 my $vis = shift(@params) || return XML::XPath::Boolean->True;
442 my $nodevis = $node->getAttribute("visibility")
443 || return XML::XPath::Boolean->True;
444 return XML::XPath::Boolean->True
445 if $vislevel{$vis} >= $vislevel{$nodevis};
446 return XML::XPath::Boolean->False;
450 # Test of custom xpath function.
452 return XML::XPath::Literal->new("Hello World");
455 #=============================================================================
463 Seems to be slow. I think this is because the XMI files can get pretty
464 big and complex, especially all the diagram info.
468 B<field sizes> Don't think UML does this directly so may need to include
469 it in the datatype names.
471 B<Check the Tag Attribute lists in get_* subs> I have taken them from looking
472 at Poseidon so need to check against XMI spec.
474 B<table_visibility and field_visibility args> Seperate control over what is
475 parsed, setting visibility arg will set both.
477 Everything else! Relations, fkeys, constraints, indexes, etc...
481 Mark D. Addison E<lt>mark.addison@itn.co.ukE<gt>.
485 perl(1), SQL::Translator, XML::XPath, SQL::Translator::Producer::XML::SQLFairy,
486 SQL::Translator::Schema.