From: Mark Addison Date: Mon, 22 Sep 2003 11:41:07 +0000 (+0000) Subject: Moved Rational profile code to its own mod. Added support for tagged values, so X-Git-Tag: v0.04~175 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b2a00f50f65f6e2e95356c6e4f704c7fdfab25fb;p=dbsrgits%2FSQL-Translator.git Moved Rational profile code to its own mod. Added support for tagged values, so we can now model the data type, size and nullability of fields using rational. Updated the docs. --- diff --git a/lib/SQL/Translator/Parser/XML/XMI.pm b/lib/SQL/Translator/Parser/XML/XMI.pm index 64f2097..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.7 2003-09-17 16:27:21 grommit Exp $ +# $Id: XMI.pm,v 1.8 2003-09-22 11:41:07 grommit Exp $ # ------------------------------------------------------------------- # Copyright (C) 2003 Mark Addison , # @@ -25,63 +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 - -Currently pulls out all the Classes as tables. - -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. - -=head2 XMI Format - -The parser has been built using XMI 1.2 generated by PoseidonUML 2beta, which -says it uses UML 2. So the current conformance is down to Poseidon's idea -of XMI! - -It should also parse XMI 1.0, such as you get from Rose, but this has had -little testing! - -=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.7 $ =~ /(\d+)\.(\d+)/; +$VERSION = sprintf "%d.%02d", q$Revision: 1.8 $ =~ /(\d+)\.(\d+)/; $DEBUG = 0 unless defined $DEBUG; use Data::Dumper; @@ -121,6 +70,7 @@ sub parse { local $DEBUG = $translator->debug; $schema = $translator->schema; $pargs = $translator->parser_args; + $pargs->{classes2schema} ||= \&classes2schema; debug "Visibility Level:$pargs->{visibility}" if $DEBUG; @@ -142,27 +92,28 @@ sub parse { return 1; }, ); - debug "Found ".scalar(@$classes)." Classes: ".join(", ", map {$_->{"name"}} @$classes) if $DEBUG; debug "Classes:",Dumper($classes); - #print "Classes:",Dumper($classes),"\n"; # # Turn the data from get_classes into a Schema # - profile_default($classes); - + $pargs->{classes2schema}->($schema, $classes); return 1; } -sub profile_default { - my ($classes) = @_; +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; @@ -172,106 +123,87 @@ sub profile_default { 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 } -sub profile_rational { - my ($classes) = @_; +1; - foreach my $class (@$classes) { - next unless $class->{stereotype} eq "Table"; +__END__ - # Add the table - debug "Adding class: $class->{name}" if $DEBUG; - my $table = $schema->add_table( name => $class->{name} ) - or die "Schema Error: ".$schema->error; +=pod - # - # Fields from Class attributes - # - foreach my $attr ( @{$class->{attributes}} ) { - next unless $attr->{stereotype} eq "Column" - or $attr->{stereotype} eq "PK" - or $attr->{stereotype} eq "FK" - or $attr->{stereotype} eq "PFK"; - - my $ispk = - $attr->{stereotype} eq "PK" or $attr->{stereotype} eq "PFK" - ? 1 : 0; - my %data = ( - name => $attr->{name}, - data_type => $attr->{datatype}, - is_primary_key => $ispk, - ); - $data{default_value} = $attr->{initialValue} - if exists $attr->{initialValue}; +=head1 SYNOPSIS - my $field = $table->add_field( %data ) or die $schema->error; - $table->primary_key( $field->name ) if $data{'is_primary_key'}; - } - - # - # Constraints and indexes from Operations - # - foreach my $op ( @{$class->{operations}} ) { - next unless my $stereo = $op->{stereotype}; - my @fields = map {$_->{name}} @{$op->{parameters}}; - my %data = ( - name => $op->{name}, - type => "", - fields => [@fields], - ); - - # Work out type and any other data - if ( $stereo eq "Unique" ) { - $data{type} = "UNIQUE"; - } - elsif ( $stereo eq "PK" ) { - $data{type} = "PRIMARY_KEY"; - } - # TODO We need to work out the ref table - #elsif ( $stereo eq "FK" ) { - # $data{type} = "FOREIGN_KEY"; - #} - - # Add the constraint or index - if ( $data{type} ) { - $table->add_constraint( %data ) or die $schema->error; - } - elsif ( $stereo eq "Index" ) { - $data{type} = "NORMAL"; - $table->add_index( %data ) or die $schema->error; - } - - - } # Ops loop + use SQL::Translator; + use SQL::Translator::Parser::XML::XMI; - } # Classes loop -} + my $translator = SQL::Translator->new( + from => 'XML-XMI', + to => 'MySQL', + filename => 'schema.xmi', + show_warnings => 1, + add_drop_table => 1, + ); + + print $obj->translate; -1; #--------------------------------------------------------------------------- +=head1 DESCRIPTION -__END__ +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. + +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. + +=over 4 + +=item XML::XMI::Rational + +The Rational Software UML Data Modeling Profile + +=back + +=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 + +=head1 XMI Format + +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 @@ -279,15 +211,12 @@ 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. -=head1 TODO - -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 diff --git a/lib/SQL/Translator/Parser/XML/XMI/Rational.pm b/lib/SQL/Translator/Parser/XML/XMI/Rational.pm new file mode 100644 index 0000000..784dfb6 --- /dev/null +++ b/lib/SQL/Translator/Parser/XML/XMI/Rational.pm @@ -0,0 +1,203 @@ +package SQL::Translator::Parser::XML::XMI::Rational; + +# ------------------------------------------------------------------- +# $Id: Rational.pm,v 1.1 2003-09-22 11:41:07 grommit Exp $ +# ------------------------------------------------------------------- +# Copyright (C) 2003 Mark Addison , +# +# This program is free software; you can redistribute it and/or +# modify it under the terms of the GNU General Public License as +# published by the Free Software Foundation; version 2. +# +# This program is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA +# 02111-1307 USA +# ------------------------------------------------------------------- + +=head1 NAME + +SQL::Translator::Parser::XML::XMI::Rational - Create Schema using Rational's UML +Data Modeling Profile. + +=cut + +use strict; +use SQL::Translator::Parser::XML::XMI; +use SQL::Translator::Utils 'debug'; + +# Set the parg for the conversion sub then use the XMI parser +sub parse { + my ( $translator ) = @_; + my $pargs = $translator->parser_args; + $pargs->{classes2schema} = \&classes2schema; + return SQL::Translator::Parser::XML::XMI::parse(@_); +} + +sub classes2schema { + my ($schema, $classes) = @_; + + foreach my $class (@$classes) { + next unless $class->{stereotype} eq "Table"; + + # Add the table + debug "Adding class: $class->{name}"; + my $table = $schema->add_table( name => $class->{name} ) + or die "Schema Error: ".$schema->error; + + # + # Fields from Class attributes + # + foreach my $attr ( @{$class->{attributes}} ) { + next unless $attr->{stereotype} eq "Column" + or $attr->{stereotype} eq "PK" + or $attr->{stereotype} eq "FK" + or $attr->{stereotype} eq "PFK"; + + my $ispk = + $attr->{stereotype} eq "PK" or $attr->{stereotype} eq "PFK" + ? 1 : 0; + my %data = ( + name => $attr->{name}, + data_type => $attr->{datatype}, + is_primary_key => $ispk, + ); + $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}; + + my $field = $table->add_field( %data ) or die $schema->error; + $table->primary_key( $field->name ) if $data{'is_primary_key'}; + } + + # + # Constraints and indexes from Operations + # + foreach my $op ( @{$class->{operations}} ) { + next unless my $stereo = $op->{stereotype}; + my @fields = map {$_->{name}} grep {$_->{kind} ne "return"} @{$op->{parameters}}; + my %data = ( + name => $op->{name}, + type => "", + fields => [@fields], + ); + + # Work out type and any other data + if ( $stereo eq "Unique" ) { + $data{type} = "UNIQUE"; + } + elsif ( $stereo eq "PK" ) { + $data{type} = "PRIMARY_KEY"; + } + # TODO We need to work out the ref table + #elsif ( $stereo eq "FK" ) { + # $data{type} = "FOREIGN_KEY"; + #} + + # Add the constraint or index + if ( $data{type} ) { + $table->add_constraint( %data ) or die $schema->error; + } + elsif ( $stereo eq "Index" ) { + $data{type} = "NORMAL"; + $table->add_index( %data ) or die $schema->error; + } + + + } # Ops loop + + } # Classes loop +} + +1; #--------------------------------------------------------------------------- + +__END__ + +=pod + +=head1 SYNOPSIS + + use SQL::Translator; + use SQL::Translator::Parser::XML::XMI; + + my $translator = SQL::Translator->new( + from => 'XML-XMI-Rational', + to => 'MySQL', + filename => 'schema.xmi', + show_warnings => 1, + add_drop_table => 1, + ); + + print $obj->translate; + +=head1 DESCRIPTION + +Translates Schema described using Rational Software's UML Data Modeling Profile. +Finding good information on this profile seems to be very difficult so this +is based on a vague white paper and notes in vendors docs! + +Below is a summary of what this parser thinks the profile looks like. + +B Are classes marked with <> stereotype. + +B Attributes stereotyped with <> or one of the key stereotypes. +Additional info is added using tagged values of C, C and +C. Default value is given using normal UML default value for the +attribute. + +B Key fields are marked with <>, <> or <>. Note that this is +really to make it obvious on the diagram, you must still add the constraints. +(This parser will also automatically add the constraint for single field pkeys +for attributes marked with PK but I think this is out of spec.) + +B Stereotyped operations, with the names of the parameters +indicating which fields it applies to. Can use <>, <>, <> or +<>. + +e.g. + + +------------------------------------------------------+ + | <
> | + | Foo | + +------------------------------------------------------+ + | <> fooID { dataType=INT size=10 nullable=0 } | + | <> name { dataType=VARCHAR size=255 } | + | <> description { dataType=TEXT } | + +------------------------------------------------------+ + | <> con1( fooID ) | + | <> con2( name ) | + +------------------------------------------------------+ + + CREATE TABLE Foo ( + fooID INT(10) NOT NULL, + name VARCHAR(255), + description TEXT, + PRIMARY KEY (fooID), + UNIQUE (name) + ); + +=head1 ARGS + +=head1 BUGS + +=head1 TODO + +Relationships from associations. + +=head1 AUTHOR + +Mark D. Addison Emark.addison@itn.co.ukE. + +=head1 SEE ALSO + +perl(1), SQL::Translator::Parser::XML::XMI + +=cut diff --git a/lib/SQL/Translator/XMI/Parser.pm b/lib/SQL/Translator/XMI/Parser.pm index e3ccb06..0fcf776 100644 --- 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 => [ { @@ -382,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) = @_; @@ -406,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"; @@ -419,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); + } } } @@ -452,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; #===========================================================================