package SQL::Translator::Parser::XML::XMI;
# -------------------------------------------------------------------
-# $Id: XMI.pm,v 1.5 2003-09-09 01:37:25 grommit Exp $
+# $Id: XMI.pm,v 1.6 2003-09-16 16:29:49 grommit Exp $
# -------------------------------------------------------------------
# Copyright (C) 2003 Mark Addison <mark.addison@itn.co.uk>,
#
=head1 DESCRIPTION
-=head2 UML Data Modeling
-
-To tell the parser which Classes are tables give them a <<Table>> stereotype.
+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.
-Primary keys are attributes marked with <<PK>> stereotype.
-
=head2 XMI Format
-The parser has been built using XMI generated by PoseidonUML 2beta, which
+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
use strict;
use vars qw[ $DEBUG $VERSION @EXPORT_OK ];
-$VERSION = sprintf "%d.%02d", q$Revision: 1.5 $ =~ /(\d+)\.(\d+)/;
+$VERSION = sprintf "%d.%02d", q$Revision: 1.6 $ =~ /(\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;
-
-# XMI XPath parsing
-#-----------------------------------------------------------------------------
-
-#
-# 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.
-#
+use SQL::Translator::XMI::Parser;
-# _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 "" ?
-}
-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} = get_attributes( $classnode,
- xpath => 'UML:Classifier.feature/UML:Attribute',
- test => $args{attribute_test} );
-
- $class->{operations} = get_operations( $classnode,
- xpath => '//UML:Classifier.feature/UML:Operation',
- test => $args{operation_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 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;
- }
- return wantarray ? @$attributes : $attributes;
-}
-
-sub get_operations {
- my ($xp, %args) = @_;
-
- my $xpath = $args{xpath} ||= '//UML:Classifier.feature/UML:Operation';
- $xpath = _add_xpath_tests $xpath, $args{test};
- debug "Searching for operations using:$xpath";
-
- my $operations;
- foreach my $node ( $xp->findnodes($xpath) ) {
- my $operation = {};
-
- foreach (qw/name visibility isSpecification ownerScope isQuery
- concurrency isRoot isLeaf isAbstract/) {
- $operation->{$_} = $node->getAttribute($_);
- }
- $operation->{stereotype} = get_stereotype($node);
-
- $operation->{parameters} = get_parameters( $node,
- xpath => 'UML:BehavioralFeature.parameter/UML:Parameter',
- test => $args{attribute_test}
- );
-
- push @$operations, $operation;
- }
- return wantarray ? @$operations : $operations;
-}
-
-sub get_parameters {
- my ($xp, %args) = @_;
+# SQLFairy Parser
+#-----------------------------------------------------------------------------
- my $xpath = $args{xpath} ||= '//UML:Classifier.feature/UML:Attribute';
- $xpath = _add_xpath_tests $xpath, $args{test};
- debug "Searching for Attributes using:$xpath";
-
- my $parameters;
- foreach my $node ( $xp->findnodes($xpath) ) {
- my $parameter = {};
-
- foreach (qw/name isSpecification kind/) {
- $parameter->{$_} = $node->getAttribute($_);
- }
- $parameter->{stereotype} = get_stereotype($node);
+# is_visible - Used to check visibility in filter subs
+{
+ my %vislevel = (
+ public => 1,
+ protected => 2,
+ private => 3,
+ );
- $parameter->{datatype} = "".$node->find(
- 'xmiDeref(UML:Parameter.type/UML:DataType)/@name');
-
- push @$parameters, $parameter;
+ 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 ? @$parameters : $parameters;
}
-# SQLFairy Parser
-#-----------------------------------------------------------------------------
-
sub parse {
- eval {
-
my ( $translator, $data ) = @_;
- local $DEBUG = $translator->debug;
- my $schema = $translator->schema;
- my $pargs = $translator->parser_args;
-
+ local $DEBUG = $translator->debug;
+ my $schema = $translator->schema;
+ my $pargs = $translator->parser_args;
+
+ eval {
+
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 "Classes:",Dumper($classes);
+ #print "Classes:",Dumper($classes),"\n";
#
# Turn the data from get_classes into a Schema
#
+ # TODO This is where we will applie different strategies for different UML
+ # data modeling profiles.
+ #
foreach my $class (@$classes) {
- next unless $class->{stereotype} eq "Table";
-
# Add the table
debug "Adding class: $class->{name}" if $DEBUG;
my $table = $schema->add_table( name => $class->{name} )
#
# 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},
}
} # Classes loop
+
+ };
+ print "ERROR:$@" if $@;
return 1;
-
- };
- print "ERROR: $@\n" if $@;
- return 1;
}
1;
-#=============================================================================
-#
-# XML::XPath extensions
-#
-#=============================================================================
-
-package XML::XPath::Function;
-
-=head1 XMI XPath Functions
-
-The Parser adds the following extra XPath functions.
-
-=head2 xmiDeref
-
-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.
-
-If it doesn't have an xmi.id, the path is returned as normal.
-
-e.g. given
-
- <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>
-
-Using xmideref(//UML:ModelElement.stereotype/UML:stereotype) would return the
-<UML:Stereotype xmi.id = '3b4b1e:f762a35f6b:-7fb6' ...> tag.
-
-Using xmideref(//UML:ModelElement.stereotype/UML:stereotype)/@name would give
-"Table".
-
-=head xmiVisible
-
- is_visible( VISLEVEL )
-
-Returns true or false for whether the visibility of something e.g. a Class or
-Attribute, is visible at the level given. e.g.
-
- //UML:Class[xmiVisible('public')] - Find all public classes
- //UML:Class[xmiVisible('protected')] - Find all public and protected classes
-
-Supports the 3 UML visibility levels of public, protected and 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.
-
-=cut
-
-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");
-
- 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
Seems to be slow. I think this is because the XMI files can get pretty
-big and complex, especially all the diagram info.
+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.
-B<Check the Tag Attribute lists in get_* subs> I have taken them from looking
-at Poseidon so need to check against XMI spec.
-
B<table_visibility and field_visibility args> Seperate control over what is
parsed, setting visibility arg will set both.
--- /dev/null
+package SQL::Translator::XMI::Parser;
+
+=pod
+
+=head1 NAME
+
+SQL::Translator::XMI::Parser- Perl class for blah blah blah
+
+=cut
+
+use strict;
+use 5.006_001;
+our $VERSION = "0.01";
+
+use XML::XPath;
+use XML::XPath::XMLParser;
+use Storable qw/dclone/;
+
+# Spec
+#=============================================================================
+#
+# Describes the 2 xmi formats 1.2 and 1.0. Neither is complete!
+#
+# NB The names of the data keys MUST be the same for both specs so the
+# data structures returned are the same.
+#
+# There is currently no way to set the data key name for attrib_data, it just
+# uses the attribute name from the XMI. This isn't a problem at the moment as
+# xmi1.0 names all these things with tags so we don't need the attrib data!
+# Also use of names seems to be consistant between the versions.
+#
+
+my $SPECS = {};
+
+my $spec12 = $SPECS->{"1.2"} = {};
+
+$spec12->{class} = {
+ name => "class",
+ plural => "classes",
+ default_path => '//UML:Class[@xmi.id]',
+ attrib_data =>
+ [qw/name visibility isSpecification isRoot isLeaf isAbstract isActive/],
+ path_data => [
+ {
+ name => "stereotype",
+ path => 'xmiDeref(UML:ModelElement.stereotype/UML:Stereotype)/@name',
+ default => "",
+ },
+ ],
+ kids => [
+ {
+ name => "attributes",
+ # name in data returned
+ path => "UML:Classifier.feature/UML:Attribute",
+ class => "attribute",
+ # Points to class in spec. get_attributes() called to parse it and
+ # adds filter_attributes to the args for get_classes().
+ multiplicity => "*",
+ # 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",
+ 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!
+ },
+ ],
+};
+
+$spec12->{taggedValue} = {
+ name => "taggedValue",
+ plural => "taggedValues",
+ default_path => '//UML:TaggedValue[@xmi.id]',
+ attrib_data => [qw/isSpecification/],
+ path_data => [
+ {
+ name => "dataValue",
+ path => 'UML:TaggedValue.dataValue/text()',
+ },
+ {
+ name => "name",
+ path => 'xmiDeref(UML:TaggedValue.type/UML:TagDefinition)/@name',
+ },
+ ],
+};
+
+$spec12->{attribute} = {
+ name => "attribute",
+ plural => "attributes",
+ default_path => '//UML:Classifier.feature/UML:Attribute[@xmi.id]',
+ attrib_data =>
+ [qw/name visibility isSpecification ownerScope/],
+ path_data => [
+ {
+ name => "stereotype",
+ path => 'xmiDeref(UML:ModelElement.stereotype/UML:Stereotype)/@name',
+ default => "",
+ },
+ {
+ name => "datatype",
+ path => 'xmiDeref(UML:StructuralFeature.type/UML:DataType)/@name',
+ },
+ {
+ name => "initialValue",
+ path => 'UML:Attribute.initialValue/UML:Expression/@body',
+ },
+ ],
+ kids => [
+ {
+ name => "taggedValues",
+ path => 'UML:ModelElement.taggedValue/UML:TaggedValue',
+ class => "taggedValue",
+ multiplicity => "*",
+ },
+ ],
+};
+
+$spec12->{operation} = {
+ name => "operation",
+ plural => "operations",
+ default_path => '//UML:Classifier.feature/UML:Operation[@xmi.id]',
+ attrib_data =>
+ [qw/name visibility isSpecification ownerScope isQuery
+ concurrency isRoot isLeaf isAbstract/],
+ path_data => [
+ {
+ name => "stereotype",
+ path => 'xmiDeref(UML:ModelElement.stereotype/UML:Stereotype)/@name',
+ default => "",
+ },
+ ],
+ kids => [
+ {
+ name => "parameters",
+ path => "UML:BehavioralFeature.parameter/UML:Parameter",
+ class => "parameter",
+ multiplicity => "*",
+ },
+ {
+ name => "taggedValues",
+ path => 'UML:ModelElement.taggedValue/UML:TaggedValue',
+ class => "taggedValue",
+ multiplicity => "*",
+ },
+ ],
+};
+
+$spec12->{parameter} = {
+ name => "parameter",
+ plural => "parameters",
+ default_path => '//UML:BehavioralFeature.parameter/UML:Parameter[@xmi.id]',
+ attrib_data => [qw/name isSpecification kind/],
+ path_data => [
+ {
+ name => "stereotype",
+ path => 'xmiDeref(UML:ModelElement.stereotype/UML:Stereotype)/@name',
+ default => "",
+ },
+ {
+ name => "datatype",
+ path => 'xmiDeref(UML:StructuralFeature.type/UML:DataType)/@name',
+ },
+ ],
+};
+
+#-----------------------------------------------------------------------------
+
+my $spec10 = $SPECS->{"1.0"} = {};
+
+$spec10->{class} = {
+ name => "class",
+ plural => "classes",
+ default_path => '//Foundation.Core.Class[@xmi.id]',
+ attrib_data => [],
+ path_data => [
+ {
+ name => "name",
+ path => 'Foundation.Core.ModelElement.name/text()',
+ },
+ {
+ name => "visibility",
+ path => 'Foundation.Core.ModelElement.visibility/@xmi.value',
+ },
+ {
+ name => "isSpecification",
+ path => 'Foundation.Core.ModelElement.isSpecification/@xmi.value',
+ },
+ {
+ name => "isRoot",
+ path => 'Foundation.Core.GeneralizableElement.isRoot/@xmi.value',
+ },
+ {
+ name => "isLeaf",
+ path => 'Foundation.Core.GeneralizableElement.isLeaf/@xmi.value',
+ },
+ {
+ name => "isAbstract",
+ path => 'Foundation.Core.GeneralizableElement.isAbstract/@xmi.value',
+ },
+ {
+ name => "isActive",
+ path => 'Foundation.Core.Class.isActive/@xmi.value',
+ },
+ ],
+ kids => [
+ {
+ name => "attributes",
+ path =>
+ 'Foundation.Core.Classifier.feature/Foundation.Core.Attribute',
+ class => "attribute",
+ multiplicity => "*",
+ },
+ # {
+ # name => "operations",
+ # path => "UML:Classifier.feature/UML:Operation",
+ # class => "operation",
+ # multiplicity => "*",
+ # },
+ ],
+};
+
+$spec10->{attribute} = {
+ name => "attribute",
+ plural => "attributes",
+ default_path => '//Foundation.Core.Attribute[@xmi.id]',
+ path_data => [
+ {
+ name => "name",
+ path => 'Foundation.Core.ModelElement.name/text()',
+ },
+ {
+ name => "visibility",
+ path => 'Foundation.Core.ModelElement.visibility/@xmi.value',
+ },
+ {
+ name => "isSpecification",
+ path => 'Foundation.Core.ModelElement.isSpecification/@xmi.value',
+ },
+ {
+ name => "ownerScope",
+ path => 'Foundation.Core.Feature.ownerScope/@xmi.value',
+ },
+ {
+ name => "initialValue",
+ path => 'Foundation.Core.Attribute.initialValue/Foundation.Data_Types.Expression/Foundation.Data_Types.Expression.body/text()',
+ },
+ #{
+ # name => "datatype",
+ # path => 'xmiDeref(Foundation.Core.StructuralFeature.type/Foundation.Core.Classifier)/Foundation.Core.DataType/Foundation.Core.ModelElement.name/text()',
+ #},
+ ],
+};
+
+#=============================================================================
+
+#
+# How this works!
+#=================
+#
+# The parser supports xmi1.0 and xmi1.2 based on the specs above. At new() time
+# the version is read from the XMI tag and picks out a spec e.g.
+# $SPECS->{"1.2"} and feeds it to mk_gets() which returns a hash ref of subs
+# (think strategy pattern), one for each entry in the specs hash. This is held
+# in $self->{xmi_get_}.
+#
+# When the class is use'd it sets dispatch methods with
+# mk_get_dispatch() that return the call using the corresponding sub in
+# $self->{xmi_get_}. e.g.
+#
+# sub get_classes { $_[0]->{xmi_get_}{classes}->(@_); }
+# sub get_attributes { $_[0]->{xmi_get_}{attributes}->(@_); }
+# sub get_classes { $_[0]->{xmi_get_}{classes}->(@_); }
+#
+# The names for the data keys in the specs must match up so that we get the
+# same data structure for each version.
+#
+
+# Class setup
+foreach ( values %$SPECS ) { init_specs($_) };
+mk_get_dispatch();
+
+# Build lookups etc. Its important that each spec item becomes self contained
+# so we can build good closures, therefor we do all the lookups 1st.
+sub init_specs {
+ my $specs = shift;
+
+ foreach my $spec ( values %$specs ) {
+ foreach ( @{$spec->{kids}} ) {
+ $_->{get_method} = "get_".$specs->{$_->{class}}{plural};
+ }
+ }
+
+}
+
+# Generate get_* subs to dispach the calls to the subs held in $me->{xmi_get_}
+sub mk_get_dispatch {
+ foreach ( values %{$SPECS->{"1.2"}} ) {
+ my $name = $_->{plural};
+ no strict "refs";
+
+ # get_ on parser
+ *{"get_$name"} = sub {
+ #my $me = shift;
+ #$me->{xmi_get_}{$name}->($me,@_);
+ $_[0]->{xmi_get_}{$name}->(@_);
+ };
+ }
+}
+
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my %args = @_;
+ my $me = {};
+
+ # Create the XML::XPath object
+ # TODO Docs recommend we only use 1 XPath object per application
+ my $xp;
+ foreach (qw/filename xml ioref/) {
+ if ($args{$_}) {
+ $xp = XML::XPath->new( $_ => $args{$_});
+ $xp->set_namespace("UML", "org.omg.xmi.namespace.UML");
+ last;
+ }
+ }
+ $me = { xml_xpath => $xp };
+
+ # Work out the version of XMI we have and generate the get subs to parse it
+ my $xmiv = "".$xp->findvalue('/XMI/@xmi.version')
+ or die "Can't find XMI version";
+ $me->{xmi_get_} = mk_gets($SPECS->{$xmiv});
+
+ return bless $me, $class;
+}
+
+
+# Returns hashref of get subs from set of specs e.g. $SPECS->{"1.2"}
+#
+# TODO
+# * Add a memoize so we don't keep regenerating the subs for every use.
+sub mk_gets {
+ my $specs = shift;
+ my $gets;
+ foreach ( values %$specs ) {
+ # Clone from specs and sort out the lookups into it so we get a
+ # self contained spec to use as a proper closure.
+ my $spec = dclone($_);
+
+ # Add the sub
+ $gets->{$spec->{plural}} = mk_get($spec);
+ }
+ return $gets;
+}
+
+#
+# mk_get
+#
+# Generates and returns a get_ sub for the spec given. e.g. give it
+# $SPECS->{"1.2"}->{classes} to get the code for xmi 1.2 get_classes. So, if
+# you want to change how the get methods work do it here!
+#
+# The get methods made have the args described in the docs and 2 private args
+# used internally, to call other get methods from paths in the spec.
+#
+# 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) = @_;
+ my $xp = delete $args{_context} || $me->{xml_xpath};
+ my $things;
+
+ my $xpath = $args{_xpath} ||= $spec->{default_path};
+#warn "Searching for $spec->{plural} using:$xpath\n";
+
+ my @nodes = $xp->findnodes($xpath);
+ return unless @nodes;
+
+ 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";
+ my @nodes = $node->findnodes($_->{path});
+ $thing->{$_->{name}} = @nodes ? $nodes[0]->getData
+ : (exists $_->{default} ? $_->{default} : undef);
+ }
+
+ # 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 $meth = $_->{get_method};
+ $data = $me->$meth( _context => $node, _xpath => $_->{path},
+ filter => $args{"filter_$_->{name}"} );
+
+ if ( $_->{multiplicity} eq "1" ) {
+ $thing->{$_->{name}} = shift @$data;
+ }
+ else {
+ $thing->{$_->{name}} = $data || [];
+ }
+ }
+
+ push @$things, $thing;
+ }
+ return wantarray ? @$things : $things;
+} # /closure sub
+
+} # /mk_get
+
+1; #===========================================================================
+
+
+package XML::XPath::Function;
+
+#
+# May need to look at doing deref on all paths just to be on the safe side!
+#
+# Will also want some caching as these calls are expensive as the whole doc
+# is used but the same ref will likley be requested lots of times.
+#
+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");
+
+ my $id = $node->getAttribute("xmi.idref") or return $node;
+ return $node->getRootNode->find('//*[@xmi.id="'.$id.'"]');
+}
+
+
+# compile please
+1;
+
+__END__
+
+=head1 SYNOPSIS
+
+ use SQL::Translator::XMI::Parser;
+ my $xmip = SQL::Translator::XMI::Parser->new( xml => $xml );
+ my $classes = $xmip->get_classes();
+
+=head1 DESCRIPTION
+
+Parses XMI files (XML version of UML diagrams) to perl data structures and
+provides hooks to filter the data down to what you want.
+
+=head2 new
+
+Pass in name/value arg of either filename, xml or ioref for the XMI data you
+want to parse.
+
+=head2 get_* methods
+
+Doc below is for classes method, all the other calls follow this form.
+
+=head2 get_classes( ARGS )
+
+ ARGS - Name/Value list of args.
+
+ filter => A sub to filter the node to see if we want it. Has the nodes data,
+ before kids are added, referenced to $_. Should return true if you
+ want it, false otherwise.
+
+ e.g. To find only classes with a "Foo" stereotype.
+
+ filter => sub { return $_->{stereotype} eq "Foo"; }
+
+ filter_attributes => A filter sub to pass onto get_attributes.
+
+ filter_operations => A filter sub to pass onto get_operations.
+
+Returns a perl data structure including all the kids. e.g.
+
+ {
+ 'name' => 'Foo',
+ 'visibility' => 'public',
+ 'isActive' => 'false',
+ 'isAbstract' => 'false',
+ 'isSpecification' => 'false',
+ 'stereotype' => 'Table',
+ 'isRoot' => 'false',
+ 'isLeaf' => 'false',
+ 'attributes' => [
+ {
+ 'name' => 'fooid',
+ 'stereotype' => 'PK',
+ 'datatype' => 'int'
+ 'ownerScope' => 'instance',
+ 'visibility' => 'public',
+ 'initialValue' => undef,
+ 'isSpecification' => 'false',
+ },
+ {
+ 'name' => 'name',
+ 'stereotype' => '',
+ 'datatype' => 'varchar'
+ 'ownerScope' => 'instance',
+ 'visibility' => 'public',
+ 'initialValue' => '',
+ 'isSpecification' => 'false',
+ },
+ ]
+ 'operations' => [
+ {
+ 'name' => 'magic',
+ 'isQuery' => 'false',
+ 'ownerScope' => 'instance',
+ 'visibility' => 'public',
+ 'isSpecification' => 'false',
+ 'stereotype' => '',
+ 'isAbstract' => 'false',
+ 'isLeaf' => 'false',
+ 'isRoot' => 'false',
+ 'concurrency' => 'sequential'
+ 'parameters' => [
+ {
+ 'kind' => 'inout',
+ 'isSpecification' => 'false',
+ 'stereotype' => '',
+ 'name' => 'arg1',
+ 'datatype' => undef
+ },
+ {
+ 'kind' => 'inout',
+ 'isSpecification' => 'false',
+ 'stereotype' => '',
+ 'name' => 'arg2',
+ 'datatype' => undef
+ },
+ {
+ 'kind' => 'return',
+ 'isSpecification' => 'false',
+ 'stereotype' => '',
+ 'name' => 'return',
+ 'datatype' => undef
+ }
+ ],
+ }
+ ],
+ }
+
+=head1 XMI XPath Functions
+
+The Parser adds the following extra XPath functions for use in the SPECS.
+
+=head2 xmiDeref
+
+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.
+
+If it doesn't have an xmi.id, the path is returned as normal.
+
+e.g. given
+
+ <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>
+
+Using xmideref(//UML:ModelElement.stereotype/UML:stereotype) would return the
+<UML:Stereotype xmi.id = '3b4b1e:f762a35f6b:-7fb6' ...> tag.
+
+Using xmideref(//UML:ModelElement.stereotype/UML:stereotype)/@name would give
+"Table".
+
+=head1 SEE ALSO
+
+perl(1).
+
+=head1 TODO
+
+=head1 BUGS
+
+=head1 VERSION HISTORY
+
+=head1 AUTHOR
+
+grommit <mark.addison@itn.co.uk>
+
+=head1 LICENSE
+
+This package is free software and is provided "as is" without express or
+implied warranty. It may be used, redistributed and/or modified under the
+terms of either;
+
+a) the Perl Artistic License.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+b) the terms of the GNU General Public License as published by the Free Software
+Foundation; either version 1, or (at your option) any later version.
+
+=cut
#
my $scma = $obj->schema;
my @tblnames = map {$_->name} $scma->get_tables;
-is_deeply( \@tblnames, [qw/Foo PrivateFoo Recording Track ProtectedFoo/]
+is_deeply( \@tblnames, [qw/Foo PrivateFoo Recording CD Track ProtectedFoo/]
,"tables");
#
# Classes
my @testd = (
- "" => [qw/Foo PrivateFoo Recording Track ProtectedFoo/],
+ "" => [qw/Foo PrivateFoo Recording CD Track ProtectedFoo/],
[qw/fooid name protectedname privatename/],
- "public" => [qw/Foo Recording Track/],
+ "public" => [qw/Foo Recording CD Track/],
[qw/fooid name /],
- "protected" => [qw/Foo Recording Track ProtectedFoo/],
+ "protected" => [qw/Foo Recording CD Track ProtectedFoo/],
[qw/fooid name protectedname/],
- "private" => [qw/Foo PrivateFoo Recording Track ProtectedFoo/],
+ "private" => [qw/Foo PrivateFoo Recording CD Track ProtectedFoo/],
[qw/fooid name protectedname privatename/],
);
while ( my ($vis,$tables,$foofields) = splice @testd,0,3 ) {
<?xml version = '1.0' encoding = 'UTF-8' ?>
-<XMI xmi.version = '1.2' xmlns:UML = 'org.omg.xmi.namespace.UML' timestamp = 'Tue Sep 09 00:09:56 BST 2003'>
+<XMI xmi.version = '1.2' xmlns:UML = 'org.omg.xmi.namespace.UML' timestamp = 'Tue Sep 09 02:47:05 BST 2003'>
<XMI.header>
<XMI.documentation>
<XMI.exporter>Netbeans XMI Writer</XMI.exporter>
<UML:MultiplicityRange xmi.id = '3b4b1e:f762a35f6b:-7f40' lower = '1' upper = '1'/>
</UML:Multiplicity.range>
</UML:Multiplicity>
- <UML:Model xmi.id = '3b4b1e:f762a35f6b:-7ff9' name = 'model 2' isSpecification = 'false'
+ <UML:Model xmi.id = '3b4b1e:f762a35f6b:-7ff9' name = 'PackageFoo' isSpecification = 'false'
isRoot = 'false' isLeaf = 'false' isAbstract = 'false'>
<UML:Namespace.ownedElement>
<UML:Class xmi.id = '3b4b1e:f762a35f6b:-7ff8' name = 'Foo' visibility = 'public'
isSpecification = 'false' isRoot = 'false' isLeaf = 'false' isAbstract = 'false'>
<UML:Stereotype.baseClass>Class</UML:Stereotype.baseClass>
</UML:Stereotype>
- <UML:Class xmi.id = '3b4b1e:f762a35f6b:-7fa8' name = 'NotMe' visibility = 'public'
- isSpecification = 'false' isRoot = 'false' isLeaf = 'false' isAbstract = 'false'
- isActive = 'false'>
- <UML:ModelElement.taggedValue>
- <UML:TaggedValue xmi.id = '3b4b1e:f762a35f6b:-7fa7' isSpecification = 'false'>
- <UML:TaggedValue.dataValue><p>
-No &lt;&lt;Table&gt;&gt; so the parser should ignore it.
-</p>
-</UML:TaggedValue.dataValue>
- <UML:TaggedValue.type>
- <UML:TagDefinition xmi.idref = '3b4b1e:f762a35f6b:-7fa6'/>
- </UML:TaggedValue.type>
- </UML:TaggedValue>
- </UML:ModelElement.taggedValue>
- </UML:Class>
<UML:Class xmi.id = '3b4b1e:f762a35f6b:-7f90' name = 'PrivateFoo' visibility = 'private'
isSpecification = 'false' isRoot = 'false' isLeaf = 'false' isAbstract = 'false'
isActive = 'false'>
<UML:Stereotype xmi.idref = '3b4b1e:f762a35f6b:-7fb6'/>
</UML:ModelElement.stereotype>
</UML:Class>
- <UML:Class xmi.id = '19e11a1:f7837163c4:-7ff5' name = 'arg1' visibility = 'public'
- isSpecification = 'false' isRoot = 'false' isLeaf = 'false' isAbstract = 'false'
- isActive = 'false'/>
- <UML:Class xmi.id = '19e11a1:f7837163c4:-7ff4' name = 'arg2' visibility = 'public'
- isSpecification = 'false' isRoot = 'false' isLeaf = 'false' isAbstract = 'false'
- isActive = 'false'/>
</UML:Namespace.ownedElement>
</UML:Model>
<UML:TagDefinition xmi.id = '3b4b1e:f762a35f6b:-7fa6' name = 'documentation'
projects / dbsrgits/SQL-Translator.git / commitdiff