package SQL::Translator::Parser::XML::XMI;
# -------------------------------------------------------------------
-# $Id: XMI.pm,v 1.2 2003-09-08 12:27:29 grommit Exp $
+# $Id: XMI.pm,v 1.3 2003-09-08 17:10: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
+
+=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.2 $ =~ /(\d+)\.(\d+)/;
+$VERSION = sprintf "%d.%02d", q$Revision: 1.3 $ =~ /(\d+)\.(\d+)/;
$DEBUG = 0 unless defined $DEBUG;
use Data::Dumper;
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
+# get_classes( XPATHOBJ, ARGS );
#
-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
-#-----------------------------------------------------------------------------
-
+# 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.
#
-# is_visible( {ELEMENT|VIS_OF_THING}, VISLEVEL)
+# ARGS - Name/Value list of args.
#
-# Returns true or false for whether the visibility of something e.g. Class,
-# Attribute, is visible at the level given.
+# xpath => The xpath to use for finding classes. Default is //UML:Classes
+# which will find all the classes in the XMI.
#
-{
- my %vislevel = (
- public => 1,
- protected => 2,
- private => 3,
- );
+# 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 = {};
+
+ # <UML: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 = {};
+ # <UML:Attributes> 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;
+ }
- sub is_visible {
- my ($arg, $vis) = @_;
- return 1 unless $vis;
- my $foo;
- die "is_visible : Needs something to test" unless $arg;
- if ( $arg->isa("XML::XPath::Node::Element") ) {
- $foo = $arg->getAttribute("visibility");
- }
- else {
- $foo = $arg;
- }
- return 1 if $vislevel{$vis} >= $vislevel{$foo};
- return 0;
- }
-}
+ push @{$class->{attributes}}, $attr;
+ }
+
+ push @$classes, $class;
+ }
+
+ return $classes;
+};
sub parse {
+ eval {
+
my ( $translator, $data ) = @_;
local $DEBUG = $translator->debug;
my $schema = $translator->schema;
# - 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) if $DEBUG;
-
- for my $classnode (@nodes) {
- # Only process classes with <<Table>> and name
- next unless my $classname = $classnode->getAttribute("name");
- next unless !$pargs->{visibility}
- or is_visible($classnode, $pargs->{visibility});
-
- my $stereotype = "".$classnode->find(
- 'xmideref(UML:ModelElement.stereotype/UML:Stereotype)/@name');
- next unless $stereotype eq "Table";
+ #
+ # 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);
+
+ debug "Found ".scalar(@$classes)." Classes: ".join(", ",
+ map {$_->{"name"}} @$classes) if $DEBUG;
+ debug "Classes:",Dumper($classes);
+
+ #
+ # Turn the data from get_classes into a Schema
+ #
+ foreach my $class (@$classes) {
+ next unless $class->{stereotype} eq "Table";
# Add the table
- debug "Adding class: $classname as table:$classname" if $DEBUG;
- my $table = $schema->add_table(name=>$classname)
+ debug "Adding class: $class->{name}" if $DEBUG;
+ my $table = $schema->add_table( name => $class->{name} )
or die "Schema Error: ".$schema->error;
#
# 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");
- next unless !$pargs->{visibility}
- or is_visible($attrnode, $pargs->{visibility});
-
- 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,
+ 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,
);
- if ( my @body = $attrnode->findnodes(
- 'UML:Attribute.initialValue/UML:Expression/@body')
- ) {
- $data{default_value} = $body[0]->getData;
- }
+ $data{default_value} = $attr->{initialValue}
+ if exists $attr->{initialValue};
debug "Adding field:",Dumper(\%data);
my $field = $table->add_field( %data ) or die $schema->error;
} # Classes loop
return 1;
+
+ };
+ print "ERROR: $@\n" if $@;
+ return 1;
}
1;
-# -------------------------------------------------------------------
+#=============================================================================
+#
+# XML::XPath extensions
+#
+#=============================================================================
-=pod
+package XML::XPath::Function;
-=head1 SYNOPSIS
+=head1 XMI XPath Functions
- use SQL::Translator;
- use SQL::Translator::Parser::XML::XMI;
+The Parser adds the following extra XPath functions.
- my $translator = SQL::Translator->new(
- from => 'XML-XMI',
- to => 'MySQL',
- filename => 'schema.xmi',
- show_warnings => 1,
- add_drop_table => 1,
- );
+=head2 xmiDeref
- print $obj->translate;
+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.
-=head1 DESCRIPTION
+If it doesn't have an xmi.id, the path is returned as normal.
-=head2 UML Data Modeling
+e.g. given
-To tell the parser which Classes are tables give them a <<Table>> stereotype.
+ <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>
-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.
+Using xmideref(//UML:ModelElement.stereotype/UML:stereotype) would return the
+<UML:Stereotype xmi.id = '3b4b1e:f762a35f6b:-7fb6' ...> tag.
-Primary keys are attributes marked with <<PK>> stereotype.
+Using xmideref(//UML:ModelElement.stereotype/UML:stereotype)/@name would give
+"Table".
-=head2 XMI Format
+=head xmiVisible
-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!
+ is_visible( VISLEVEL )
-=head1 ARGS
+Returns true or false for whether the visibility of something e.g. a Class or
+Attribute, is visible at the level given. e.g.
-=over 4
+ //UML:Class[xmiVisible('public')] - Find all public classes
+ //UML:Class[xmiVisible('protected')] - Find all public and protected classes
-=item visibility
+Supports the 3 UML visibility levels of public, protected and private.
- visibilty=public|protected|private
+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.
-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.
+=cut
-If not set or false (the default) no checks will be made and everything is
-translated.
+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");
-=back
+ my $id = $node->getAttribute("xmi.idref") or return $node;
+ return $node->getRootNode->find('//*[@xmi.id="'.$id.'"]');
+}
+
+{
+ my %vislevel = (
+ public => 1,
+ protected => 2,
+ private => 3,
+ );
+
+ 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;
+ }
+}
+
+# Test of custom xpath function.
+sub hello {
+ return XML::XPath::Literal->new("Hello World");
+}
+
+#=============================================================================
+package main;
+
+
+=pod
=head1 BUGS
SQL::Translator::Schema.
=cut
+
+
projects / dbsrgits/SQL-Translator.git / commitdiff