1 package SQL::Translator::XMI::Parser;
3 # -------------------------------------------------------------------
4 # $Id: Parser.pm,v 1.8 2003-10-06 15:03: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 # -------------------------------------------------------------------
27 SQL::Translator::XMI::Parser - XMI Parser class for use in SQL Fairy's XMI
34 use vars qw/$VERSION/;
35 $VERSION = sprintf "%d.%02d", q$Revision: 1.8 $ =~ /(\d+)\.(\d+)/;
39 use XML::XPath::XMLParser;
40 use Storable qw/dclone/;
44 # See SQL::Translator::XMI::Parser::V12 and SQL::Translator::XMI::Parser:V10
47 # Hash ref used to describe the 2 xmi formats 1.2 and 1.0. Neither is complete!
49 # NB The names of the data keys MUST be the same for both specs so the
50 # data structures returned are the same.
54 # * There is currently no way to set the data key name for attrib_data, it just
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.
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.
72 # Build lookups etc. Its important that each spec item becomes self contained
73 # so we can build good closures, therefore we do all the lookups 1st.
77 foreach my $spec ( values %$specs ) {
78 # Look up for kids get method
79 foreach ( @{$spec->{kids}} ) {
80 $_->{get_method} = "get_".$specs->{$_->{class}}{plural};
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
86 my $attrib_data = $spec->{attrib_data} ||= [];
87 push @$attrib_data, "xmi.id";
92 # Create get methods from spec
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($_);
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.
106 my $meth = "_get_$spec->{plural}";
107 *{$meth} = _mk_get($spec);
108 *{__PACKAGE__."::get_$spec->{plural}"} = sub {shift->$meth(@_);}
109 unless $class->can("get_$spec->{plural}");
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.
119 my $class = ref($proto) || $proto;
123 # Create the XML::XPath object
124 # TODO Docs recommend we only use 1 XPath object per application
126 foreach (qw/filename xml ioref/) {
128 $xp = XML::XPath->new( $_ => $args{$_});
129 $xp->set_namespace("UML", "org.omg.xmi.namespace.UML");
133 $me = { xml_xpath => $xp };
135 # Work out the version of XMI we have and return as that sub class
136 my $xmiv = $args{xmi_version}
137 || "".$xp->findvalue('/XMI/@xmi.version')
138 || die "Can't find XMI version";
140 $class = __PACKAGE__."::V$xmiv";
142 die "Failed to load version sub class $class : $@" if $@;
144 return bless $me, $class;
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
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.
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.
160 # _context => The context node to use, if not given starts from root.
162 # _xpath => The xpath to use for finding stuff.
167 # get_* closure using $spec
169 my ($me, %args) = @_;
170 my $xp = delete $args{_context} || $me->{xml_xpath};
173 my $xpath = $args{_xpath} ||= $spec->{default_path};
174 #warn "Searching for $spec->{plural} using:$xpath\n";
176 my @nodes = $xp->findnodes($xpath);
177 #warn "None.\n" unless @nodes;
178 return unless @nodes;
180 for my $node (@nodes) {
181 #warn " Found $spec->{name} xmi.id=".$node->getAttribute("xmi.id")." name=".$node->getAttribute("name")."\n";
183 # my $thing = { xpNode => $node };
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";
194 # Get the Tag attributes
195 #warn " getting attribs: ",join(" ",@{$spec->{attrib_data}}),"\n";
196 foreach ( @{$spec->{attrib_data}} ) {
197 $thing->{$_} = $node->getAttribute($_);
199 #warn " got attribs: ",(map "$_=$thing->{$_}", keys %$thing),"\n";
202 foreach ( @{$spec->{path_data}} ) {
203 #warn " getting path data $_->{name} : $_->{path}\n";
204 my @nodes = $node->findnodes($_->{path});
205 $thing->{$_->{name}} = @nodes ? $nodes[0]->getData
206 : (exists $_->{default} ? $_->{default} : undef);
207 #warn " got path data $_->{name}=$thing->{$_->{name}}\n";
210 # Run any filters set
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} ) {
216 next unless $filter->($thing);
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"}
224 $me->{model}{things}{$id} = $thing; }
228 foreach ( @{$spec->{kids}} ) {
230 my $meth = $_->{get_method};
231 my $path = $_->{path};
233 # Variable subs on the path from thing
234 $path =~ s/\$\{(.*?)\}/$thing->{$1}/g;
235 $data = $me->$meth( _context => $node, _xpath => $path,
236 filter => $args{"filter_$_->{name}"} );
237 if ( $_->{multiplicity} eq "1" ) {
238 $thing->{$_->{name}} = shift @$data;
241 my $kids = $thing->{$_->{name}} = $data || [];
242 if ( my $key = $_->{"map"} ) {
243 $thing->{"_map_$_->{name}"} = _mk_map($kids,$key);
249 if ( $spec->{isRoot} ) {
250 push(@{$me->{model}{$spec->{plural}}}, $_) foreach @$things;
258 my ($kids,$key) = @_;
261 $map->{$_->{$key}} = $_ if exists $_->{$key};
266 sub get_associations {
267 my $assoc = shift->_get_associations(@_);
269 next unless defined $_->{associationEnds}; # Wait until we get all of an association
270 my @ends = @{$_->{associationEnds}};
272 warn "Sorry can't handle otherEnd associations with more than 2 ends";
275 $ends[0]{otherEnd} = $ends[1];
276 $ends[1]{otherEnd} = $ends[0];
281 1; #===========================================================================
284 package XML::XPath::Function;
287 # May need to look at doing deref on all paths just to be on the safe side!
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.
294 my ($node, @params) = @_;
297 die "xmiDeref() function takes one or no parameters\n";
300 $nodeset = shift(@params);
301 return $nodeset unless $nodeset->size;
302 $node = $nodeset->get_node(1);
304 die "xmiDeref() needs an Element node."
305 unless $node->isa("XML::XPath::Node::Element");
307 my $id = $node->getAttribute("xmi.idref") || return ($nodeset || $node);
308 return $node->getRootNode->find('//*[@xmi.id="'.$id.'"]');
309 # TODO We should use the tag name to search from the source
320 use SQL::Translator::XMI::Parser;
321 my $xmip = SQL::Translator::XMI::Parser->new( xml => $xml );
322 my $classes = $xmip->get_classes();
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.
331 Pass in name/value arg of either C<filename>, C<xml> or C<ioref> for the XMI
332 data you want to parse.
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.
339 Doc below is for classes method, all the other calls follow this form.
341 =head2 get_classes( ARGS )
343 ARGS - Name/Value list of args.
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.
349 e.g. To find only classes with a "Foo" stereotype.
351 filter => sub { return $_->{stereotype} eq "Foo"; }
353 filter_attributes => A filter sub to pass onto get_attributes.
355 filter_operations => A filter sub to pass onto get_operations.
357 Returns a perl data structure including all the kids. e.g.
361 'visibility' => 'public',
362 'isActive' => 'false',
363 'isAbstract' => 'false',
364 'isSpecification' => 'false',
365 'stereotype' => 'Table',
371 'stereotype' => 'PK',
373 'ownerScope' => 'instance',
374 'visibility' => 'public',
375 'initialValue' => undef,
376 'isSpecification' => 'false',
381 'datatype' => 'varchar'
382 'ownerScope' => 'instance',
383 'visibility' => 'public',
384 'initialValue' => '',
385 'isSpecification' => 'false',
391 'isQuery' => 'false',
392 'ownerScope' => 'instance',
393 'visibility' => 'public',
394 'isSpecification' => 'false',
396 'isAbstract' => 'false',
399 'concurrency' => 'sequential'
403 'isSpecification' => 'false',
410 'isSpecification' => 'false',
417 'isSpecification' => 'false',
427 =head1 XMI XPath Functions
429 The Parser adds the following extra XPath functions for use in the Specs.
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.
438 If it doesn't have an xmi.id, the path is returned as normal.
442 <UML:ModelElement.stereotype>
443 <UML:Stereotype xmi.idref = 'stTable'/>
444 </UML:ModelElement.stereotype>
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>
451 Using xmideref(//UML:ModelElement.stereotype/UML:stereotype) would return the
452 <UML:Stereotype xmi.id = '3b4b1e:f762a35f6b:-7fb6' ...> tag.
454 Using xmideref(//UML:ModelElement.stereotype/UML:stereotype)/@name would give
465 =head1 VERSION HISTORY
469 grommit <mark.addison@itn.co.uk>