Added parsing of field.extra
[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Parser / XML / XMI.pm
index 695e0c4..b1e426c 100644 (file)
@@ -1,7 +1,7 @@
 package SQL::Translator::Parser::XML::XMI;
 
 # -------------------------------------------------------------------
-# $Id: XMI.pm,v 1.1 2003-09-04 15:55:47 grommit Exp $
+# $Id: XMI.pm,v 1.10 2003-10-03 13:17:28 grommit Exp $
 # -------------------------------------------------------------------
 # Copyright (C) 2003 Mark Addison <mark.addison@itn.co.uk>,
 #
@@ -27,12 +27,10 @@ Class diagrams stored in XMI format.
 
 =cut
 
-# -------------------------------------------------------------------
-
 use strict;
 
 use vars qw[ $DEBUG $VERSION @EXPORT_OK ];
-$VERSION = sprintf "%d.%02d", q$Revision: 1.1 $ =~ /(\d+)\.(\d+)/;
+$VERSION = sprintf "%d.%02d", q$Revision: 1.10 $ =~ /(\d+)\.(\d+)/;
 $DEBUG   = 0 unless defined $DEBUG;
 
 use Data::Dumper;
@@ -42,125 +40,108 @@ use base qw(Exporter);
 
 use base qw/SQL::Translator::Parser/;  # Doesnt do anything at the mo!
 use SQL::Translator::Utils 'debug';
-use XML::XPath;
-use XML::XPath::XMLParser;
-
+use SQL::Translator::XMI::Parser;
 
-# Custom XPath functions
+# SQLFairy Parser
 #-----------------------------------------------------------------------------
 
-#
-# Pass a nodeset. If the first node has an xmi.idref attrib then return
-# the nodeset for that id
-#
-sub XML::XPath::Function::xmideref {
-    my $self = shift;
-    my ($node, @params) = @_;
-    if (@params > 1) {
-        die "xmideref() function takes one or no parameters\n";
+# is_visible - Used to check visibility in filter subs
+{
+    my %vislevel = (
+        public => 1,
+        protected => 2,
+        private => 3,
+    );
+
+    sub is_visible {
+               my ($nodevis, $vis) = @_;
+        $nodevis = ref $_[0] ? $_[0]->{visibility} : $_[0];
+        return 1 unless $vis;
+        return 1 if $vislevel{$vis} >= $vislevel{$nodevis};
+        return 0; 
     }
-    elsif (@params) {
-        my $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;
-    return $node->getRootNode->find('//*[@xmi.id="'.$id.'"]');
 }
 
-sub XML::XPath::Function::hello {
-    return XML::XPath::Literal->new("Hello World");
-}
+my ($schema, $pargs);
 
+sub parse {
+    my ( $translator, $data ) = @_;
+    local $DEBUG  = $translator->debug;
+    $schema    = $translator->schema;
+    $pargs     = $translator->parser_args;
+       $pargs->{classes2schema} ||= \&classes2schema;
 
+    debug "Visibility Level:$pargs->{visibility}" if $DEBUG;
 
-# Parser
-#-----------------------------------------------------------------------------
+       my $xmip = SQL::Translator::XMI::Parser->new(xml => $data);
 
-sub parse {
-    my ( $translator, $data ) = @_;
-    local $DEBUG    = $translator->debug;
-    my $schema      = $translator->schema;
-    my $pargs          = $translator->parser_args;
-    
-    my $xp          = XML::XPath->new(xml => $data);
-
-    $xp->set_namespace("UML", "org.omg.xmi.namespace.UML");
-    #
     # TODO
     # - Options to set the initial context node so we don't just
     #   blindly do all the classes. e.g. Select a diag name to do.
-    #
-    
-    #
-    # Work our way through the classes, creating tables. We only
-    # want class with xmi.id attributes and not the refs to them,
-    # which will have xmi.idref attributes.
-    #
-    my @nodes = $xp->findnodes('//UML:Class[@xmi.id]');
-    
-    debug "Found ".scalar(@nodes)." Classes: ".join(", ",
-        map {$_->getAttribute("name")} @nodes);
-    
-    for my $classnode (@nodes) {
-        # Only process classes with <<Table>> and name
-        next unless my $classname = $classnode->getAttribute("name");
-        my $stereotype = "".$classnode->find(
-            'xmideref(UML:ModelElement.stereotype/UML:Stereotype)/@name');
-        next unless $stereotype eq "Table";
-        
+
+    my $classes = $xmip->get_classes(
+        filter => sub {
+            return unless $_->{name};
+            return unless is_visible($_, $pargs->{visibility});
+            return 1;
+        },
+        filter_attributes => sub {
+            return unless $_->{name};
+            return unless is_visible($_, $pargs->{visibility});
+            return 1;
+        },
+    );
+    debug "Found ".scalar(@$classes)." Classes: ".join(", ",
+        map {$_->{"name"}} @$classes) if $DEBUG;
+       debug "Model:",Dumper($xmip->{model}) if $DEBUG;
+
+       #
+       # Turn the data from get_classes into a Schema
+       #
+       $pargs->{classes2schema}->($schema, $classes);
+
+    return 1;
+}
+
+1;
+
+# Default conversion sub. Makes all classes into tables using all their
+# attributes.
+sub classes2schema {
+       my ($schema, $classes) = @_;
+
+       foreach my $class (@$classes) {
         # Add the table
-        debug "Adding class: $classname as table:$classname";
-        my $table = $schema->add_table(name=>$classname)
+        debug "Adding class: $class->{name}";
+        my $table = $schema->add_table( name => $class->{name} )
             or die "Schema Error: ".$schema->error;
 
         #
         # Fields from Class attributes
         #
-        # name data_type size default_value is_nullable 
-        # is_auto_increment is_primary_key is_foreign_key comments
-        #
-        foreach my $attrnode ( $classnode->findnodes(
-            'UML:Classifier.feature/UML:Attribute[@xmi.id]',) 
-        ) {
-            next unless my $fieldname = $attrnode->getAttribute("name");
-            my $stereotype = "".$attrnode->findvalue(
-                'xmideref(UML:ModelElement.stereotype/UML:Stereotype)/@name');
-            my %data = (
-                name => $fieldname,
-                data_type => "".$attrnode->find(
-                  'xmideref(UML:StructuralFeature.type/UML:DataType)/@name'),
-                is_primary_key => $stereotype eq "PK" ? 1 : 0,
+        foreach my $attr ( @{$class->{attributes}} ) {
+                       my %data = (
+                name           => $attr->{name},
+                is_primary_key => $attr->{stereotype} eq "PK" ? 1 : 0,
                 #is_foreign_key => $stereotype eq "FK" ? 1 : 0,
             );
-            if ( my @body = $attrnode->findnodes(
-                'UML:Attribute.initialValue/UML:Expression/@body') 
-            ) {
-                $data{default_value} = $body[0]->getData;
-            }
+                       $data{default_value} = $attr->{initialValue}
+                               if exists $attr->{initialValue};
+                       $data{data_type} = $attr->{_map_taggedValues}{dataType}{dataValue}
+                               || $attr->{dataType}{name};
+                       $data{size} = $attr->{_map_taggedValues}{size}{dataValue};
+                       $data{is_nullable}=$attr->{_map_taggedValues}{nullable}{dataValue};
 
-            debug "Adding field:",Dumper(\%data);
             my $field = $table->add_field( %data ) or die $schema->error;
-
             $table->primary_key( $field->name ) if $data{'is_primary_key'};
-            #
-            # TODO:
-            # - We should be able to make the table obj spot this when 
-            #   we use add_field.
-            #
         }
 
     } # Classes loop
-
-    return 1;
 }
 
 1;
 
-# -------------------------------------------------------------------
+__END__
 
 =pod
 
@@ -181,53 +162,60 @@ sub parse {
 
 =head1 DESCRIPTION
 
-=head2 UML Data Modeling
+Translates XMI (UML models in XML format) into Schema. This basic parser
+will just pull out all the classes as tables with fields from their attributes.
 
-To tell the parser which Classes are tables give them a <<Table>> stereotype.
+For more detail you will need to use a UML profile for data modelling. These are
+supported by sub parsers. See their docs for details.
 
-Any attributes of the class will be used as fields. The datatype of the
-attribute must be a UML datatype and not an object, with the datatype's name
-being used to set the data_type value in the schema.
+=over 4
 
-Primary keys are attributes marked with <<PK>> stereotype.
+=item XML::XMI::Rational
 
-=head2 XMI Format
+The Rational Software UML Data Modeling Profile
 
-The parser has been built using XMI generated by PoseidonUML 2beta, which
-says it uses UML 2. So the current conformance is down to Poseidon's idea
-of XMI!
+=back
 
 =head1 ARGS
 
 =over 4
 
-=item visibility TODO
+=item visibility
 
- visibilty=public|private|protected|package
+ visibilty=public|protected|private
 
 What visibilty of stuff to translate. e.g when set to 'public' any private
-Classes will be ignored and not turned into tables.
+and package Classes will be ignored and not turned into tables. Applies
+to Classes and Attributes.
 
-=item table_visibility    TODO
+If not set or false (the default) no checks will be made and everything is
+translated.
 
-=item field_visibility    TODO
+=back
 
-=item table_stereotype    Def:Table TODO 
+=head1 XMI Format
 
-What stereotype a class must have to turned into a table.
+Uses either XMI v1.0 or v1.2. The version to use is detected automatically
+from the <XMI> tag in the source file.
 
-=item pkey_stereotype    Def:PK TODO 
+The parser has been built using XMI 1.2 generated by PoseidonUML 2, which
+says it uses UML 2. So the current conformance is down to Poseidon's idea
+of XMI! 1.0 support is based on a Rose file, is less complete and has little
+testing.
 
-=back
 
 =head1 BUGS
 
-=head1 TODO
+Seems to be slow. I think this is because the XMI files can get pretty
+big and complex, especially all the diagram info, and XPath needs to load the
+whole tree.
 
-Deal with field sizes. Don't think UML does this directly so may need to include
-it in the datatype names.
+Deleting the diagrams from an XMI1.2 file (make a backup!) will really speed
+things up. Remove <UML:Diagram> tags and all their contents.
 
-Everything else! Relations, fkeys, constraints, indexes, etc...
+=head1 TODO
+
+More profiles.
 
 =head1 AUTHOR
 
@@ -239,3 +227,5 @@ perl(1), SQL::Translator, XML::XPath, SQL::Translator::Producer::XML::SQLFairy,
 SQL::Translator::Schema.
 
 =cut
+
+