X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FTranslator%2FParser%2FXML%2FXMI.pm;h=bf88f6b910b2107ffefd544328902857a7de4bee;hb=b2a00f50f65f6e2e95356c6e4f704c7fdfab25fb;hp=c44286c7644ebc97843828077f5f33c4eac78ed0;hpb=f8ec05fa0713483583b6ac959ff312f008107b78;p=dbsrgits%2FSQL-Translator.git diff --git a/lib/SQL/Translator/Parser/XML/XMI.pm b/lib/SQL/Translator/Parser/XML/XMI.pm index c44286c..bf88f6b 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.3 2003-09-08 17:10:07 grommit Exp $ +# $Id: XMI.pm,v 1.8 2003-09-22 11:41:07 grommit Exp $ # ------------------------------------------------------------------- # Copyright (C) 2003 Mark Addison , # @@ -25,64 +25,12 @@ 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 -# ------------------------------------------------------------------- - use strict; use vars qw[ $DEBUG $VERSION @EXPORT_OK ]; -$VERSION = sprintf "%d.%02d", q$Revision: 1.3 $ =~ /(\d+)\.(\d+)/; +$VERSION = sprintf "%d.%02d", q$Revision: 1.8 $ =~ /(\d+)\.(\d+)/; $DEBUG = 0 unless defined $DEBUG; use Data::Dumper; @@ -92,300 +40,183 @@ 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; -# -# get_classes( XPATHOBJ, ARGS ); -# -# 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. -# -# ARGS - Name/Value list of args. -# -# xpath => The xpath to use for finding classes. Default is //UML:Classes -# which will find all the classes in the XMI. -# -# 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; - } - - push @{$class->{attributes}}, $attr; - } - - push @$classes, $class; - } - - return $classes; -}; -sub parse { - eval { +# SQLFairy Parser +#----------------------------------------------------------------------------- + +# 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; + } +} + +my ($schema, $pargs); + +sub parse { my ( $translator, $data ) = @_; - local $DEBUG = $translator->debug; - my $schema = $translator->schema; - my $pargs = $translator->parser_args; + local $DEBUG = $translator->debug; + $schema = $translator->schema; + $pargs = $translator->parser_args; + $pargs->{classes2schema} ||= \&classes2schema; debug "Visibility Level:$pargs->{visibility}" if $DEBUG; - my $xp = XML::XPath->new(xml => $data); - $xp->set_namespace("UML", "org.omg.xmi.namespace.UML"); - # + my $xmip = SQL::Translator::XMI::Parser->new(xml => $data); + # 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. - # - # 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); - + 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 "Classes:",Dumper($classes); + debug "Classes:",Dumper($classes); # # Turn the data from get_classes into a Schema # - foreach my $class (@$classes) { - next unless $class->{stereotype} eq "Table"; + $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: $class->{name}" if $DEBUG; + 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 $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, ); $data{default_value} = $attr->{initialValue} if exists $attr->{initialValue}; + $data{data_type} = $attr->{_map_taggedValues}{dataType}{dataValue} + || $attr->{datatype}; + $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; - - }; - print "ERROR: $@\n" if $@; - return 1; } 1; -#============================================================================= -# -# XML::XPath extensions -# -#============================================================================= - -package XML::XPath::Function; +__END__ -=head1 XMI XPath Functions - -The Parser adds the following extra XPath functions. +=pod -=head2 xmiDeref +=head1 SYNOPSIS -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. + use SQL::Translator; + use SQL::Translator::Parser::XML::XMI; -If it doesn't have an xmi.id, the path is returned as normal. + my $translator = SQL::Translator->new( + from => 'XML-XMI', + to => 'MySQL', + filename => 'schema.xmi', + show_warnings => 1, + add_drop_table => 1, + ); -e.g. given + print $obj->translate; - - - - ... - - Class - +=head1 DESCRIPTION -Using xmideref(//UML:ModelElement.stereotype/UML:stereotype) would return the - tag. +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. -Using xmideref(//UML:ModelElement.stereotype/UML:stereotype)/@name would give -"Table". +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. -=head xmiVisible +=over 4 - is_visible( VISLEVEL ) +=item XML::XMI::Rational -Returns true or false for whether the visibility of something e.g. a Class or -Attribute, is visible at the level given. e.g. +The Rational Software UML Data Modeling Profile - //UML:Class[xmiVisible('public')] - Find all public classes - //UML:Class[xmiVisible('protected')] - Find all public and protected classes +=back -Supports the 3 UML visibility levels of public, protected and private. +=head1 ARGS -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. +=over 4 -=cut +=item visibility -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"); + visibilty=public|protected|private - my $id = $node->getAttribute("xmi.idref") or return $node; - return $node->getRootNode->find('//*[@xmi.id="'.$id.'"]'); -} +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. -{ - my %vislevel = ( - public => 1, - protected => 2, - private => 3, - ); +If not set or false (the default) no checks will be made and everything is +translated. - 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; - } -} +=back -# Test of custom xpath function. -sub hello { - return XML::XPath::Literal->new("Hello World"); -} +=head1 XMI Format -#============================================================================= -package main; +Uses either XMI v1.0 or v1.2. The version to use is detected automatically +from the tag in the source file. +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. -=pod =head1 BUGS Seems to be slow. I think this is because the XMI files can get pretty -big and complex, especially all the diagram info. - -=head1 TODO +big and complex, especially all the diagram info, and XPath needs to load the +whole tree. -B 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 tags and all their contents. -B Seperate control over what is -parsed, setting visibility arg will set both. +=head1 TODO -Everything else! Relations, fkeys, constraints, indexes, etc... +More profiles. =head1 AUTHOR