Commit | Line | Data |
1223c9b2 |
1 | package SQL::Translator::Parser::XML::XMI; |
2 | |
3 | # ------------------------------------------------------------------- |
f8ec05fa |
4 | # $Id: XMI.pm,v 1.3 2003-09-08 17:10:07 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 ]; |
f8ec05fa |
85 | $VERSION = sprintf "%d.%02d", q$Revision: 1.3 $ =~ /(\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 | |
1223c9b2 |
98 | # |
f8ec05fa |
99 | # get_classes( XPATHOBJ, ARGS ); |
1223c9b2 |
100 | # |
f8ec05fa |
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. |
ef2d7798 |
103 | # |
f8ec05fa |
104 | # ARGS - Name/Value list of args. |
ef2d7798 |
105 | # |
f8ec05fa |
106 | # xpath => The xpath to use for finding classes. Default is //UML:Classes |
107 | # which will find all the classes in the XMI. |
ef2d7798 |
108 | # |
f8ec05fa |
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. |
113 | # |
114 | sub get_classes { |
115 | my ($xp,%args) = @_; |
116 | my $classes = []; |
117 | |
118 | my $xpath = $args{xpath} ||= '//UML:Class'; # Default: all classes |
119 | $xpath .= "[$args{class_test}]" if $args{class_test}; |
120 | |
121 | my @nodes = $xp->findnodes($xpath); |
122 | return unless @nodes; |
123 | |
124 | for my $classnode (@nodes) { |
125 | my $class = {}; |
126 | |
127 | # <UML:Class> attributes |
128 | foreach ( |
129 | qw/name visibility isSpecification |
130 | isRoot isLeaf isAbstract isActive/ |
131 | ) { |
132 | $class->{$_} = $classnode->getAttribute($_); |
133 | } |
134 | |
135 | # Stereotype |
136 | $class->{stereotype} = "".$classnode->find( |
137 | 'xmiDeref(UML:ModelElement.stereotype/UML:Stereotype)/@name'); |
138 | |
139 | # |
140 | # Class Attributes |
141 | # |
142 | my $xpath = 'UML:Classifier.feature/UML:Attribute'; |
143 | $xpath .= "[$args{attribute_test}]" if $args{attribute_test}; |
144 | foreach my $attrnode ( $classnode->findnodes($xpath) ) { |
145 | my $attr = {}; |
146 | # <UML:Attributes> attributes |
147 | foreach (qw/name visibility isSpecification ownerScope/) { |
148 | $attr->{$_} = $attrnode->getAttribute($_); |
149 | } |
150 | |
151 | $attr->{stereotype} = "".$attrnode->findvalue( |
152 | 'xmiDeref(UML:ModelElement.stereotype/UML:Stereotype)/@name'); |
153 | |
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') |
158 | ) { |
159 | $attr->{initialValue} = $body[0]->getData; |
160 | } |
ef2d7798 |
161 | |
f8ec05fa |
162 | push @{$class->{attributes}}, $attr; |
163 | } |
164 | |
165 | push @$classes, $class; |
166 | } |
167 | |
168 | return $classes; |
169 | }; |
ef2d7798 |
170 | |
1223c9b2 |
171 | sub parse { |
f8ec05fa |
172 | eval { |
173 | |
1223c9b2 |
174 | my ( $translator, $data ) = @_; |
175 | local $DEBUG = $translator->debug; |
176 | my $schema = $translator->schema; |
ef2d7798 |
177 | my $pargs = $translator->parser_args; |
1223c9b2 |
178 | |
ef2d7798 |
179 | debug "Visibility Level:$pargs->{visibility}" if $DEBUG; |
180 | |
181 | my $xp = XML::XPath->new(xml => $data); |
1223c9b2 |
182 | $xp->set_namespace("UML", "org.omg.xmi.namespace.UML"); |
183 | # |
184 | # TODO |
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. |
ef2d7798 |
187 | |
f8ec05fa |
188 | # |
189 | # Build an XPath for the classes and attributes we want... |
190 | # |
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).']'; |
196 | |
197 | my $attrib_test = '@name'; |
198 | $attrib_test .= " and xmiVisible('$pargs->{visibility}')" |
199 | if $pargs->{visibility}; |
200 | |
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); |
205 | |
206 | debug "Found ".scalar(@$classes)." Classes: ".join(", ", |
207 | map {$_->{"name"}} @$classes) if $DEBUG; |
208 | debug "Classes:",Dumper($classes); |
209 | |
210 | # |
211 | # Turn the data from get_classes into a Schema |
212 | # |
213 | foreach my $class (@$classes) { |
214 | next unless $class->{stereotype} eq "Table"; |
ef2d7798 |
215 | |
1223c9b2 |
216 | # Add the table |
f8ec05fa |
217 | debug "Adding class: $class->{name}" if $DEBUG; |
218 | my $table = $schema->add_table( name => $class->{name} ) |
1223c9b2 |
219 | or die "Schema Error: ".$schema->error; |
220 | |
221 | # |
222 | # Fields from Class attributes |
223 | # |
ef2d7798 |
224 | # name data_type size default_value is_nullable |
1223c9b2 |
225 | # is_auto_increment is_primary_key is_foreign_key comments |
226 | # |
f8ec05fa |
227 | foreach my $attr ( @{$class->{attributes}} ) { |
228 | my %data = ( |
229 | name => $attr->{name}, |
230 | data_type => $attr->{datatype}, |
231 | is_primary_key => $attr->{stereotype} eq "PK" ? 1 : 0, |
1223c9b2 |
232 | #is_foreign_key => $stereotype eq "FK" ? 1 : 0, |
233 | ); |
f8ec05fa |
234 | $data{default_value} = $attr->{initialValue} |
235 | if exists $attr->{initialValue}; |
1223c9b2 |
236 | |
237 | debug "Adding field:",Dumper(\%data); |
238 | my $field = $table->add_field( %data ) or die $schema->error; |
239 | |
240 | $table->primary_key( $field->name ) if $data{'is_primary_key'}; |
241 | # |
242 | # TODO: |
ef2d7798 |
243 | # - We should be able to make the table obj spot this when |
1223c9b2 |
244 | # we use add_field. |
245 | # |
246 | } |
247 | |
248 | } # Classes loop |
249 | |
250 | return 1; |
f8ec05fa |
251 | |
252 | }; |
253 | print "ERROR: $@\n" if $@; |
254 | return 1; |
1223c9b2 |
255 | } |
256 | |
257 | 1; |
258 | |
f8ec05fa |
259 | #============================================================================= |
260 | # |
261 | # XML::XPath extensions |
262 | # |
263 | #============================================================================= |
1223c9b2 |
264 | |
f8ec05fa |
265 | package XML::XPath::Function; |
1223c9b2 |
266 | |
f8ec05fa |
267 | =head1 XMI XPath Functions |
1223c9b2 |
268 | |
f8ec05fa |
269 | The Parser adds the following extra XPath functions. |
1223c9b2 |
270 | |
f8ec05fa |
271 | =head2 xmiDeref |
1223c9b2 |
272 | |
f8ec05fa |
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. |
1223c9b2 |
277 | |
f8ec05fa |
278 | If it doesn't have an xmi.id, the path is returned as normal. |
1223c9b2 |
279 | |
f8ec05fa |
280 | e.g. given |
1223c9b2 |
281 | |
f8ec05fa |
282 | <UML:ModelElement.stereotype> |
283 | <UML:Stereotype xmi.idref = 'stTable'/> |
284 | </UML:ModelElement.stereotype> |
285 | ... |
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> |
289 | </UML:Stereotype> |
1223c9b2 |
290 | |
f8ec05fa |
291 | Using xmideref(//UML:ModelElement.stereotype/UML:stereotype) would return the |
292 | <UML:Stereotype xmi.id = '3b4b1e:f762a35f6b:-7fb6' ...> tag. |
1223c9b2 |
293 | |
f8ec05fa |
294 | Using xmideref(//UML:ModelElement.stereotype/UML:stereotype)/@name would give |
295 | "Table". |
1223c9b2 |
296 | |
f8ec05fa |
297 | =head xmiVisible |
1223c9b2 |
298 | |
f8ec05fa |
299 | is_visible( VISLEVEL ) |
1223c9b2 |
300 | |
f8ec05fa |
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. |
1223c9b2 |
303 | |
f8ec05fa |
304 | //UML:Class[xmiVisible('public')] - Find all public classes |
305 | //UML:Class[xmiVisible('protected')] - Find all public and protected classes |
1223c9b2 |
306 | |
f8ec05fa |
307 | Supports the 3 UML visibility levels of public, protected and private. |
1223c9b2 |
308 | |
f8ec05fa |
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. |
1223c9b2 |
313 | |
f8ec05fa |
314 | =cut |
1223c9b2 |
315 | |
f8ec05fa |
316 | sub xmiDeref { |
317 | my $self = shift; |
318 | my ($node, @params) = @_; |
319 | if (@params > 1) { |
320 | die "xmiDeref() function takes one or no parameters\n"; |
321 | } |
322 | elsif (@params) { |
323 | my $nodeset = shift(@params); |
324 | return $nodeset unless $nodeset->size; |
325 | $node = $nodeset->get_node(1); |
326 | } |
327 | die "xmiDeref() needs an Element node." |
328 | unless $node->isa("XML::XPath::Node::Element"); |
1223c9b2 |
329 | |
f8ec05fa |
330 | my $id = $node->getAttribute("xmi.idref") or return $node; |
331 | return $node->getRootNode->find('//*[@xmi.id="'.$id.'"]'); |
332 | } |
333 | |
334 | { |
335 | my %vislevel = ( |
336 | public => 1, |
337 | protected => 2, |
338 | private => 3, |
339 | ); |
340 | |
341 | sub xmiVisible { |
342 | my $self = shift; |
343 | my ($node, @params) = @_; |
344 | if (@params < 1 or @params > 2) { |
345 | die "xmiVisible() function takes 1 or 2 parameters\n"; |
346 | } |
347 | elsif (@params == 2) { |
348 | my $nodeset = shift(@params); |
349 | return unless $nodeset->size; |
350 | $node = $nodeset->get_node(1); |
351 | } |
352 | die "xmiVisible() needs an Element node." |
353 | unless $node->isa("XML::XPath::Node::Element"); |
354 | |
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; |
361 | } |
362 | } |
363 | |
364 | # Test of custom xpath function. |
365 | sub hello { |
366 | return XML::XPath::Literal->new("Hello World"); |
367 | } |
368 | |
369 | #============================================================================= |
370 | package main; |
371 | |
372 | |
373 | =pod |
1223c9b2 |
374 | |
375 | =head1 BUGS |
376 | |
ef2d7798 |
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. |
379 | |
1223c9b2 |
380 | =head1 TODO |
381 | |
ef2d7798 |
382 | B<field sizes> Don't think UML does this directly so may need to include |
1223c9b2 |
383 | it in the datatype names. |
384 | |
ef2d7798 |
385 | B<table_visibility and field_visibility args> Seperate control over what is |
386 | parsed, setting visibility arg will set both. |
387 | |
1223c9b2 |
388 | Everything else! Relations, fkeys, constraints, indexes, etc... |
389 | |
390 | =head1 AUTHOR |
391 | |
392 | Mark D. Addison E<lt>mark.addison@itn.co.ukE<gt>. |
393 | |
394 | =head1 SEE ALSO |
395 | |
396 | perl(1), SQL::Translator, XML::XPath, SQL::Translator::Producer::XML::SQLFairy, |
397 | SQL::Translator::Schema. |
398 | |
399 | =cut |
f8ec05fa |
400 | |
401 | |