Moved Rational profile code to its own mod. Added support for tagged values, so

[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / XMI / Parser.pm

diff --git a/lib/SQL/Translator/XMI/Parser.pm b/lib/SQL/Translator/XMI/Parser.pm
index 8e1b6da..0fcf776 100644 (file)
--- a/lib/SQL/Translator/XMI/Parser.pm
+++ b/lib/SQL/Translator/XMI/Parser.pm
@@ -59,20 +59,21 @@ $spec12->{class} = {
             # How many we get back. Use '1' for 1 and '*' for lots.
                        # TODO If not set then decide depening on the return?
         },
-        { 
+        {
             name  => "operations",
             path  => "UML:Classifier.feature/UML:Operation",
             class => "operation", 
             multiplicity => "*",
         },
-        { 
+        {
             name  => "taggedValues",
             path  => 'UML:ModelElement.taggedValue/UML:TaggedValue',
-            class => "taggedValue", 
+            class => "taggedValue",
             multiplicity => "*",
-                       # Nice if we could say that the list should me folded into a hash
-                       # on the name key. type=>"hash", hash_key=>"name" or something!
-        },
+                       map => "name",
+               # Add a _map_taggedValues to the data. Its a hash of the name data
+                       # which refs the normal list of kids
+               },
     ],
 };
 
@@ -120,6 +121,7 @@ $spec12->{attribute} = {
             path  => 'UML:ModelElement.taggedValue/UML:TaggedValue',
             class => "taggedValue", 
             multiplicity => "*",
+                       map => "name",
         },
     ],
 };
@@ -150,6 +152,7 @@ $spec12->{operation} = {
             path  => 'UML:ModelElement.taggedValue/UML:TaggedValue',
             class => "taggedValue", 
             multiplicity => "*",
+                       map => "name",
         },
     ],
 };
@@ -157,7 +160,7 @@ $spec12->{operation} = {
 $spec12->{parameter} = {
     name   => "parameter",
     plural => "parameters",
-    default_path => '//UML:BehavioralFeature.parameter/UML:Parameter[@xmi.id]',
+    default_path => '//UML:Parameter[@xmi.id]',
     attrib_data  => [qw/name isSpecification kind/],
     path_data => [
         { 
@@ -289,14 +292,21 @@ foreach ( values %$SPECS ) { init_specs($_) };
 mk_get_dispatch();
 
 # Build lookups etc. Its important that each spec item becomes self contained
-# so we can build good closures, therefor we do all the lookups 1st.
+# so we can build good closures, therefore we do all the lookups 1st.
 sub init_specs {
        my $specs = shift;
 
        foreach my $spec ( values %$specs ) {
-        foreach ( @{$spec->{kids}} ) {
+               # Look up for kids get method
+               foreach ( @{$spec->{kids}} ) {
             $_->{get_method} = "get_".$specs->{$_->{class}}{plural};
         }
+               
+               # Add xmi.id ti all specs. Everything we want at the moment (in both
+               # versions) has an id. The tags that don't seem to be used for
+               # structure.
+               my $attrib_data = $spec->{attrib_data} ||= [];
+               push @$attrib_data, "xmi.id";
        }
 
 }
@@ -335,8 +345,9 @@ sub new {
     $me = { xml_xpath => $xp };
     
     # Work out the version of XMI we have and generate the get subs to parse it
-    my $xmiv = "".$xp->findvalue('/XMI/@xmi.version')
-        or die "Can't find XMI version";
+    my $xmiv = $args{xmi_version}
+           || "".$xp->findvalue('/XMI/@xmi.version')
+        || die "Can't find XMI version";
     $me->{xmi_get_} = mk_gets($SPECS->{$xmiv});
     
     return bless $me, $class;
@@ -374,15 +385,15 @@ sub mk_gets {
 # NB: DO NOT use publicly as you will break the version independance. e.g. When
 # using _xpath you need to know which version of XMI to use. This is handled by
 # the use of different paths in the specs.
-# 
+#
 #  _context => The context node to use, if not given starts from root.
-# 
+#
 #  _xpath   => The xpath to use for finding stuff.
-# 
+#
 use Data::Dumper;
 sub mk_get {
     my $spec = shift;
-    
+
     # get_* closure using $spec
     return sub {
        my ($me, %args) = @_;
@@ -398,12 +409,12 @@ sub mk_get {
        for my $node (@nodes) {
                my $thing = {};
         # my $thing = { xpNode => $node };
-               
+
                # Get the Tag attributes
         foreach ( @{$spec->{attrib_data}} ) {
                        $thing->{$_} = $node->getAttribute($_);
                }
-               
+
         # Add the path data
         foreach ( @{$spec->{path_data}} ) {
 #warn "Searching for $spec->{plural} - $_->{name} using:$_->{path}\n";
@@ -411,29 +422,33 @@ sub mk_get {
             $thing->{$_->{name}} = @nodes ? $nodes[0]->getData
                 : (exists $_->{default} ? $_->{default} : undef);
         }
-        
-        # Run any filters set 
-        # 
+
+        # Run any filters set
+        #
         # Should we do this after the kids as we may want to test them?
         # e.g. test for number of attribs
         if ( my $filter = $args{filter} ) {
             local $_ = $thing;
             next unless $filter->($thing);
         }
-        
+
         # Kids
         #
         foreach ( @{$spec->{kids}} ) {
-            my $data;
+                       my $data;
             my $meth = $_->{get_method};
-            $data = $me->$meth( _context => $node, _xpath => $_->{path},
+            my $path = $_->{path};
+                       $data = $me->$meth( _context => $node, _xpath => $path,
                 filter => $args{"filter_$_->{name}"} );
-           
+
             if ( $_->{multiplicity} eq "1" ) {
                 $thing->{$_->{name}} = shift @$data;
             }
             else {
-                $thing->{$_->{name}} = $data || [];
+                my $kids = $thing->{$_->{name}} = $data || [];
+                               if ( my $key = $_->{"map"} ) {
+                                       $thing->{"_map_$_->{name}"} = _mk_map($kids,$key);
+                               }
             }
         }
 
@@ -444,6 +459,15 @@ sub mk_get {
 
 } # /mk_get
 
+sub _mk_map {
+       my ($kids,$key) = @_;
+       my $map = {};
+       foreach (@$kids) {
+               $map->{$_->{$key}} = $_ if exists $_->{$key};
+       }
+       return $map;
+}
+
 1; #===========================================================================
 
 
@@ -492,8 +516,11 @@ provides hooks to filter the data down to what you want.
 
 =head2 new
 
-Pass in name/value arg of either filename, xml or ioref for the XMI data you
-want to parse.
+Pass in name/value arg of either C<filename>, C<xml> or C<ioref> for the XMI
+data you want to parse.
+
+The version of XMI to use either 1.0 or 1.2 is worked out from the file. You
+can also use a C<xmi_version> arg to set it explicitley.
 
 =head2 get_* methods