Added collection tags for the Schemas objects (tables, views, etc)
[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / XMI / Parser.pm
index bea303c..db3a222 100644 (file)
@@ -1,7 +1,7 @@
 package SQL::Translator::XMI::Parser;
 
 # -------------------------------------------------------------------
-# $Id: Parser.pm,v 1.5 2003-09-29 12:02:35 grommit Exp $
+# $Id: Parser.pm,v 1.8 2003-10-06 15:03:07 grommit Exp $
 # -------------------------------------------------------------------
 # Copyright (C) 2003 Mark Addison <mark.addison@itn.co.uk>,
 #
@@ -32,7 +32,7 @@ parser.
 use strict;
 use 5.006_001;
 use vars qw/$VERSION/;
-$VERSION = sprintf "%d.%02d", q$Revision: 1.5 $ =~ /(\d+)\.(\d+)/;
+$VERSION = sprintf "%d.%02d", q$Revision: 1.8 $ =~ /(\d+)\.(\d+)/;
 
 use Data::Dumper;
 use XML::XPath;
@@ -65,13 +65,13 @@ use Storable qw/dclone/;
 #
 sub XmiSpec {
        my ($me,$spec) = @_;
-       init_specs($spec);
-       $me->mk_gets($spec);
+       _init_specs($spec);
+       $me->_mk_gets($spec);
 }
 
 # Build lookups etc. Its important that each spec item becomes self contained
 # so we can build good closures, therefore we do all the lookups 1st.
-sub init_specs {
+sub _init_specs {
        my $specs = shift;
 
        foreach my $spec ( values %$specs ) {
@@ -91,7 +91,7 @@ sub init_specs {
 
 # Create get methods from spec
 #
-sub mk_gets {
+sub _mk_gets {
     my ($proto,$specs) = @_;
     my $class = ref($proto) || $proto;
     foreach ( values %$specs ) {
@@ -104,18 +104,12 @@ sub mk_gets {
                # so we can add overrides to both specs.
                no strict "refs";
                my $meth = "_get_$spec->{plural}";
-               *{$meth} = mk_get($spec);
+               *{$meth} = _mk_get($spec);
                *{__PACKAGE__."::get_$spec->{plural}"} = sub {shift->$meth(@_);}
                        unless $class->can("get_$spec->{plural}");
     }
 }
 
-# e.g. of overriding both versions.
-#sub get_classes {
-#      print "HELLO Both\n";
-#      return shift->_get_classes(@_);
-#}
-
 #
 # Sets up the XML::XPath object and then checks the version of the XMI file and
 # blesses its self into either the V10 or V12 class.
@@ -151,7 +145,7 @@ sub new {
 }
 
 #
-# mk_get
+# _mk_get
 #
 # Generates and returns a get_ sub for the spec given.
 # So, if you want to change how the get methods (e.g. get_classes) work do it
@@ -167,7 +161,7 @@ sub new {
 #
 #  _xpath   => The xpath to use for finding stuff.
 #
-sub mk_get {
+sub _mk_get {
     my $spec = shift;
 
     # get_* closure using $spec
@@ -198,16 +192,19 @@ sub mk_get {
         }
 
                # Get the Tag attributes
+#warn "    getting attribs: ",join(" ",@{$spec->{attrib_data}}),"\n";
         foreach ( @{$spec->{attrib_data}} ) {
                        $thing->{$_} = $node->getAttribute($_);
                }
+#warn "    got attribs: ",(map "$_=$thing->{$_}", keys %$thing),"\n";
 
         # Add the path data
         foreach ( @{$spec->{path_data}} ) {
-#warn "          $spec->{name} - $_->{name} using:$_->{path}\n";
+#warn "    getting path data $_->{name} : $_->{path}\n";
             my @nodes = $node->findnodes($_->{path});
             $thing->{$_->{name}} = @nodes ? $nodes[0]->getData
                 : (exists $_->{default} ? $_->{default} : undef);
+#warn "    got path data $_->{name}=$thing->{$_->{name}}\n";
         }
 
         # Run any filters set
@@ -237,7 +234,6 @@ sub mk_get {
                        $path =~ s/\$\{(.*?)\}/$thing->{$1}/g;
                        $data = $me->$meth( _context => $node, _xpath => $path,
                 filter => $args{"filter_$_->{name}"} );
-
             if ( $_->{multiplicity} eq "1" ) {
                 $thing->{$_->{name}} = shift @$data;
             }
@@ -256,7 +252,7 @@ sub mk_get {
        return $things;
 } # /closure sub
 
-} # /mk_get
+} # /_mk_get
 
 sub _mk_map {
        my ($kids,$key) = @_;
@@ -267,6 +263,21 @@ sub _mk_map {
        return $map;
 }
 
+sub get_associations {
+       my $assoc = shift->_get_associations(@_);
+       foreach (@$assoc) {
+               next unless defined $_->{associationEnds}; # Wait until we get all of an association
+               my @ends = @{$_->{associationEnds}};
+               if (@ends != 2) {
+                       warn "Sorry can't handle otherEnd associations with more than 2 ends"; 
+                       return $assoc;
+               }
+               $ends[0]{otherEnd} = $ends[1];
+               $ends[1]{otherEnd} = $ends[0];
+       }
+       return $assoc;
+}
+
 1; #===========================================================================
 
 
@@ -281,19 +292,21 @@ package XML::XPath::Function;
 sub xmiDeref {
     my $self = shift;
     my ($node, @params) = @_;
+    my $nodeset;
     if (@params > 1) {
         die "xmiDeref() function takes one or no parameters\n";
     }
     elsif (@params) {
-        my $nodeset = shift(@params);
+        $nodeset = shift(@params);
         return $nodeset unless $nodeset->size;
         $node = $nodeset->get_node(1);
     }
     die "xmiDeref() needs an Element node." 
     unless $node->isa("XML::XPath::Node::Element");
 
-    my $id = $node->getAttribute("xmi.idref") or return $node;
+    my $id = $node->getAttribute("xmi.idref") || return ($nodeset || $node);
     return $node->getRootNode->find('//*[@xmi.id="'.$id.'"]');
+    # TODO We should use the tag name to search from the source 
 }