Commit | Line | Data |
1223c9b2 |
1 | package SQL::Translator::Parser::XML::XMI; |
2 | |
3 | # ------------------------------------------------------------------- |
5cb154e5 |
4 | # $Id: XMI.pm,v 1.5 2003-09-09 01:37:25 grommit Exp $ |
1223c9b2 |
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 - Parser to create Schema from UML |
26 | Class diagrams stored in XMI format. |
27 | |
f8ec05fa |
28 | =head1 SYNOPSIS |
29 | |
30 | use SQL::Translator; |
31 | use SQL::Translator::Parser::XML::XMI; |
32 | |
33 | my $translator = SQL::Translator->new( |
34 | from => 'XML-XMI', |
35 | to => 'MySQL', |
36 | filename => 'schema.xmi', |
37 | show_warnings => 1, |
38 | add_drop_table => 1, |
39 | ); |
40 | |
41 | print $obj->translate; |
42 | |
43 | =head1 DESCRIPTION |
44 | |
45 | =head2 UML Data Modeling |
46 | |
47 | To tell the parser which Classes are tables give them a <<Table>> stereotype. |
48 | |
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. |
52 | |
53 | Primary keys are attributes marked with <<PK>> stereotype. |
54 | |
55 | =head2 XMI Format |
56 | |
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 |
59 | of XMI! |
60 | |
61 | =head1 ARGS |
62 | |
63 | =over 4 |
64 | |
65 | =item visibility |
66 | |
67 | visibilty=public|protected|private |
68 | |
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. |
72 | |
73 | If not set or false (the default) no checks will be made and everything is |
74 | translated. |
75 | |
76 | =back |
77 | |
1223c9b2 |
78 | =cut |
79 | |
80 | # ------------------------------------------------------------------- |
81 | |
82 | use strict; |
83 | |
84 | use vars qw[ $DEBUG $VERSION @EXPORT_OK ]; |
5cb154e5 |
85 | $VERSION = sprintf "%d.%02d", q$Revision: 1.5 $ =~ /(\d+)\.(\d+)/; |
1223c9b2 |
86 | $DEBUG = 0 unless defined $DEBUG; |
87 | |
88 | use Data::Dumper; |
89 | use Exporter; |
90 | use base qw(Exporter); |
91 | @EXPORT_OK = qw(parse); |
92 | |
93 | use base qw/SQL::Translator::Parser/; # Doesnt do anything at the mo! |
94 | use SQL::Translator::Utils 'debug'; |
95 | use XML::XPath; |
96 | use XML::XPath::XMLParser; |
97 | |
91ed9c32 |
98 | # XMI XPath parsing |
99 | #----------------------------------------------------------------------------- |
100 | |
1223c9b2 |
101 | # |
f8ec05fa |
102 | # get_classes( XPATHOBJ, ARGS ); |
1223c9b2 |
103 | # |
f8ec05fa |
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. |
ef2d7798 |
106 | # |
f8ec05fa |
107 | # ARGS - Name/Value list of args. |
ef2d7798 |
108 | # |
f8ec05fa |
109 | # xpath => The xpath to use for finding classes. Default is //UML:Classes |
110 | # which will find all the classes in the XMI. |
ef2d7798 |
111 | # |
91ed9c32 |
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. |
118 | # |
119 | # attribute_test => An XPath predicate to pass onto get_attributes. |
f8ec05fa |
120 | # |
91ed9c32 |
121 | |
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; |
129 | $join ||= "and"; |
130 | return $path."[".join(" $join ", @tests)."]"; |
131 | } |
132 | |
133 | sub get_stereotype { |
134 | my ($xp) = @_; |
135 | return "".$xp->findvalue( |
136 | 'xmiDeref(UML:ModelElement.stereotype/UML:Stereotype)/@name'); |
137 | # TODO Test for difference between it existing or being "" ? |
138 | } |
139 | |
f8ec05fa |
140 | sub get_classes { |
141 | my ($xp,%args) = @_; |
91ed9c32 |
142 | my $classes; |
f8ec05fa |
143 | |
144 | my $xpath = $args{xpath} ||= '//UML:Class'; # Default: all classes |
91ed9c32 |
145 | $xpath = _add_xpath_tests $xpath, $args{test}; |
146 | debug "Searching for Classes using:$xpath"; |
f8ec05fa |
147 | |
148 | my @nodes = $xp->findnodes($xpath); |
149 | return unless @nodes; |
150 | |
151 | for my $classnode (@nodes) { |
152 | my $class = {}; |
91ed9c32 |
153 | |
154 | foreach ( |
f8ec05fa |
155 | qw/name visibility isSpecification |
156 | isRoot isLeaf isAbstract isActive/ |
157 | ) { |
158 | $class->{$_} = $classnode->getAttribute($_); |
159 | } |
91ed9c32 |
160 | $class->{stereotype} = get_stereotype($classnode); |
f8ec05fa |
161 | |
91ed9c32 |
162 | $class->{attributes} = get_attributes( $classnode, |
5cb154e5 |
163 | xpath => 'UML:Classifier.feature/UML:Attribute', |
164 | test => $args{attribute_test} ); |
91ed9c32 |
165 | |
5cb154e5 |
166 | $class->{operations} = get_operations( $classnode, |
167 | xpath => '//UML:Classifier.feature/UML:Operation', |
168 | test => $args{operation_test} ); |
169 | |
170 | push @$classes, $class; |
f8ec05fa |
171 | } |
91ed9c32 |
172 | return wantarray ? @$classes : $classes; |
f8ec05fa |
173 | }; |
ef2d7798 |
174 | |
91ed9c32 |
175 | sub get_attributes { |
176 | my ($xp, %args) = @_; |
177 | |
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"; |
181 | |
182 | my $attributes; |
183 | foreach my $node ( $xp->findnodes($xpath) ) { |
184 | my $attr = {}; |
185 | |
186 | foreach (qw/name visibility isSpecification ownerScope/) { |
187 | $attr->{$_} = $node->getAttribute($_); |
188 | } |
189 | $attr->{stereotype} = get_stereotype($node); |
190 | |
5cb154e5 |
191 | # Get datatype name and the body of the initial value |
91ed9c32 |
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') |
196 | ) { |
197 | $attr->{initialValue} = $body[0]->getData; |
198 | } |
199 | |
200 | push @$attributes, $attr; |
201 | } |
202 | return wantarray ? @$attributes : $attributes; |
203 | } |
204 | |
5cb154e5 |
205 | sub get_operations { |
206 | my ($xp, %args) = @_; |
207 | |
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"; |
211 | |
212 | my $operations; |
213 | foreach my $node ( $xp->findnodes($xpath) ) { |
214 | my $operation = {}; |
215 | |
216 | foreach (qw/name visibility isSpecification ownerScope isQuery |
217 | concurrency isRoot isLeaf isAbstract/) { |
218 | $operation->{$_} = $node->getAttribute($_); |
219 | } |
220 | $operation->{stereotype} = get_stereotype($node); |
221 | |
222 | $operation->{parameters} = get_parameters( $node, |
223 | xpath => 'UML:BehavioralFeature.parameter/UML:Parameter', |
224 | test => $args{attribute_test} |
225 | ); |
226 | |
227 | push @$operations, $operation; |
228 | } |
229 | return wantarray ? @$operations : $operations; |
230 | } |
231 | |
232 | sub get_parameters { |
233 | my ($xp, %args) = @_; |
91ed9c32 |
234 | |
5cb154e5 |
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"; |
238 | |
239 | my $parameters; |
240 | foreach my $node ( $xp->findnodes($xpath) ) { |
241 | my $parameter = {}; |
242 | |
243 | foreach (qw/name isSpecification kind/) { |
244 | $parameter->{$_} = $node->getAttribute($_); |
245 | } |
246 | $parameter->{stereotype} = get_stereotype($node); |
247 | |
248 | $parameter->{datatype} = "".$node->find( |
249 | 'xmiDeref(UML:Parameter.type/UML:DataType)/@name'); |
250 | |
251 | push @$parameters, $parameter; |
252 | } |
253 | return wantarray ? @$parameters : $parameters; |
254 | } |
91ed9c32 |
255 | |
256 | # SQLFairy Parser |
257 | #----------------------------------------------------------------------------- |
258 | |
1223c9b2 |
259 | sub parse { |
f8ec05fa |
260 | eval { |
261 | |
1223c9b2 |
262 | my ( $translator, $data ) = @_; |
263 | local $DEBUG = $translator->debug; |
264 | my $schema = $translator->schema; |
ef2d7798 |
265 | my $pargs = $translator->parser_args; |
1223c9b2 |
266 | |
ef2d7798 |
267 | debug "Visibility Level:$pargs->{visibility}" if $DEBUG; |
268 | |
269 | my $xp = XML::XPath->new(xml => $data); |
1223c9b2 |
270 | $xp->set_namespace("UML", "org.omg.xmi.namespace.UML"); |
271 | # |
272 | # TODO |
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. |
ef2d7798 |
275 | |
f8ec05fa |
276 | # |
277 | # Build an XPath for the classes and attributes we want... |
278 | # |
91ed9c32 |
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'); |
f8ec05fa |
282 | push @tests, "xmiVisible('$pargs->{visibility}')" if $pargs->{visibility}; |
f8ec05fa |
283 | |
91ed9c32 |
284 | my $attrib_test = '@name and @xmi.id'; |
f8ec05fa |
285 | $attrib_test .= " and xmiVisible('$pargs->{visibility}')" |
286 | if $pargs->{visibility}; |
287 | |
288 | # ...and parse them out |
f8ec05fa |
289 | my $classes = get_classes( $xp, |
91ed9c32 |
290 | xpath => "//UML:Class", test => [@tests], attribute_test => $attrib_test); |
f8ec05fa |
291 | |
292 | debug "Found ".scalar(@$classes)." Classes: ".join(", ", |
293 | map {$_->{"name"}} @$classes) if $DEBUG; |
294 | debug "Classes:",Dumper($classes); |
295 | |
296 | # |
297 | # Turn the data from get_classes into a Schema |
298 | # |
299 | foreach my $class (@$classes) { |
300 | next unless $class->{stereotype} eq "Table"; |
ef2d7798 |
301 | |
1223c9b2 |
302 | # Add the table |
f8ec05fa |
303 | debug "Adding class: $class->{name}" if $DEBUG; |
304 | my $table = $schema->add_table( name => $class->{name} ) |
1223c9b2 |
305 | or die "Schema Error: ".$schema->error; |
306 | |
307 | # |
308 | # Fields from Class attributes |
309 | # |
ef2d7798 |
310 | # name data_type size default_value is_nullable |
1223c9b2 |
311 | # is_auto_increment is_primary_key is_foreign_key comments |
312 | # |
f8ec05fa |
313 | foreach my $attr ( @{$class->{attributes}} ) { |
314 | my %data = ( |
315 | name => $attr->{name}, |
316 | data_type => $attr->{datatype}, |
317 | is_primary_key => $attr->{stereotype} eq "PK" ? 1 : 0, |
1223c9b2 |
318 | #is_foreign_key => $stereotype eq "FK" ? 1 : 0, |
319 | ); |
f8ec05fa |
320 | $data{default_value} = $attr->{initialValue} |
321 | if exists $attr->{initialValue}; |
1223c9b2 |
322 | |
323 | debug "Adding field:",Dumper(\%data); |
324 | my $field = $table->add_field( %data ) or die $schema->error; |
325 | |
326 | $table->primary_key( $field->name ) if $data{'is_primary_key'}; |
327 | # |
328 | # TODO: |
ef2d7798 |
329 | # - We should be able to make the table obj spot this when |
1223c9b2 |
330 | # we use add_field. |
331 | # |
332 | } |
333 | |
334 | } # Classes loop |
335 | |
336 | return 1; |
f8ec05fa |
337 | |
338 | }; |
339 | print "ERROR: $@\n" if $@; |
340 | return 1; |
1223c9b2 |
341 | } |
342 | |
343 | 1; |
344 | |
f8ec05fa |
345 | #============================================================================= |
346 | # |
347 | # XML::XPath extensions |
348 | # |
349 | #============================================================================= |
1223c9b2 |
350 | |
f8ec05fa |
351 | package XML::XPath::Function; |
1223c9b2 |
352 | |
f8ec05fa |
353 | =head1 XMI XPath Functions |
1223c9b2 |
354 | |
f8ec05fa |
355 | The Parser adds the following extra XPath functions. |
1223c9b2 |
356 | |
f8ec05fa |
357 | =head2 xmiDeref |
1223c9b2 |
358 | |
f8ec05fa |
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. |
1223c9b2 |
363 | |
f8ec05fa |
364 | If it doesn't have an xmi.id, the path is returned as normal. |
1223c9b2 |
365 | |
f8ec05fa |
366 | e.g. given |
1223c9b2 |
367 | |
f8ec05fa |
368 | <UML:ModelElement.stereotype> |
369 | <UML:Stereotype xmi.idref = 'stTable'/> |
370 | </UML:ModelElement.stereotype> |
371 | ... |
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> |
375 | </UML:Stereotype> |
1223c9b2 |
376 | |
f8ec05fa |
377 | Using xmideref(//UML:ModelElement.stereotype/UML:stereotype) would return the |
378 | <UML:Stereotype xmi.id = '3b4b1e:f762a35f6b:-7fb6' ...> tag. |
1223c9b2 |
379 | |
f8ec05fa |
380 | Using xmideref(//UML:ModelElement.stereotype/UML:stereotype)/@name would give |
381 | "Table". |
1223c9b2 |
382 | |
f8ec05fa |
383 | =head xmiVisible |
1223c9b2 |
384 | |
f8ec05fa |
385 | is_visible( VISLEVEL ) |
1223c9b2 |
386 | |
f8ec05fa |
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. |
1223c9b2 |
389 | |
f8ec05fa |
390 | //UML:Class[xmiVisible('public')] - Find all public classes |
391 | //UML:Class[xmiVisible('protected')] - Find all public and protected classes |
1223c9b2 |
392 | |
f8ec05fa |
393 | Supports the 3 UML visibility levels of public, protected and private. |
1223c9b2 |
394 | |
f8ec05fa |
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. |
1223c9b2 |
399 | |
f8ec05fa |
400 | =cut |
1223c9b2 |
401 | |
f8ec05fa |
402 | sub xmiDeref { |
403 | my $self = shift; |
404 | my ($node, @params) = @_; |
405 | if (@params > 1) { |
406 | die "xmiDeref() function takes one or no parameters\n"; |
407 | } |
408 | elsif (@params) { |
409 | my $nodeset = shift(@params); |
410 | return $nodeset unless $nodeset->size; |
411 | $node = $nodeset->get_node(1); |
412 | } |
413 | die "xmiDeref() needs an Element node." |
414 | unless $node->isa("XML::XPath::Node::Element"); |
1223c9b2 |
415 | |
f8ec05fa |
416 | my $id = $node->getAttribute("xmi.idref") or return $node; |
417 | return $node->getRootNode->find('//*[@xmi.id="'.$id.'"]'); |
418 | } |
419 | |
420 | { |
421 | my %vislevel = ( |
422 | public => 1, |
423 | protected => 2, |
424 | private => 3, |
425 | ); |
426 | |
427 | sub xmiVisible { |
428 | my $self = shift; |
429 | my ($node, @params) = @_; |
430 | if (@params < 1 or @params > 2) { |
431 | die "xmiVisible() function takes 1 or 2 parameters\n"; |
432 | } |
433 | elsif (@params == 2) { |
434 | my $nodeset = shift(@params); |
435 | return unless $nodeset->size; |
436 | $node = $nodeset->get_node(1); |
437 | } |
438 | die "xmiVisible() needs an Element node." |
439 | unless $node->isa("XML::XPath::Node::Element"); |
440 | |
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; |
447 | } |
448 | } |
449 | |
450 | # Test of custom xpath function. |
451 | sub hello { |
452 | return XML::XPath::Literal->new("Hello World"); |
453 | } |
454 | |
455 | #============================================================================= |
456 | package main; |
457 | |
458 | |
459 | =pod |
1223c9b2 |
460 | |
461 | =head1 BUGS |
462 | |
ef2d7798 |
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. |
465 | |
1223c9b2 |
466 | =head1 TODO |
467 | |
ef2d7798 |
468 | B<field sizes> Don't think UML does this directly so may need to include |
1223c9b2 |
469 | it in the datatype names. |
470 | |
5cb154e5 |
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. |
473 | |
ef2d7798 |
474 | B<table_visibility and field_visibility args> Seperate control over what is |
475 | parsed, setting visibility arg will set both. |
476 | |
1223c9b2 |
477 | Everything else! Relations, fkeys, constraints, indexes, etc... |
478 | |
479 | =head1 AUTHOR |
480 | |
481 | Mark D. Addison E<lt>mark.addison@itn.co.ukE<gt>. |
482 | |
483 | =head1 SEE ALSO |
484 | |
485 | perl(1), SQL::Translator, XML::XPath, SQL::Translator::Producer::XML::SQLFairy, |
486 | SQL::Translator::Schema. |
487 | |
488 | =cut |
f8ec05fa |
489 | |
490 | |