1 package SQL::Translator::XMI::Parser;
7 SQL::Translator::XMI::Parser- Perl class for blah blah blah
13 our $VERSION = "0.01";
16 use XML::XPath::XMLParser;
17 use Storable qw/dclone/;
20 #=============================================================================
22 # Describes the 2 xmi formats 1.2 and 1.0. Neither is complete!
24 # NB The names of the data keys MUST be the same for both specs so the
25 # data structures returned are the same.
27 # There is currently no way to set the data key name for attrib_data, it just
28 # uses the attribute name from the XMI. This isn't a problem at the moment as
29 # xmi1.0 names all these things with tags so we don't need the attrib data!
30 # Also use of names seems to be consistant between the versions.
35 my $spec12 = $SPECS->{"1.2"} = {};
40 default_path => '//UML:Class[@xmi.id]',
42 [qw/name visibility isSpecification isRoot isLeaf isAbstract isActive/],
46 path => 'xmiDeref(UML:ModelElement.stereotype/UML:Stereotype)/@name',
53 # name in data returned
54 path => "UML:Classifier.feature/UML:Attribute",
56 # Points to class in spec. get_attributes() called to parse it and
57 # adds filter_attributes to the args for get_classes().
59 # How many we get back. Use '1' for 1 and '*' for lots.
60 # TODO If not set then decide depening on the return?
64 path => "UML:Classifier.feature/UML:Operation",
69 name => "taggedValues",
70 path => 'UML:ModelElement.taggedValue/UML:TaggedValue',
71 class => "taggedValue",
74 # Add a _map_taggedValues to the data. Its a hash of the name data
75 # which refs the normal list of kids
80 $spec12->{taggedValue} = {
81 name => "taggedValue",
82 plural => "taggedValues",
83 default_path => '//UML:TaggedValue[@xmi.id]',
84 attrib_data => [qw/isSpecification/],
88 path => 'UML:TaggedValue.dataValue/text()',
92 path => 'xmiDeref(UML:TaggedValue.type/UML:TagDefinition)/@name',
97 $spec12->{attribute} = {
99 plural => "attributes",
100 default_path => '//UML:Classifier.feature/UML:Attribute[@xmi.id]',
102 [qw/name visibility isSpecification ownerScope/],
105 name => "stereotype",
106 path => 'xmiDeref(UML:ModelElement.stereotype/UML:Stereotype)/@name',
111 path => 'xmiDeref(UML:StructuralFeature.type/UML:DataType)/@name',
114 name => "initialValue",
115 path => 'UML:Attribute.initialValue/UML:Expression/@body',
120 name => "taggedValues",
121 path => 'UML:ModelElement.taggedValue/UML:TaggedValue',
122 class => "taggedValue",
129 $spec12->{operation} = {
131 plural => "operations",
132 default_path => '//UML:Classifier.feature/UML:Operation[@xmi.id]',
134 [qw/name visibility isSpecification ownerScope isQuery
135 concurrency isRoot isLeaf isAbstract/],
138 name => "stereotype",
139 path => 'xmiDeref(UML:ModelElement.stereotype/UML:Stereotype)/@name',
145 name => "parameters",
146 path => "UML:BehavioralFeature.parameter/UML:Parameter",
147 class => "parameter",
151 name => "taggedValues",
152 path => 'UML:ModelElement.taggedValue/UML:TaggedValue',
153 class => "taggedValue",
160 $spec12->{parameter} = {
162 plural => "parameters",
163 default_path => '//UML:Parameter[@xmi.id]',
164 attrib_data => [qw/name isSpecification kind/],
167 name => "stereotype",
168 path => 'xmiDeref(UML:ModelElement.stereotype/UML:Stereotype)/@name',
173 path => 'xmiDeref(UML:StructuralFeature.type/UML:DataType)/@name',
178 #-----------------------------------------------------------------------------
180 my $spec10 = $SPECS->{"1.0"} = {};
185 default_path => '//Foundation.Core.Class[@xmi.id]',
190 path => 'Foundation.Core.ModelElement.name/text()',
193 name => "visibility",
194 path => 'Foundation.Core.ModelElement.visibility/@xmi.value',
197 name => "isSpecification",
198 path => 'Foundation.Core.ModelElement.isSpecification/@xmi.value',
202 path => 'Foundation.Core.GeneralizableElement.isRoot/@xmi.value',
206 path => 'Foundation.Core.GeneralizableElement.isLeaf/@xmi.value',
209 name => "isAbstract",
210 path => 'Foundation.Core.GeneralizableElement.isAbstract/@xmi.value',
214 path => 'Foundation.Core.Class.isActive/@xmi.value',
219 name => "attributes",
221 'Foundation.Core.Classifier.feature/Foundation.Core.Attribute',
222 class => "attribute",
226 # name => "operations",
227 # path => "UML:Classifier.feature/UML:Operation",
228 # class => "operation",
229 # multiplicity => "*",
234 $spec10->{attribute} = {
236 plural => "attributes",
237 default_path => '//Foundation.Core.Attribute[@xmi.id]',
241 path => 'Foundation.Core.ModelElement.name/text()',
244 name => "visibility",
245 path => 'Foundation.Core.ModelElement.visibility/@xmi.value',
248 name => "isSpecification",
249 path => 'Foundation.Core.ModelElement.isSpecification/@xmi.value',
252 name => "ownerScope",
253 path => 'Foundation.Core.Feature.ownerScope/@xmi.value',
256 name => "initialValue",
257 path => 'Foundation.Core.Attribute.initialValue/Foundation.Data_Types.Expression/Foundation.Data_Types.Expression.body/text()',
260 # name => "datatype",
261 # path => 'xmiDeref(Foundation.Core.StructuralFeature.type/Foundation.Core.Classifier)/Foundation.Core.DataType/Foundation.Core.ModelElement.name/text()',
266 #=============================================================================
272 # The parser supports xmi1.0 and xmi1.2 based on the specs above. At new() time
273 # the version is read from the XMI tag and picks out a spec e.g.
274 # $SPECS->{"1.2"} and feeds it to mk_gets() which returns a hash ref of subs
275 # (think strategy pattern), one for each entry in the specs hash. This is held
276 # in $self->{xmi_get_}.
278 # When the class is use'd it sets dispatch methods with
279 # mk_get_dispatch() that return the call using the corresponding sub in
280 # $self->{xmi_get_}. e.g.
282 # sub get_classes { $_[0]->{xmi_get_}{classes}->(@_); }
283 # sub get_attributes { $_[0]->{xmi_get_}{attributes}->(@_); }
284 # sub get_classes { $_[0]->{xmi_get_}{classes}->(@_); }
286 # The names for the data keys in the specs must match up so that we get the
287 # same data structure for each version.
291 foreach ( values %$SPECS ) { init_specs($_) };
294 # Build lookups etc. Its important that each spec item becomes self contained
295 # so we can build good closures, therefore we do all the lookups 1st.
299 foreach my $spec ( values %$specs ) {
300 # Look up for kids get method
301 foreach ( @{$spec->{kids}} ) {
302 $_->{get_method} = "get_".$specs->{$_->{class}}{plural};
305 # Add xmi.id ti all specs. Everything we want at the moment (in both
306 # versions) has an id. The tags that don't seem to be used for
308 my $attrib_data = $spec->{attrib_data} ||= [];
309 push @$attrib_data, "xmi.id";
314 # Generate get_* subs to dispach the calls to the subs held in $me->{xmi_get_}
315 sub mk_get_dispatch {
316 foreach ( values %{$SPECS->{"1.2"}} ) {
317 my $name = $_->{plural};
321 *{"get_$name"} = sub {
323 #$me->{xmi_get_}{$name}->($me,@_);
324 $_[0]->{xmi_get_}{$name}->(@_);
331 my $class = ref($proto) || $proto;
335 # Create the XML::XPath object
336 # TODO Docs recommend we only use 1 XPath object per application
338 foreach (qw/filename xml ioref/) {
340 $xp = XML::XPath->new( $_ => $args{$_});
341 $xp->set_namespace("UML", "org.omg.xmi.namespace.UML");
345 $me = { xml_xpath => $xp };
347 # Work out the version of XMI we have and generate the get subs to parse it
348 my $xmiv = $args{xmi_version}
349 || "".$xp->findvalue('/XMI/@xmi.version')
350 || die "Can't find XMI version";
351 $me->{xmi_get_} = mk_gets($SPECS->{$xmiv});
353 return bless $me, $class;
357 # Returns hashref of get subs from set of specs e.g. $SPECS->{"1.2"}
360 # * Add a memoize so we don't keep regenerating the subs for every use.
364 foreach ( values %$specs ) {
365 # Clone from specs and sort out the lookups into it so we get a
366 # self contained spec to use as a proper closure.
367 my $spec = dclone($_);
370 $gets->{$spec->{plural}} = mk_get($spec);
378 # Generates and returns a get_ sub for the spec given. e.g. give it
379 # $SPECS->{"1.2"}->{classes} to get the code for xmi 1.2 get_classes. So, if
380 # you want to change how the get methods work do it here!
382 # The get methods made have the args described in the docs and 2 private args
383 # used internally, to call other get methods from paths in the spec.
385 # NB: DO NOT use publicly as you will break the version independance. e.g. When
386 # using _xpath you need to know which version of XMI to use. This is handled by
387 # the use of different paths in the specs.
389 # _context => The context node to use, if not given starts from root.
391 # _xpath => The xpath to use for finding stuff.
397 # get_* closure using $spec
399 my ($me, %args) = @_;
400 my $xp = delete $args{_context} || $me->{xml_xpath};
403 my $xpath = $args{_xpath} ||= $spec->{default_path};
404 #warn "Searching for $spec->{plural} using:$xpath\n";
406 my @nodes = $xp->findnodes($xpath);
407 return unless @nodes;
409 for my $node (@nodes) {
411 # my $thing = { xpNode => $node };
413 # Get the Tag attributes
414 foreach ( @{$spec->{attrib_data}} ) {
415 $thing->{$_} = $node->getAttribute($_);
419 foreach ( @{$spec->{path_data}} ) {
420 #warn "Searching for $spec->{plural} - $_->{name} using:$_->{path}\n";
421 my @nodes = $node->findnodes($_->{path});
422 $thing->{$_->{name}} = @nodes ? $nodes[0]->getData
423 : (exists $_->{default} ? $_->{default} : undef);
426 # Run any filters set
428 # Should we do this after the kids as we may want to test them?
429 # e.g. test for number of attribs
430 if ( my $filter = $args{filter} ) {
432 next unless $filter->($thing);
437 foreach ( @{$spec->{kids}} ) {
439 my $meth = $_->{get_method};
440 my $path = $_->{path};
441 $data = $me->$meth( _context => $node, _xpath => $path,
442 filter => $args{"filter_$_->{name}"} );
444 if ( $_->{multiplicity} eq "1" ) {
445 $thing->{$_->{name}} = shift @$data;
448 my $kids = $thing->{$_->{name}} = $data || [];
449 if ( my $key = $_->{"map"} ) {
450 $thing->{"_map_$_->{name}"} = _mk_map($kids,$key);
455 push @$things, $thing;
457 return wantarray ? @$things : $things;
463 my ($kids,$key) = @_;
466 $map->{$_->{$key}} = $_ if exists $_->{$key};
471 1; #===========================================================================
474 package XML::XPath::Function;
477 # May need to look at doing deref on all paths just to be on the safe side!
479 # Will also want some caching as these calls are expensive as the whole doc
480 # is used but the same ref will likley be requested lots of times.
484 my ($node, @params) = @_;
486 die "xmiDeref() function takes one or no parameters\n";
489 my $nodeset = shift(@params);
490 return $nodeset unless $nodeset->size;
491 $node = $nodeset->get_node(1);
493 die "xmiDeref() needs an Element node."
494 unless $node->isa("XML::XPath::Node::Element");
496 my $id = $node->getAttribute("xmi.idref") or return $node;
497 return $node->getRootNode->find('//*[@xmi.id="'.$id.'"]');
508 use SQL::Translator::XMI::Parser;
509 my $xmip = SQL::Translator::XMI::Parser->new( xml => $xml );
510 my $classes = $xmip->get_classes();
514 Parses XMI files (XML version of UML diagrams) to perl data structures and
515 provides hooks to filter the data down to what you want.
519 Pass in name/value arg of either C<filename>, C<xml> or C<ioref> for the XMI
520 data you want to parse.
522 The version of XMI to use either 1.0 or 1.2 is worked out from the file. You
523 can also use a C<xmi_version> arg to set it explicitley.
527 Doc below is for classes method, all the other calls follow this form.
529 =head2 get_classes( ARGS )
531 ARGS - Name/Value list of args.
533 filter => A sub to filter the node to see if we want it. Has the nodes data,
534 before kids are added, referenced to $_. Should return true if you
535 want it, false otherwise.
537 e.g. To find only classes with a "Foo" stereotype.
539 filter => sub { return $_->{stereotype} eq "Foo"; }
541 filter_attributes => A filter sub to pass onto get_attributes.
543 filter_operations => A filter sub to pass onto get_operations.
545 Returns a perl data structure including all the kids. e.g.
549 'visibility' => 'public',
550 'isActive' => 'false',
551 'isAbstract' => 'false',
552 'isSpecification' => 'false',
553 'stereotype' => 'Table',
559 'stereotype' => 'PK',
561 'ownerScope' => 'instance',
562 'visibility' => 'public',
563 'initialValue' => undef,
564 'isSpecification' => 'false',
569 'datatype' => 'varchar'
570 'ownerScope' => 'instance',
571 'visibility' => 'public',
572 'initialValue' => '',
573 'isSpecification' => 'false',
579 'isQuery' => 'false',
580 'ownerScope' => 'instance',
581 'visibility' => 'public',
582 'isSpecification' => 'false',
584 'isAbstract' => 'false',
587 'concurrency' => 'sequential'
591 'isSpecification' => 'false',
598 'isSpecification' => 'false',
605 'isSpecification' => 'false',
615 =head1 XMI XPath Functions
617 The Parser adds the following extra XPath functions for use in the SPECS.
621 Deals with xmi.id/xmi.idref pairs of attributes. You give it an
622 xPath e.g 'UML:ModelElement.stereotype/UML:stereotype' if the the
623 tag it points at has an xmi.idref it looks up the tag with that
624 xmi.id and returns it.
626 If it doesn't have an xmi.id, the path is returned as normal.
630 <UML:ModelElement.stereotype>
631 <UML:Stereotype xmi.idref = 'stTable'/>
632 </UML:ModelElement.stereotype>
634 <UML:Stereotype xmi.id='stTable' name='Table' visibility='public'
635 isAbstract='false' isSpecification='false' isRoot='false' isLeaf='false'>
636 <UML:Stereotype.baseClass>Class</UML:Stereotype.baseClass>
639 Using xmideref(//UML:ModelElement.stereotype/UML:stereotype) would return the
640 <UML:Stereotype xmi.id = '3b4b1e:f762a35f6b:-7fb6' ...> tag.
642 Using xmideref(//UML:ModelElement.stereotype/UML:stereotype)/@name would give
653 =head1 VERSION HISTORY
657 grommit <mark.addison@itn.co.uk>
661 This package is free software and is provided "as is" without express or
662 implied warranty. It may be used, redistributed and/or modified under the
665 a) the Perl Artistic License.
667 See F<http://www.perl.com/perl/misc/Artistic.html>
669 b) the terms of the GNU General Public License as published by the Free Software
670 Foundation; either version 1, or (at your option) any later version.