--- /dev/null
+package SQL::Translator::Parser::XML::XMI;
+
+# -------------------------------------------------------------------
+# $Id: XMI.pm,v 1.1 2003-09-04 15:55:47 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 - Parser to create Schema from UML
+Class diagrams stored in XMI format.
+
+=cut
+
+# -------------------------------------------------------------------
+
+use strict;
+
+use vars qw[ $DEBUG $VERSION @EXPORT_OK ];
+$VERSION = sprintf "%d.%02d", q$Revision: 1.1 $ =~ /(\d+)\.(\d+)/;
+$DEBUG = 0 unless defined $DEBUG;
+
+use Data::Dumper;
+use Exporter;
+use base qw(Exporter);
+@EXPORT_OK = qw(parse);
+
+use base qw/SQL::Translator::Parser/; # Doesnt do anything at the mo!
+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
+#
+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
+#-----------------------------------------------------------------------------
+
+sub parse {
+ my ( $translator, $data ) = @_;
+ local $DEBUG = $translator->debug;
+ my $schema = $translator->schema;
+ my $pargs = $translator->parser_args;
+
+ my $xp = XML::XPath->new(xml => $data);
+
+ $xp->set_namespace("UML", "org.omg.xmi.namespace.UML");
+ #
+ # 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.
+ #
+
+ #
+ # 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);
+
+ for my $classnode (@nodes) {
+ # Only process classes with <<Table>> and name
+ next unless my $classname = $classnode->getAttribute("name");
+ my $stereotype = "".$classnode->find(
+ 'xmideref(UML:ModelElement.stereotype/UML:Stereotype)/@name');
+ next unless $stereotype eq "Table";
+
+ # Add the table
+ debug "Adding class: $classname as table:$classname";
+ my $table = $schema->add_table(name=>$classname)
+ 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 $attrnode ( $classnode->findnodes(
+ 'UML:Classifier.feature/UML:Attribute[@xmi.id]',)
+ ) {
+ next unless my $fieldname = $attrnode->getAttribute("name");
+ 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,
+ #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;
+ }
+
+ 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;
+}
+
+1;
+
+# -------------------------------------------------------------------
+
+=pod
+
+=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 TODO
+
+ visibilty=public|private|protected|package
+
+What visibilty of stuff to translate. e.g when set to 'public' any private
+Classes will be ignored and not turned into tables.
+
+=item table_visibility TODO
+
+=item field_visibility TODO
+
+=item table_stereotype Def:Table TODO
+
+What stereotype a class must have to turned into a table.
+
+=item pkey_stereotype Def:PK TODO
+
+=back
+
+=head1 BUGS
+
+=head1 TODO
+
+Deal with field sizes. Don't think UML does this directly so may need to include
+it in the datatype names.
+
+Everything else! Relations, fkeys, constraints, indexes, etc...
+
+=head1 AUTHOR
+
+Mark D. Addison E<lt>mark.addison@itn.co.ukE<gt>.
+
+=head1 SEE ALSO
+
+perl(1), SQL::Translator, XML::XPath, SQL::Translator::Producer::XML::SQLFairy,
+SQL::Translator::Schema.
+
+=cut
projects / dbsrgits/SQL-Translator.git / blobdiff