1 package SQL::Translator::Parser::XML::XMI;
3 # -------------------------------------------------------------------
4 # $Id: XMI.pm,v 1.3 2003-09-08 17:10:07 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.3 $ =~ /(\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 # get_classes( XPATHOBJ, ARGS );
101 # XPATHOBJ - An XML::XPath object setup and ready to use. You can also use any
102 # Node to search from as this sub just calls findnodes() on the arg.
104 # ARGS - Name/Value list of args.
106 # xpath => The xpath to use for finding classes. Default is //UML:Classes
107 # which will find all the classes in the XMI.
109 # attribute_test => An XPath predicate (ie the bit between [] ) to test the
110 # attributes with to decide if we should parse them. ie
111 # attribute_test => '@name="foo"' would only pass out attribs
112 # with a name of foo.
118 my $xpath = $args{xpath} ||= '//UML:Class'; # Default: all classes
119 $xpath .= "[$args{class_test}]" if $args{class_test};
121 my @nodes = $xp->findnodes($xpath);
122 return unless @nodes;
124 for my $classnode (@nodes) {
127 # <UML:Class> attributes
129 qw/name visibility isSpecification
130 isRoot isLeaf isAbstract isActive/
132 $class->{$_} = $classnode->getAttribute($_);
136 $class->{stereotype} = "".$classnode->find(
137 'xmiDeref(UML:ModelElement.stereotype/UML:Stereotype)/@name');
142 my $xpath = 'UML:Classifier.feature/UML:Attribute';
143 $xpath .= "[$args{attribute_test}]" if $args{attribute_test};
144 foreach my $attrnode ( $classnode->findnodes($xpath) ) {
146 # <UML:Attributes> attributes
147 foreach (qw/name visibility isSpecification ownerScope/) {
148 $attr->{$_} = $attrnode->getAttribute($_);
151 $attr->{stereotype} = "".$attrnode->findvalue(
152 'xmiDeref(UML:ModelElement.stereotype/UML:Stereotype)/@name');
154 $attr->{datatype} = "".$attrnode->find(
155 'xmiDeref(UML:StructuralFeature.type/UML:DataType)/@name');
156 if ( my @body = $attrnode->findnodes(
157 'UML:Attribute.initialValue/UML:Expression/@body')
159 $attr->{initialValue} = $body[0]->getData;
162 push @{$class->{attributes}}, $attr;
165 push @$classes, $class;
174 my ( $translator, $data ) = @_;
175 local $DEBUG = $translator->debug;
176 my $schema = $translator->schema;
177 my $pargs = $translator->parser_args;
179 debug "Visibility Level:$pargs->{visibility}" if $DEBUG;
181 my $xp = XML::XPath->new(xml => $data);
182 $xp->set_namespace("UML", "org.omg.xmi.namespace.UML");
185 # - Options to set the initial context node so we don't just
186 # blindly do all the classes. e.g. Select a diag name to do.
189 # Build an XPath for the classes and attributes we want...
191 my @tests = ('@xmi.id'); # Only classes with an id so we don't get any
192 # refs to classes ie xmi.idref classes
193 push @tests, '@name'; # Only Classes with a name
194 push @tests, "xmiVisible('$pargs->{visibility}')" if $pargs->{visibility};
195 my $path = '//UML:Class['.join(' and ',@tests).']';
197 my $attrib_test = '@name';
198 $attrib_test .= " and xmiVisible('$pargs->{visibility}')"
199 if $pargs->{visibility};
201 # ...and parse them out
202 debug "Searching for Classes using:$path";
203 my $classes = get_classes( $xp,
204 xpath => $path, attribute_test => $attrib_test);
206 debug "Found ".scalar(@$classes)." Classes: ".join(", ",
207 map {$_->{"name"}} @$classes) if $DEBUG;
208 debug "Classes:",Dumper($classes);
211 # Turn the data from get_classes into a Schema
213 foreach my $class (@$classes) {
214 next unless $class->{stereotype} eq "Table";
217 debug "Adding class: $class->{name}" if $DEBUG;
218 my $table = $schema->add_table( name => $class->{name} )
219 or die "Schema Error: ".$schema->error;
222 # Fields from Class attributes
224 # name data_type size default_value is_nullable
225 # is_auto_increment is_primary_key is_foreign_key comments
227 foreach my $attr ( @{$class->{attributes}} ) {
229 name => $attr->{name},
230 data_type => $attr->{datatype},
231 is_primary_key => $attr->{stereotype} eq "PK" ? 1 : 0,
232 #is_foreign_key => $stereotype eq "FK" ? 1 : 0,
234 $data{default_value} = $attr->{initialValue}
235 if exists $attr->{initialValue};
237 debug "Adding field:",Dumper(\%data);
238 my $field = $table->add_field( %data ) or die $schema->error;
240 $table->primary_key( $field->name ) if $data{'is_primary_key'};
243 # - We should be able to make the table obj spot this when
253 print "ERROR: $@\n" if $@;
259 #=============================================================================
261 # XML::XPath extensions
263 #=============================================================================
265 package XML::XPath::Function;
267 =head1 XMI XPath Functions
269 The Parser adds the following extra XPath functions.
273 Deals with xmi.id/xmi.idref pairs of attributes. You give it an
274 xPath e.g 'UML:ModelElement.stereotype/UML:stereotype' if the the
275 tag it points at has an xmi.idref it looks up the tag with that
276 xmi.id and returns it.
278 If it doesn't have an xmi.id, the path is returned as normal.
282 <UML:ModelElement.stereotype>
283 <UML:Stereotype xmi.idref = 'stTable'/>
284 </UML:ModelElement.stereotype>
286 <UML:Stereotype xmi.id='stTable' name='Table' visibility='public'
287 isAbstract='false' isSpecification='false' isRoot='false' isLeaf='false'>
288 <UML:Stereotype.baseClass>Class</UML:Stereotype.baseClass>
291 Using xmideref(//UML:ModelElement.stereotype/UML:stereotype) would return the
292 <UML:Stereotype xmi.id = '3b4b1e:f762a35f6b:-7fb6' ...> tag.
294 Using xmideref(//UML:ModelElement.stereotype/UML:stereotype)/@name would give
299 is_visible( VISLEVEL )
301 Returns true or false for whether the visibility of something e.g. a Class or
302 Attribute, is visible at the level given. e.g.
304 //UML:Class[xmiVisible('public')] - Find all public classes
305 //UML:Class[xmiVisible('protected')] - Find all public and protected classes
307 Supports the 3 UML visibility levels of public, protected and private.
309 Note: Currently any element tested that doesn't have a visibility="" attribute
310 is assumed to be visible and so xmiVisible will return true. This is probably
311 the wrong thing to do and is very likley to change. It is probably best to
312 throw an error if we try to test something that doesn't do visibility.
318 my ($node, @params) = @_;
320 die "xmiDeref() function takes one or no parameters\n";
323 my $nodeset = shift(@params);
324 return $nodeset unless $nodeset->size;
325 $node = $nodeset->get_node(1);
327 die "xmiDeref() needs an Element node."
328 unless $node->isa("XML::XPath::Node::Element");
330 my $id = $node->getAttribute("xmi.idref") or return $node;
331 return $node->getRootNode->find('//*[@xmi.id="'.$id.'"]');
343 my ($node, @params) = @_;
344 if (@params < 1 or @params > 2) {
345 die "xmiVisible() function takes 1 or 2 parameters\n";
347 elsif (@params == 2) {
348 my $nodeset = shift(@params);
349 return unless $nodeset->size;
350 $node = $nodeset->get_node(1);
352 die "xmiVisible() needs an Element node."
353 unless $node->isa("XML::XPath::Node::Element");
355 my $vis = shift(@params) || return XML::XPath::Boolean->True;
356 my $nodevis = $node->getAttribute("visibility")
357 || return XML::XPath::Boolean->True;
358 return XML::XPath::Boolean->True
359 if $vislevel{$vis} >= $vislevel{$nodevis};
360 return XML::XPath::Boolean->False;
364 # Test of custom xpath function.
366 return XML::XPath::Literal->new("Hello World");
369 #=============================================================================
377 Seems to be slow. I think this is because the XMI files can get pretty
378 big and complex, especially all the diagram info.
382 B<field sizes> Don't think UML does this directly so may need to include
383 it in the datatype names.
385 B<table_visibility and field_visibility args> Seperate control over what is
386 parsed, setting visibility arg will set both.
388 Everything else! Relations, fkeys, constraints, indexes, etc...
392 Mark D. Addison E<lt>mark.addison@itn.co.ukE<gt>.
396 perl(1), SQL::Translator, XML::XPath, SQL::Translator::Producer::XML::SQLFairy,
397 SQL::Translator::Schema.