we can now model the data type, size and nullability of fields using rational.
Updated the docs.
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 <mark.addison@itn.co.uk>,
#
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;
local $DEBUG = $translator->debug;
$schema = $translator->schema;
$pargs = $translator->parser_args;
+ $pargs->{classes2schema} ||= \&classes2schema;
debug "Visibility Level:$pargs->{visibility}" if $DEBUG;
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;
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 <XMI> 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
big and complex, especially all the diagram info, and XPath needs to load the
whole tree.
-=head1 TODO
-
-B<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.
-B<table_visibility and field_visibility args> 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
--- /dev/null
+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 <mark.addison@itn.co.uk>,
+#
+# 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<Tables> Are classes marked with <<Table>> stereotype.
+
+B<Fields> Attributes stereotyped with <<Column>> or one of the key stereotypes.
+Additional info is added using tagged values of C<dataType>, C<size> and
+C<nullable>. Default value is given using normal UML default value for the
+attribute.
+
+B<Keys> Key fields are marked with <<PK>>, <<FK>> or <<PFK>>. 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<Constraints> Stereotyped operations, with the names of the parameters
+indicating which fields it applies to. Can use <<PK>>, <<FK>>, <<Unique>> or
+<<Index>>.
+
+e.g.
+
+ +------------------------------------------------------+
+ | <<Table>> |
+ | Foo |
+ +------------------------------------------------------+
+ | <<PK>> fooID { dataType=INT size=10 nullable=0 } |
+ | <<Column>> name { dataType=VARCHAR size=255 } |
+ | <<Column>> description { dataType=TEXT } |
+ +------------------------------------------------------+
+ | <<PK>> con1( fooID ) |
+ | <<Unique>> 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 E<lt>mark.addison@itn.co.ukE<gt>.
+
+=head1 SEE ALSO
+
+perl(1), SQL::Translator::Parser::XML::XMI
+
+=cut
# 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
+ },
],
};
path => 'UML:ModelElement.taggedValue/UML:TaggedValue',
class => "taggedValue",
multiplicity => "*",
+ map => "name",
},
],
};
path => 'UML:ModelElement.taggedValue/UML:TaggedValue',
class => "taggedValue",
multiplicity => "*",
+ map => "name",
},
],
};
$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 => [
{
# 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) = @_;
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";
$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);
+ }
}
}
} # /mk_get
+sub _mk_map {
+ my ($kids,$key) = @_;
+ my $map = {};
+ foreach (@$kids) {
+ $map->{$_->{$key}} = $_ if exists $_->{$key};
+ }
+ return $map;
+}
+
1; #===========================================================================
projects / dbsrgits/SQL-Translator.git / commitdiff