package SQL::Translator::Parser::XML::XMI;
# -------------------------------------------------------------------
-# $Id: XMI.pm,v 1.4 2003-09-09 01:00:44 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>,
#
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 <<Table>> 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 <<PK>> 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.4 $ =~ /(\d+)\.(\d+)/;
+$VERSION = sprintf "%d.%02d", q$Revision: 1.10 $ =~ /(\d+)\.(\d+)/;
$DEBUG = 0 unless defined $DEBUG;
use Data::Dumper;
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;
-# XMI XPath parsing
+# SQLFairy 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.
-#
-# test => An XPath predicate (ie the bit between [] ) to test the
-# classes with to decide if we should parse them. ie
-# test => '@name' would only pass out classes with a name.
-# Can also give it an array ref and it will and the tests.
-# It gets tacked onto to xpath so don't put any [] on
-# xpath if you use test as well.
-#
-# attribute_test => An XPath predicate to pass onto get_attributes.
-#
-
-# _add_xpath_tests $path, [qw/@name xmiVisible("public")/]; # and
-# _add_xpath_tests $path, [qw/@name xmiVisible("public")/], "or";
-sub _add_xpath_tests {
- my ($path,$tests,$join) = @_;
- return $path unless defined $tests;
- my @tests = ref($tests) ? @$tests : $tests;
- return $path unless @tests;
- $join ||= "and";
- return $path."[".join(" $join ", @tests)."]";
-}
-
-sub get_stereotype {
- my ($xp) = @_;
- return "".$xp->findvalue(
- 'xmiDeref(UML:ModelElement.stereotype/UML:Stereotype)/@name');
- # TODO Test for difference between it existing or being "" ?
-}
+# is_visible - Used to check visibility in filter subs
+{
+ my %vislevel = (
+ public => 1,
+ protected => 2,
+ private => 3,
+ );
-sub get_classes {
- my ($xp,%args) = @_;
- my $classes;
-
- my $xpath = $args{xpath} ||= '//UML:Class'; # Default: all classes
- $xpath = _add_xpath_tests $xpath, $args{test};
- debug "Searching for Classes using:$xpath";
-
- my @nodes = $xp->findnodes($xpath);
- return unless @nodes;
-
- for my $classnode (@nodes) {
- my $class = {};
-
- foreach (
- qw/name visibility isSpecification
- isRoot isLeaf isAbstract isActive/
- ) {
- $class->{$_} = $classnode->getAttribute($_);
- }
- $class->{stereotype} = get_stereotype($classnode);
-
- # Class Attributes
- my $xpath = 'UML:Classifier.feature/UML:Attribute';
- $class->{attributes} = get_attributes( $classnode,
- xpath => $xpath, test => $args{attribute_test} );
-
- push @$classes, $class;
- }
- return wantarray ? @$classes : $classes;
-};
-
-sub get_attributes {
- my ($xp, %args) = @_;
-
- my $xpath = $args{xpath} ||= '//UML:Classifier.feature/UML:Attribute';
- $xpath = _add_xpath_tests $xpath, $args{test};
- debug "Searching for Attributes using:$xpath";
-
- my $attributes;
- foreach my $node ( $xp->findnodes($xpath) ) {
- my $attr = {};
-
- foreach (qw/name visibility isSpecification ownerScope/) {
- $attr->{$_} = $node->getAttribute($_);
- }
- $attr->{stereotype} = get_stereotype($node);
-
- # Get datatype name and the name body of the initial value
- $attr->{datatype} = "".$node->find(
- 'xmiDeref(UML:StructuralFeature.type/UML:DataType)/@name');
- if ( my @body = $node->findnodes(
- 'UML:Attribute.initialValue/UML:Expression/@body')
- ) {
- $attr->{initialValue} = $body[0]->getData;
- }
-
- push @$attributes, $attr;
+ 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;
}
- return wantarray ? @$attributes : $attributes;
}
-
-
-# SQLFairy Parser
-#-----------------------------------------------------------------------------
+my ($schema, $pargs);
sub parse {
- eval {
-
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...
- #
- # Only classes with an id (so we don't get any refs to classes ie
- # xmi.idref classes). They also need a name to be usefull.
- my @tests = ('@xmi.id and @name');
- push @tests, "xmiVisible('$pargs->{visibility}')" if $pargs->{visibility};
-
- my $attrib_test = '@name and @xmi.id';
- $attrib_test .= " and xmiVisible('$pargs->{visibility}')"
- if $pargs->{visibility};
-
- # ...and parse them out
- my $classes = get_classes( $xp,
- xpath => "//UML:Class", test => [@tests], 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 "Model:",Dumper($xmip->{model}) if $DEBUG;
#
# 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}{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;
-
- };
- print "ERROR: $@\n" if $@;
- return 1;
}
1;
-#=============================================================================
-#
-# XML::XPath extensions
-#
-#=============================================================================
+__END__
-package XML::XPath::Function;
-
-=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;
- <UML:ModelElement.stereotype>
- <UML:Stereotype xmi.idref = 'stTable'/>
- </UML:ModelElement.stereotype>
- ...
- <UML:Stereotype xmi.id='stTable' name='Table' visibility='public'
- isAbstract='false' isSpecification='false' isRoot='false' isLeaf='false'>
- <UML:Stereotype.baseClass>Class</UML:Stereotype.baseClass>
- </UML:Stereotype>
+=head1 DESCRIPTION
-Using xmideref(//UML:ModelElement.stereotype/UML:stereotype) would return the
-<UML:Stereotype xmi.id = '3b4b1e:f762a35f6b:-7fb6' ...> 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 <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
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<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
projects / dbsrgits/SQL-Translator.git / blobdiff