Commit | Line | Data |
f42065cb |
1 | package SQL::Translator::XMI::Parser; |
2 | |
93f4a354 |
3 | # ------------------------------------------------------------------- |
30744474 |
4 | # $Id: Parser.pm,v 1.8 2003-10-06 15:03:07 grommit Exp $ |
93f4a354 |
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 | |
f42065cb |
23 | =pod |
24 | |
25 | =head1 NAME |
26 | |
93f4a354 |
27 | SQL::Translator::XMI::Parser - XMI Parser class for use in SQL Fairy's XMI |
28 | parser. |
f42065cb |
29 | |
30 | =cut |
31 | |
32 | use strict; |
33 | use 5.006_001; |
93f4a354 |
34 | use vars qw/$VERSION/; |
30744474 |
35 | $VERSION = sprintf "%d.%02d", q$Revision: 1.8 $ =~ /(\d+)\.(\d+)/; |
f42065cb |
36 | |
93f4a354 |
37 | use Data::Dumper; |
f42065cb |
38 | use XML::XPath; |
39 | use XML::XPath::XMLParser; |
40 | use Storable qw/dclone/; |
41 | |
42 | # Spec |
93f4a354 |
43 | #------ |
44 | # See SQL::Translator::XMI::Parser::V12 and SQL::Translator::XMI::Parser:V10 |
45 | # for examples. |
f42065cb |
46 | # |
93f4a354 |
47 | # Hash ref used to describe the 2 xmi formats 1.2 and 1.0. Neither is complete! |
f42065cb |
48 | # |
49 | # NB The names of the data keys MUST be the same for both specs so the |
50 | # data structures returned are the same. |
51 | # |
93f4a354 |
52 | # TODO |
53 | # |
54 | # * There is currently no way to set the data key name for attrib_data, it just |
f42065cb |
55 | # uses the attribute name from the XMI. This isn't a problem at the moment as |
56 | # xmi1.0 names all these things with tags so we don't need the attrib data! |
57 | # Also use of names seems to be consistant between the versions. |
58 | # |
f42065cb |
59 | # |
93f4a354 |
60 | # XmiSpec( $spec ) |
f42065cb |
61 | # |
93f4a354 |
62 | # Call as class method to set up the parser from a spec (see above). This |
63 | # generates the get_ methods for the version of XMI the spec is for. Called by |
64 | # the sub-classes (e.g. V12 and V10) to create parsers for each version. |
f42065cb |
65 | # |
93f4a354 |
66 | sub XmiSpec { |
67 | my ($me,$spec) = @_; |
42b5b9b6 |
68 | _init_specs($spec); |
69 | $me->_mk_gets($spec); |
93f4a354 |
70 | } |
f42065cb |
71 | |
72 | # Build lookups etc. Its important that each spec item becomes self contained |
b4b9f867 |
73 | # so we can build good closures, therefore we do all the lookups 1st. |
42b5b9b6 |
74 | sub _init_specs { |
f42065cb |
75 | my $specs = shift; |
76 | |
77 | foreach my $spec ( values %$specs ) { |
b4b9f867 |
78 | # Look up for kids get method |
79 | foreach ( @{$spec->{kids}} ) { |
f42065cb |
80 | $_->{get_method} = "get_".$specs->{$_->{class}}{plural}; |
81 | } |
0b3f94e0 |
82 | |
b4b9f867 |
83 | # Add xmi.id ti all specs. Everything we want at the moment (in both |
84 | # versions) has an id. The tags that don't seem to be used for |
85 | # structure. |
86 | my $attrib_data = $spec->{attrib_data} ||= []; |
87 | push @$attrib_data, "xmi.id"; |
f42065cb |
88 | } |
89 | |
90 | } |
91 | |
93f4a354 |
92 | # Create get methods from spec |
93 | # |
42b5b9b6 |
94 | sub _mk_gets { |
93f4a354 |
95 | my ($proto,$specs) = @_; |
96 | my $class = ref($proto) || $proto; |
97 | foreach ( values %$specs ) { |
98 | # Clone from specs and sort out the lookups into it so we get a |
99 | # self contained spec to use as a proper closure. |
100 | my $spec = dclone($_); |
101 | |
102 | # Create _get_* method with get_* as an alias unless the user has |
103 | # defined it. Allows for override. Note the alias is in this package |
104 | # so we can add overrides to both specs. |
105 | no strict "refs"; |
106 | my $meth = "_get_$spec->{plural}"; |
42b5b9b6 |
107 | *{$meth} = _mk_get($spec); |
93f4a354 |
108 | *{__PACKAGE__."::get_$spec->{plural}"} = sub {shift->$meth(@_);} |
109 | unless $class->can("get_$spec->{plural}"); |
f42065cb |
110 | } |
111 | } |
112 | |
93f4a354 |
113 | # |
114 | # Sets up the XML::XPath object and then checks the version of the XMI file and |
115 | # blesses its self into either the V10 or V12 class. |
116 | # |
f42065cb |
117 | sub new { |
118 | my $proto = shift; |
119 | my $class = ref($proto) || $proto; |
120 | my %args = @_; |
121 | my $me = {}; |
93f4a354 |
122 | |
f42065cb |
123 | # Create the XML::XPath object |
124 | # TODO Docs recommend we only use 1 XPath object per application |
125 | my $xp; |
126 | foreach (qw/filename xml ioref/) { |
127 | if ($args{$_}) { |
128 | $xp = XML::XPath->new( $_ => $args{$_}); |
129 | $xp->set_namespace("UML", "org.omg.xmi.namespace.UML"); |
130 | last; |
131 | } |
132 | } |
133 | $me = { xml_xpath => $xp }; |
93f4a354 |
134 | |
135 | # Work out the version of XMI we have and return as that sub class |
136 | my $xmiv = $args{xmi_version} |
b4b9f867 |
137 | || "".$xp->findvalue('/XMI/@xmi.version') |
138 | || die "Can't find XMI version"; |
93f4a354 |
139 | $xmiv =~ s/[.]//g; |
140 | $class = __PACKAGE__."::V$xmiv"; |
141 | eval "use $class;"; |
142 | die "Failed to load version sub class $class : $@" if $@; |
f42065cb |
143 | |
93f4a354 |
144 | return bless $me, $class; |
f42065cb |
145 | } |
146 | |
93f4a354 |
147 | # |
42b5b9b6 |
148 | # _mk_get |
f42065cb |
149 | # |
93f4a354 |
150 | # Generates and returns a get_ sub for the spec given. |
151 | # So, if you want to change how the get methods (e.g. get_classes) work do it |
152 | # here! |
f42065cb |
153 | # |
154 | # The get methods made have the args described in the docs and 2 private args |
155 | # used internally, to call other get methods from paths in the spec. |
f42065cb |
156 | # NB: DO NOT use publicly as you will break the version independance. e.g. When |
157 | # using _xpath you need to know which version of XMI to use. This is handled by |
158 | # the use of different paths in the specs. |
b2a00f50 |
159 | # |
f42065cb |
160 | # _context => The context node to use, if not given starts from root. |
b2a00f50 |
161 | # |
f42065cb |
162 | # _xpath => The xpath to use for finding stuff. |
b2a00f50 |
163 | # |
42b5b9b6 |
164 | sub _mk_get { |
f42065cb |
165 | my $spec = shift; |
b2a00f50 |
166 | |
f42065cb |
167 | # get_* closure using $spec |
168 | return sub { |
169 | my ($me, %args) = @_; |
170 | my $xp = delete $args{_context} || $me->{xml_xpath}; |
171 | my $things; |
172 | |
173 | my $xpath = $args{_xpath} ||= $spec->{default_path}; |
174 | #warn "Searching for $spec->{plural} using:$xpath\n"; |
175 | |
176 | my @nodes = $xp->findnodes($xpath); |
0b3f94e0 |
177 | #warn "None.\n" unless @nodes; |
f42065cb |
178 | return unless @nodes; |
179 | |
180 | for my $node (@nodes) { |
0b3f94e0 |
181 | #warn " Found $spec->{name} xmi.id=".$node->getAttribute("xmi.id")." name=".$node->getAttribute("name")."\n"; |
f42065cb |
182 | my $thing = {}; |
183 | # my $thing = { xpNode => $node }; |
b2a00f50 |
184 | |
0b3f94e0 |
185 | # Have we seen this before? If so just use the ref we have. |
186 | if ( my $id = $node->getAttribute("xmi.id") ) { |
187 | if ( my $foo = $me->{model}{things}{$id} ) { |
188 | #warn " Reffing from model **********************\n"; |
189 | push @$things, $foo; |
190 | next; |
191 | } |
192 | } |
193 | |
f42065cb |
194 | # Get the Tag attributes |
6e694599 |
195 | #warn " getting attribs: ",join(" ",@{$spec->{attrib_data}}),"\n"; |
f42065cb |
196 | foreach ( @{$spec->{attrib_data}} ) { |
197 | $thing->{$_} = $node->getAttribute($_); |
198 | } |
6e694599 |
199 | #warn " got attribs: ",(map "$_=$thing->{$_}", keys %$thing),"\n"; |
b2a00f50 |
200 | |
f42065cb |
201 | # Add the path data |
202 | foreach ( @{$spec->{path_data}} ) { |
6e694599 |
203 | #warn " getting path data $_->{name} : $_->{path}\n"; |
f42065cb |
204 | my @nodes = $node->findnodes($_->{path}); |
205 | $thing->{$_->{name}} = @nodes ? $nodes[0]->getData |
206 | : (exists $_->{default} ? $_->{default} : undef); |
6e694599 |
207 | #warn " got path data $_->{name}=$thing->{$_->{name}}\n"; |
f42065cb |
208 | } |
b2a00f50 |
209 | |
210 | # Run any filters set |
211 | # |
f42065cb |
212 | # Should we do this after the kids as we may want to test them? |
213 | # e.g. test for number of attribs |
214 | if ( my $filter = $args{filter} ) { |
215 | local $_ = $thing; |
216 | next unless $filter->($thing); |
217 | } |
b2a00f50 |
218 | |
0b3f94e0 |
219 | # Add anything with an id to the things lookup |
220 | push @$things, $thing; |
221 | if ( exists $thing->{"xmi.id"} and defined $thing->{"xmi.id"} |
222 | and my $id = $thing->{"xmi.id"} |
223 | ) { |
224 | $me->{model}{things}{$id} = $thing; } |
225 | |
f42065cb |
226 | # Kids |
227 | # |
228 | foreach ( @{$spec->{kids}} ) { |
b2a00f50 |
229 | my $data; |
f42065cb |
230 | my $meth = $_->{get_method}; |
b2a00f50 |
231 | my $path = $_->{path}; |
0b3f94e0 |
232 | |
233 | # Variable subs on the path from thing |
234 | $path =~ s/\$\{(.*?)\}/$thing->{$1}/g; |
b2a00f50 |
235 | $data = $me->$meth( _context => $node, _xpath => $path, |
f42065cb |
236 | filter => $args{"filter_$_->{name}"} ); |
f42065cb |
237 | if ( $_->{multiplicity} eq "1" ) { |
238 | $thing->{$_->{name}} = shift @$data; |
239 | } |
240 | else { |
b2a00f50 |
241 | my $kids = $thing->{$_->{name}} = $data || []; |
242 | if ( my $key = $_->{"map"} ) { |
243 | $thing->{"_map_$_->{name}"} = _mk_map($kids,$key); |
244 | } |
f42065cb |
245 | } |
246 | } |
0b3f94e0 |
247 | } |
f42065cb |
248 | |
0b3f94e0 |
249 | if ( $spec->{isRoot} ) { |
250 | push(@{$me->{model}{$spec->{plural}}}, $_) foreach @$things; |
f42065cb |
251 | } |
0b3f94e0 |
252 | return $things; |
f42065cb |
253 | } # /closure sub |
254 | |
42b5b9b6 |
255 | } # /_mk_get |
f42065cb |
256 | |
b2a00f50 |
257 | sub _mk_map { |
258 | my ($kids,$key) = @_; |
259 | my $map = {}; |
260 | foreach (@$kids) { |
261 | $map->{$_->{$key}} = $_ if exists $_->{$key}; |
262 | } |
263 | return $map; |
264 | } |
265 | |
42b5b9b6 |
266 | sub get_associations { |
267 | my $assoc = shift->_get_associations(@_); |
268 | foreach (@$assoc) { |
30744474 |
269 | next unless defined $_->{associationEnds}; # Wait until we get all of an association |
270 | my @ends = @{$_->{associationEnds}}; |
42b5b9b6 |
271 | if (@ends != 2) { |
272 | warn "Sorry can't handle otherEnd associations with more than 2 ends"; |
273 | return $assoc; |
274 | } |
275 | $ends[0]{otherEnd} = $ends[1]; |
276 | $ends[1]{otherEnd} = $ends[0]; |
277 | } |
278 | return $assoc; |
279 | } |
280 | |
f42065cb |
281 | 1; #=========================================================================== |
282 | |
283 | |
284 | package XML::XPath::Function; |
285 | |
286 | # |
287 | # May need to look at doing deref on all paths just to be on the safe side! |
288 | # |
289 | # Will also want some caching as these calls are expensive as the whole doc |
290 | # is used but the same ref will likley be requested lots of times. |
291 | # |
292 | sub xmiDeref { |
293 | my $self = shift; |
294 | my ($node, @params) = @_; |
6e694599 |
295 | my $nodeset; |
f42065cb |
296 | if (@params > 1) { |
297 | die "xmiDeref() function takes one or no parameters\n"; |
298 | } |
299 | elsif (@params) { |
6e694599 |
300 | $nodeset = shift(@params); |
f42065cb |
301 | return $nodeset unless $nodeset->size; |
302 | $node = $nodeset->get_node(1); |
303 | } |
304 | die "xmiDeref() needs an Element node." |
305 | unless $node->isa("XML::XPath::Node::Element"); |
306 | |
6e694599 |
307 | my $id = $node->getAttribute("xmi.idref") || return ($nodeset || $node); |
f42065cb |
308 | return $node->getRootNode->find('//*[@xmi.id="'.$id.'"]'); |
6e694599 |
309 | # TODO We should use the tag name to search from the source |
f42065cb |
310 | } |
311 | |
312 | |
313 | # compile please |
314 | 1; |
315 | |
316 | __END__ |
317 | |
318 | =head1 SYNOPSIS |
319 | |
320 | use SQL::Translator::XMI::Parser; |
321 | my $xmip = SQL::Translator::XMI::Parser->new( xml => $xml ); |
322 | my $classes = $xmip->get_classes(); |
323 | |
324 | =head1 DESCRIPTION |
325 | |
326 | Parses XMI files (XML version of UML diagrams) to perl data structures and |
327 | provides hooks to filter the data down to what you want. |
328 | |
329 | =head2 new |
330 | |
b4b9f867 |
331 | Pass in name/value arg of either C<filename>, C<xml> or C<ioref> for the XMI |
332 | data you want to parse. |
333 | |
334 | The version of XMI to use either 1.0 or 1.2 is worked out from the file. You |
335 | can also use a C<xmi_version> arg to set it explicitley. |
f42065cb |
336 | |
337 | =head2 get_* methods |
338 | |
339 | Doc below is for classes method, all the other calls follow this form. |
340 | |
341 | =head2 get_classes( ARGS ) |
342 | |
343 | ARGS - Name/Value list of args. |
344 | |
345 | filter => A sub to filter the node to see if we want it. Has the nodes data, |
346 | before kids are added, referenced to $_. Should return true if you |
347 | want it, false otherwise. |
348 | |
349 | e.g. To find only classes with a "Foo" stereotype. |
350 | |
351 | filter => sub { return $_->{stereotype} eq "Foo"; } |
352 | |
353 | filter_attributes => A filter sub to pass onto get_attributes. |
354 | |
355 | filter_operations => A filter sub to pass onto get_operations. |
356 | |
357 | Returns a perl data structure including all the kids. e.g. |
358 | |
359 | { |
360 | 'name' => 'Foo', |
361 | 'visibility' => 'public', |
362 | 'isActive' => 'false', |
363 | 'isAbstract' => 'false', |
364 | 'isSpecification' => 'false', |
365 | 'stereotype' => 'Table', |
366 | 'isRoot' => 'false', |
367 | 'isLeaf' => 'false', |
368 | 'attributes' => [ |
369 | { |
370 | 'name' => 'fooid', |
371 | 'stereotype' => 'PK', |
372 | 'datatype' => 'int' |
373 | 'ownerScope' => 'instance', |
374 | 'visibility' => 'public', |
375 | 'initialValue' => undef, |
376 | 'isSpecification' => 'false', |
377 | }, |
378 | { |
379 | 'name' => 'name', |
380 | 'stereotype' => '', |
381 | 'datatype' => 'varchar' |
382 | 'ownerScope' => 'instance', |
383 | 'visibility' => 'public', |
384 | 'initialValue' => '', |
385 | 'isSpecification' => 'false', |
386 | }, |
387 | ] |
388 | 'operations' => [ |
389 | { |
390 | 'name' => 'magic', |
391 | 'isQuery' => 'false', |
392 | 'ownerScope' => 'instance', |
393 | 'visibility' => 'public', |
394 | 'isSpecification' => 'false', |
395 | 'stereotype' => '', |
396 | 'isAbstract' => 'false', |
397 | 'isLeaf' => 'false', |
398 | 'isRoot' => 'false', |
399 | 'concurrency' => 'sequential' |
400 | 'parameters' => [ |
401 | { |
402 | 'kind' => 'inout', |
403 | 'isSpecification' => 'false', |
404 | 'stereotype' => '', |
405 | 'name' => 'arg1', |
406 | 'datatype' => undef |
407 | }, |
408 | { |
409 | 'kind' => 'inout', |
410 | 'isSpecification' => 'false', |
411 | 'stereotype' => '', |
412 | 'name' => 'arg2', |
413 | 'datatype' => undef |
414 | }, |
415 | { |
416 | 'kind' => 'return', |
417 | 'isSpecification' => 'false', |
418 | 'stereotype' => '', |
419 | 'name' => 'return', |
420 | 'datatype' => undef |
421 | } |
422 | ], |
423 | } |
424 | ], |
425 | } |
426 | |
427 | =head1 XMI XPath Functions |
428 | |
93f4a354 |
429 | The Parser adds the following extra XPath functions for use in the Specs. |
f42065cb |
430 | |
431 | =head2 xmiDeref |
432 | |
433 | Deals with xmi.id/xmi.idref pairs of attributes. You give it an |
434 | xPath e.g 'UML:ModelElement.stereotype/UML:stereotype' if the the |
435 | tag it points at has an xmi.idref it looks up the tag with that |
436 | xmi.id and returns it. |
437 | |
438 | If it doesn't have an xmi.id, the path is returned as normal. |
439 | |
440 | e.g. given |
441 | |
442 | <UML:ModelElement.stereotype> |
443 | <UML:Stereotype xmi.idref = 'stTable'/> |
444 | </UML:ModelElement.stereotype> |
445 | ... |
446 | <UML:Stereotype xmi.id='stTable' name='Table' visibility='public' |
447 | isAbstract='false' isSpecification='false' isRoot='false' isLeaf='false'> |
448 | <UML:Stereotype.baseClass>Class</UML:Stereotype.baseClass> |
449 | </UML:Stereotype> |
450 | |
451 | Using xmideref(//UML:ModelElement.stereotype/UML:stereotype) would return the |
452 | <UML:Stereotype xmi.id = '3b4b1e:f762a35f6b:-7fb6' ...> tag. |
453 | |
454 | Using xmideref(//UML:ModelElement.stereotype/UML:stereotype)/@name would give |
455 | "Table". |
456 | |
457 | =head1 SEE ALSO |
458 | |
459 | perl(1). |
460 | |
461 | =head1 TODO |
462 | |
463 | =head1 BUGS |
464 | |
465 | =head1 VERSION HISTORY |
466 | |
467 | =head1 AUTHOR |
468 | |
469 | grommit <mark.addison@itn.co.uk> |
470 | |
f42065cb |
471 | =cut |