From: Mark Addison Date: Mon, 8 Sep 2003 17:10:07 +0000 (+0000) Subject: Refactored the internals so that the XMI parsing is seperate from the X-Git-Tag: v0.04~189 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f8ec05fa0713483583b6ac959ff312f008107b78;p=dbsrgits%2FSQL-Translator.git Refactored the internals so that the XMI parsing is seperate from the Schema generation. This should make it easy to work with and extend and is laying the ground work for making the XMI parser a seperate mod. The Classes to build are now more directly selected using xpaths. Added xmiVisible() xpath function. --- diff --git a/lib/SQL/Translator/Parser/XML/XMI.pm b/lib/SQL/Translator/Parser/XML/XMI.pm index 11ac3a1..c44286c 100644 --- a/lib/SQL/Translator/Parser/XML/XMI.pm +++ b/lib/SQL/Translator/Parser/XML/XMI.pm @@ -1,7 +1,7 @@ package SQL::Translator::Parser::XML::XMI; # ------------------------------------------------------------------- -# $Id: XMI.pm,v 1.2 2003-09-08 12:27:29 grommit Exp $ +# $Id: XMI.pm,v 1.3 2003-09-08 17:10:07 grommit Exp $ # ------------------------------------------------------------------- # Copyright (C) 2003 Mark Addison , # @@ -25,6 +25,56 @@ package SQL::Translator::Parser::XML::XMI; SQL::Translator::Parser::XML::XMI - Parser to create Schema from UML Class diagrams stored in XMI format. +=head1 SYNOPSIS + + use SQL::Translator; + use SQL::Translator::Parser::XML::XMI; + + my $translator = SQL::Translator->new( + from => 'XML-XMI', + to => 'MySQL', + filename => 'schema.xmi', + show_warnings => 1, + add_drop_table => 1, + ); + + print $obj->translate; + +=head1 DESCRIPTION + +=head2 UML Data Modeling + +To tell the parser which Classes are tables give them a <> stereotype. + +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. + +Primary keys are attributes marked with <> stereotype. + +=head2 XMI Format + +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! + +=head1 ARGS + +=over 4 + +=item visibility + + visibilty=public|protected|private + +What visibilty of stuff to translate. e.g when set to 'public' any private +and package Classes will be ignored and not turned into tables. Applies +to Classes and Attributes. + +If not set or false (the default) no checks will be made and everything is +translated. + +=back + =cut # ------------------------------------------------------------------- @@ -32,7 +82,7 @@ Class diagrams stored in XMI format. use strict; use vars qw[ $DEBUG $VERSION @EXPORT_OK ]; -$VERSION = sprintf "%d.%02d", q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/; +$VERSION = sprintf "%d.%02d", q$Revision: 1.3 $ =~ /(\d+)\.(\d+)/; $DEBUG = 0 unless defined $DEBUG; use Data::Dumper; @@ -45,71 +95,82 @@ use SQL::Translator::Utils 'debug'; use XML::XPath; use XML::XPath::XMLParser; - -# Custom XPath functions -#----------------------------------------------------------------------------- - # -# Pass a nodeset. If the first node has an xmi.idref attrib then return -# the nodeset for that id +# get_classes( XPATHOBJ, ARGS ); # -sub XML::XPath::Function::xmideref { - my $self = shift; - my ($node, @params) = @_; - if (@params > 1) { - die "xmideref() function takes one or no parameters\n"; - } - 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"); -} - - - -# Parser -#----------------------------------------------------------------------------- - +# XPATHOBJ - An XML::XPath object setup and ready to use. You can also use any +# Node to search from as this sub just calls findnodes() on the arg. # -# is_visible( {ELEMENT|VIS_OF_THING}, VISLEVEL) +# ARGS - Name/Value list of args. # -# Returns true or false for whether the visibility of something e.g. Class, -# Attribute, is visible at the level given. +# xpath => The xpath to use for finding classes. Default is //UML:Classes +# which will find all the classes in the XMI. # -{ - my %vislevel = ( - public => 1, - protected => 2, - private => 3, - ); +# attribute_test => An XPath predicate (ie the bit between [] ) to test the +# attributes with to decide if we should parse them. ie +# attribute_test => '@name="foo"' would only pass out attribs +# with a name of foo. +# +sub get_classes { + my ($xp,%args) = @_; + my $classes = []; + + my $xpath = $args{xpath} ||= '//UML:Class'; # Default: all classes + $xpath .= "[$args{class_test}]" if $args{class_test}; + + my @nodes = $xp->findnodes($xpath); + return unless @nodes; + + for my $classnode (@nodes) { + my $class = {}; + + # attributes + foreach ( + qw/name visibility isSpecification + isRoot isLeaf isAbstract isActive/ + ) { + $class->{$_} = $classnode->getAttribute($_); + } + + # Stereotype + $class->{stereotype} = "".$classnode->find( + 'xmiDeref(UML:ModelElement.stereotype/UML:Stereotype)/@name'); + + # + # Class Attributes + # + my $xpath = 'UML:Classifier.feature/UML:Attribute'; + $xpath .= "[$args{attribute_test}]" if $args{attribute_test}; + foreach my $attrnode ( $classnode->findnodes($xpath) ) { + my $attr = {}; + # attributes + foreach (qw/name visibility isSpecification ownerScope/) { + $attr->{$_} = $attrnode->getAttribute($_); + } + + $attr->{stereotype} = "".$attrnode->findvalue( + 'xmiDeref(UML:ModelElement.stereotype/UML:Stereotype)/@name'); + + $attr->{datatype} = "".$attrnode->find( + 'xmiDeref(UML:StructuralFeature.type/UML:DataType)/@name'); + if ( my @body = $attrnode->findnodes( + 'UML:Attribute.initialValue/UML:Expression/@body') + ) { + $attr->{initialValue} = $body[0]->getData; + } - sub is_visible { - my ($arg, $vis) = @_; - return 1 unless $vis; - my $foo; - die "is_visible : Needs something to test" unless $arg; - if ( $arg->isa("XML::XPath::Node::Element") ) { - $foo = $arg->getAttribute("visibility"); - } - else { - $foo = $arg; - } - return 1 if $vislevel{$vis} >= $vislevel{$foo}; - return 0; - } -} + push @{$class->{attributes}}, $attr; + } + + push @$classes, $class; + } + + return $classes; +}; sub parse { + eval { + my ( $translator, $data ) = @_; local $DEBUG = $translator->debug; my $schema = $translator->schema; @@ -124,29 +185,37 @@ sub parse { # - 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) if $DEBUG; - - for my $classnode (@nodes) { - # Only process classes with <
> and name - next unless my $classname = $classnode->getAttribute("name"); - next unless !$pargs->{visibility} - or is_visible($classnode, $pargs->{visibility}); - - my $stereotype = "".$classnode->find( - 'xmideref(UML:ModelElement.stereotype/UML:Stereotype)/@name'); - next unless $stereotype eq "Table"; + # + # Build an XPath for the classes and attributes we want... + # + my @tests = ('@xmi.id'); # Only classes with an id so we don't get any + # refs to classes ie xmi.idref classes + push @tests, '@name'; # Only Classes with a name + push @tests, "xmiVisible('$pargs->{visibility}')" if $pargs->{visibility}; + my $path = '//UML:Class['.join(' and ',@tests).']'; + + my $attrib_test = '@name'; + $attrib_test .= " and xmiVisible('$pargs->{visibility}')" + if $pargs->{visibility}; + + # ...and parse them out + debug "Searching for Classes using:$path"; + my $classes = get_classes( $xp, + xpath => $path, attribute_test => $attrib_test); + + debug "Found ".scalar(@$classes)." Classes: ".join(", ", + map {$_->{"name"}} @$classes) if $DEBUG; + debug "Classes:",Dumper($classes); + + # + # Turn the data from get_classes into a Schema + # + foreach my $class (@$classes) { + next unless $class->{stereotype} eq "Table"; # Add the table - debug "Adding class: $classname as table:$classname" if $DEBUG; - my $table = $schema->add_table(name=>$classname) + debug "Adding class: $class->{name}" if $DEBUG; + my $table = $schema->add_table( name => $class->{name} ) or die "Schema Error: ".$schema->error; # @@ -155,27 +224,15 @@ sub parse { # 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"); - next unless !$pargs->{visibility} - or is_visible($attrnode, $pargs->{visibility}); - - 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}, + data_type => $attr->{datatype}, + 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}; debug "Adding field:",Dumper(\%data); my $field = $table->add_field( %data ) or die $schema->error; @@ -191,63 +248,129 @@ sub parse { } # Classes loop return 1; + + }; + print "ERROR: $@\n" if $@; + return 1; } 1; -# ------------------------------------------------------------------- +#============================================================================= +# +# XML::XPath extensions +# +#============================================================================= -=pod +package XML::XPath::Function; -=head1 SYNOPSIS +=head1 XMI XPath Functions - use SQL::Translator; - use SQL::Translator::Parser::XML::XMI; +The Parser adds the following extra XPath functions. - my $translator = SQL::Translator->new( - from => 'XML-XMI', - to => 'MySQL', - filename => 'schema.xmi', - show_warnings => 1, - add_drop_table => 1, - ); +=head2 xmiDeref - print $obj->translate; +Deals with xmi.id/xmi.idref pairs of attributes. You give it an +xPath e.g 'UML:ModelElement.stereotype/UML:stereotype' if the the +tag it points at has an xmi.idref it looks up the tag with that +xmi.id and returns it. -=head1 DESCRIPTION +If it doesn't have an xmi.id, the path is returned as normal. -=head2 UML Data Modeling +e.g. given -To tell the parser which Classes are tables give them a <
> stereotype. + + + + ... + + Class + -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. +Using xmideref(//UML:ModelElement.stereotype/UML:stereotype) would return the + tag. -Primary keys are attributes marked with <> stereotype. +Using xmideref(//UML:ModelElement.stereotype/UML:stereotype)/@name would give +"Table". -=head2 XMI Format +=head xmiVisible -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! + is_visible( VISLEVEL ) -=head1 ARGS +Returns true or false for whether the visibility of something e.g. a Class or +Attribute, is visible at the level given. e.g. -=over 4 + //UML:Class[xmiVisible('public')] - Find all public classes + //UML:Class[xmiVisible('protected')] - Find all public and protected classes -=item visibility +Supports the 3 UML visibility levels of public, protected and private. - visibilty=public|protected|private +Note: Currently any element tested that doesn't have a visibility="" attribute +is assumed to be visible and so xmiVisible will return true. This is probably +the wrong thing to do and is very likley to change. It is probably best to +throw an error if we try to test something that doesn't do visibility. -What visibilty of stuff to translate. e.g when set to 'public' any private -and package Classes will be ignored and not turned into tables. Applies -to Classes and Attributes. +=cut -If not set or false (the default) no checks will be made and everything is -translated. +sub xmiDeref { + my $self = shift; + my ($node, @params) = @_; + if (@params > 1) { + die "xmiDeref() function takes one or no parameters\n"; + } + 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"); -=back + my $id = $node->getAttribute("xmi.idref") or return $node; + return $node->getRootNode->find('//*[@xmi.id="'.$id.'"]'); +} + +{ + my %vislevel = ( + public => 1, + protected => 2, + private => 3, + ); + + sub xmiVisible { + my $self = shift; + my ($node, @params) = @_; + if (@params < 1 or @params > 2) { + die "xmiVisible() function takes 1 or 2 parameters\n"; + } + elsif (@params == 2) { + my $nodeset = shift(@params); + return unless $nodeset->size; + $node = $nodeset->get_node(1); + } + die "xmiVisible() needs an Element node." + unless $node->isa("XML::XPath::Node::Element"); + + my $vis = shift(@params) || return XML::XPath::Boolean->True; + my $nodevis = $node->getAttribute("visibility") + || return XML::XPath::Boolean->True; + return XML::XPath::Boolean->True + if $vislevel{$vis} >= $vislevel{$nodevis}; + return XML::XPath::Boolean->False; + } +} + +# Test of custom xpath function. +sub hello { + return XML::XPath::Literal->new("Hello World"); +} + +#============================================================================= +package main; + + +=pod =head1 BUGS @@ -274,3 +397,5 @@ perl(1), SQL::Translator, XML::XPath, SQL::Translator::Producer::XML::SQLFairy, SQL::Translator::Schema. =cut + + diff --git a/t/21xml-xmi-parser.t b/t/21xml-xmi-parser.t index 2f07ec0..9e9491a 100644 --- a/t/21xml-xmi-parser.t +++ b/t/21xml-xmi-parser.t @@ -254,13 +254,13 @@ my @testd = ( ); my $sql = $obj->translate; my $scma = $obj->schema; - + my @tblnames = map {$_->name} $scma->get_tables; is_deeply( \@tblnames, $tables, "Tables with visibility => '$vis'"); - + my @fldnames = map {$_->name} $scma->get_table("Foo")->get_fields; is_deeply( \@fldnames, $foofields, "Foo fields with visibility => '$vis'"); - + #print "Debug: translator", Dumper($obj) if DEBUG; #print "Debug: schema", Dumper($obj->schema) if DEBUG; }