[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Parser / XML / XMI.pm

package SQL::Translator::Parser::XML::XMI;

# -------------------------------------------------------------------
# $Id: XMI.pm,v 1.3 2003-09-08 17:10: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 - 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.3 $ =~ /(\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;

#
# 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.
#
# 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;
            }

			push @{$class->{attributes}}, $attr;
		}

		push @$classes, $class;
	}

	return $classes;
};

sub parse {
	eval {

    my ( $translator, $data ) = @_;
    local $DEBUG    = $translator->debug;
    my $schema      = $translator->schema;
    my $pargs       = $translator->parser_args;

    debug "Visibility Level:$pargs->{visibility}" if $DEBUG;

    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.

	#
    # 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: $class->{name}" if $DEBUG;
        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};

            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
#
#=============================================================================

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.

=head1 TODO

B<field sizes> Don't think UML does this directly so may need to include
it in the datatype names.

B<table_visibility and field_visibility args> Seperate control over what is 
parsed, setting visibility arg will set both.

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
Commit	Line	Data
1223c9b2	1	package SQL::Translator::Parser::XML::XMI;
	2
	3	# -------------------------------------------------------------------
f8ec05fa	4	# $Id: XMI.pm,v 1.3 2003-09-08 17:10:07 grommit Exp $
1223c9b2	5	# -------------------------------------------------------------------
	6	# Copyright (C) 2003 Mark Addison <mark.addison@itn.co.uk>,
	7	#
	8	# This program is free software; you can redistribute it and/or
	9	# modify it under the terms of the GNU General Public License as
	10	# published by the Free Software Foundation; version 2.
	11	#
	12	# This program is distributed in the hope that it will be useful, but
	13	# WITHOUT ANY WARRANTY; without even the implied warranty of
	14	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
	15	# General Public License for more details.
	16	#
	17	# You should have received a copy of the GNU General Public License
	18	# along with this program; if not, write to the Free Software
	19	# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
	20	# 02111-1307 USA
	21	# -------------------------------------------------------------------
	22
	23	=head1 NAME
	24
	25	SQL::Translator::Parser::XML::XMI - Parser to create Schema from UML
	26	Class diagrams stored in XMI format.
	27
f8ec05fa	28	=head1 SYNOPSIS
	29
	30	use SQL::Translator;
	31	use SQL::Translator::Parser::XML::XMI;
	32
	33	my $translator = SQL::Translator->new(
	34	from => 'XML-XMI',
	35	to => 'MySQL',
	36	filename => 'schema.xmi',
	37	show_warnings => 1,
	38	add_drop_table => 1,
	39	);
	40
	41	print $obj->translate;
	42
	43	=head1 DESCRIPTION
	44
	45	=head2 UML Data Modeling
	46
	47	To tell the parser which Classes are tables give them a <<Table>> stereotype.
	48
	49	Any attributes of the class will be used as fields. The datatype of the
	50	attribute must be a UML datatype and not an object, with the datatype's name
	51	being used to set the data_type value in the schema.
	52
	53	Primary keys are attributes marked with <<PK>> stereotype.
	54
	55	=head2 XMI Format
	56
	57	The parser has been built using XMI generated by PoseidonUML 2beta, which
	58	says it uses UML 2. So the current conformance is down to Poseidon's idea
	59	of XMI!
	60
	61	=head1 ARGS
	62
	63	=over 4
	64
	65	=item visibility
	66
	67	visibilty=public\|protected\|private
	68
	69	What visibilty of stuff to translate. e.g when set to 'public' any private
	70	and package Classes will be ignored and not turned into tables. Applies
	71	to Classes and Attributes.
	72
	73	If not set or false (the default) no checks will be made and everything is
	74	translated.
	75
	76	=back
	77
1223c9b2	78	=cut
	79
	80	# -------------------------------------------------------------------
	81
	82	use strict;
	83
	84	use vars qw[ $DEBUG $VERSION @EXPORT_OK ];
f8ec05fa	85	$VERSION = sprintf "%d.%02d", q$Revision: 1.3 $ =~ /(\d+)\.(\d+)/;
1223c9b2	86	$DEBUG = 0 unless defined $DEBUG;
	87
	88	use Data::Dumper;
	89	use Exporter;
	90	use base qw(Exporter);
	91	@EXPORT_OK = qw(parse);
	92
	93	use base qw/SQL::Translator::Parser/; # Doesnt do anything at the mo!
	94	use SQL::Translator::Utils 'debug';
	95	use XML::XPath;
	96	use XML::XPath::XMLParser;
	97
1223c9b2	98	#
f8ec05fa	99	# get_classes( XPATHOBJ, ARGS );
1223c9b2	100	#
f8ec05fa	101	# XPATHOBJ - An XML::XPath object setup and ready to use. You can also use any
f8ec05fa	102	# Node to search from as this sub just calls findnodes() on the arg.
ef2d7798	103	#
f8ec05fa	104	# ARGS - Name/Value list of args.
ef2d7798	105	#
f8ec05fa	106	# xpath => The xpath to use for finding classes. Default is //UML:Classes
f8ec05fa	107	# which will find all the classes in the XMI.
ef2d7798	108	#
f8ec05fa	109	# attribute_test => An XPath predicate (ie the bit between [] ) to test the
	110	# attributes with to decide if we should parse them. ie
	111	# attribute_test => '@name="foo"' would only pass out attribs
	112	# with a name of foo.
	113	#
	114	sub get_classes {
	115	my ($xp,%args) = @_;
	116	my $classes = [];
	117
	118	my $xpath = $args{xpath} \|\|= '//UML:Class'; # Default: all classes
	119	$xpath .= "[$args{class_test}]" if $args{class_test};
	120
	121	my @nodes = $xp->findnodes($xpath);
	122	return unless @nodes;
	123
	124	for my $classnode (@nodes) {
	125	my $class = {};
	126
	127	# <UML:Class> attributes
	128	foreach (
	129	qw/name visibility isSpecification
	130	isRoot isLeaf isAbstract isActive/
	131	) {
	132	$class->{$_} = $classnode->getAttribute($_);
	133	}
	134
	135	# Stereotype
	136	$class->{stereotype} = "".$classnode->find(
	137	'xmiDeref(UML:ModelElement.stereotype/UML:Stereotype)/@name');
	138
	139	#
	140	# Class Attributes
	141	#
	142	my $xpath = 'UML:Classifier.feature/UML:Attribute';
	143	$xpath .= "[$args{attribute_test}]" if $args{attribute_test};
	144	foreach my $attrnode ( $classnode->findnodes($xpath) ) {
	145	my $attr = {};
	146	# <UML:Attributes> attributes
	147	foreach (qw/name visibility isSpecification ownerScope/) {
	148	$attr->{$_} = $attrnode->getAttribute($_);
	149	}
	150
	151	$attr->{stereotype} = "".$attrnode->findvalue(
	152	'xmiDeref(UML:ModelElement.stereotype/UML:Stereotype)/@name');
	153
	154	$attr->{datatype} = "".$attrnode->find(
	155	'xmiDeref(UML:StructuralFeature.type/UML:DataType)/@name');
	156	if ( my @body = $attrnode->findnodes(
	157	'UML:Attribute.initialValue/UML:Expression/@body')
	158	) {
	159	$attr->{initialValue} = $body[0]->getData;
	160	}
ef2d7798	161
f8ec05fa	162	push @{$class->{attributes}}, $attr;
	163	}
	164
	165	push @$classes, $class;
	166	}
	167
	168	return $classes;
	169	};
ef2d7798	170
1223c9b2	171	sub parse {
f8ec05fa	172	eval {
f8ec05fa	173
1223c9b2	174	my ( $translator, $data ) = @_;
	175	local $DEBUG = $translator->debug;
	176	my $schema = $translator->schema;
ef2d7798	177	my $pargs = $translator->parser_args;
1223c9b2	178
ef2d7798	179	debug "Visibility Level:$pargs->{visibility}" if $DEBUG;
	180
	181	my $xp = XML::XPath->new(xml => $data);
1223c9b2	182	$xp->set_namespace("UML", "org.omg.xmi.namespace.UML");
	183	#
	184	# TODO
	185	# - Options to set the initial context node so we don't just
	186	# blindly do all the classes. e.g. Select a diag name to do.
ef2d7798	187
f8ec05fa	188	#
	189	# Build an XPath for the classes and attributes we want...
	190	#
	191	my @tests = ('@xmi.id'); # Only classes with an id so we don't get any
	192	# refs to classes ie xmi.idref classes
	193	push @tests, '@name'; # Only Classes with a name
	194	push @tests, "xmiVisible('$pargs->{visibility}')" if $pargs->{visibility};
	195	my $path = '//UML:Class['.join(' and ',@tests).']';
	196
	197	my $attrib_test = '@name';
	198	$attrib_test .= " and xmiVisible('$pargs->{visibility}')"
	199	if $pargs->{visibility};
	200
	201	# ...and parse them out
	202	debug "Searching for Classes using:$path";
	203	my $classes = get_classes( $xp,
	204	xpath => $path, attribute_test => $attrib_test);
	205
	206	debug "Found ".scalar(@$classes)." Classes: ".join(", ",
	207	map {$_->{"name"}} @$classes) if $DEBUG;
	208	debug "Classes:",Dumper($classes);
	209
	210	#
	211	# Turn the data from get_classes into a Schema
	212	#
	213	foreach my $class (@$classes) {
	214	next unless $class->{stereotype} eq "Table";
ef2d7798	215
1223c9b2	216	# Add the table
f8ec05fa	217	debug "Adding class: $class->{name}" if $DEBUG;
f8ec05fa	218	my $table = $schema->add_table( name => $class->{name} )
1223c9b2	219	or die "Schema Error: ".$schema->error;
	220
	221	#
	222	# Fields from Class attributes
	223	#
ef2d7798	224	# name data_type size default_value is_nullable
1223c9b2	225	# is_auto_increment is_primary_key is_foreign_key comments
1223c9b2	226	#
f8ec05fa	227	foreach my $attr ( @{$class->{attributes}} ) {
	228	my %data = (
	229	name => $attr->{name},
	230	data_type => $attr->{datatype},
	231	is_primary_key => $attr->{stereotype} eq "PK" ? 1 : 0,
1223c9b2	232	#is_foreign_key => $stereotype eq "FK" ? 1 : 0,
1223c9b2	233	);
f8ec05fa	234	$data{default_value} = $attr->{initialValue}
f8ec05fa	235	if exists $attr->{initialValue};
1223c9b2	236
	237	debug "Adding field:",Dumper(\%data);
	238	my $field = $table->add_field( %data ) or die $schema->error;
	239
	240	$table->primary_key( $field->name ) if $data{'is_primary_key'};
	241	#
	242	# TODO:
ef2d7798	243	# - We should be able to make the table obj spot this when
1223c9b2	244	# we use add_field.
	245	#
	246	}
	247
	248	} # Classes loop
	249
	250	return 1;
f8ec05fa	251
	252	};
	253	print "ERROR: $@\n" if $@;
	254	return 1;
1223c9b2	255	}
	256
	257	1;
	258
f8ec05fa	259	#=============================================================================
	260	#
	261	# XML::XPath extensions
	262	#
	263	#=============================================================================
1223c9b2	264
f8ec05fa	265	package XML::XPath::Function;
1223c9b2	266
f8ec05fa	267	=head1 XMI XPath Functions
1223c9b2	268
f8ec05fa	269	The Parser adds the following extra XPath functions.
1223c9b2	270
f8ec05fa	271	=head2 xmiDeref
1223c9b2	272
f8ec05fa	273	Deals with xmi.id/xmi.idref pairs of attributes. You give it an
	274	xPath e.g 'UML:ModelElement.stereotype/UML:stereotype' if the the
	275	tag it points at has an xmi.idref it looks up the tag with that
	276	xmi.id and returns it.
1223c9b2	277
f8ec05fa	278	If it doesn't have an xmi.id, the path is returned as normal.
1223c9b2	279
f8ec05fa	280	e.g. given
1223c9b2	281
f8ec05fa	282	<UML:ModelElement.stereotype>
	283	<UML:Stereotype xmi.idref = 'stTable'/>
	284	</UML:ModelElement.stereotype>
	285	...
	286	<UML:Stereotype xmi.id='stTable' name='Table' visibility='public'
	287	isAbstract='false' isSpecification='false' isRoot='false' isLeaf='false'>
	288	<UML:Stereotype.baseClass>Class</UML:Stereotype.baseClass>
	289	</UML:Stereotype>
1223c9b2	290
f8ec05fa	291	Using xmideref(//UML:ModelElement.stereotype/UML:stereotype) would return the
f8ec05fa	292	<UML:Stereotype xmi.id = '3b4b1e:f762a35f6b:-7fb6' ...> tag.
1223c9b2	293
f8ec05fa	294	Using xmideref(//UML:ModelElement.stereotype/UML:stereotype)/@name would give
f8ec05fa	295	"Table".
1223c9b2	296
f8ec05fa	297	=head xmiVisible
1223c9b2	298
f8ec05fa	299	is_visible( VISLEVEL )
1223c9b2	300
f8ec05fa	301	Returns true or false for whether the visibility of something e.g. a Class or
f8ec05fa	302	Attribute, is visible at the level given. e.g.
1223c9b2	303
f8ec05fa	304	//UML:Class[xmiVisible('public')] - Find all public classes
f8ec05fa	305	//UML:Class[xmiVisible('protected')] - Find all public and protected classes
1223c9b2	306
f8ec05fa	307	Supports the 3 UML visibility levels of public, protected and private.
1223c9b2	308
f8ec05fa	309	Note: Currently any element tested that doesn't have a visibility="" attribute
	310	is assumed to be visible and so xmiVisible will return true. This is probably
	311	the wrong thing to do and is very likley to change. It is probably best to
	312	throw an error if we try to test something that doesn't do visibility.
1223c9b2	313
f8ec05fa	314	=cut
1223c9b2	315
f8ec05fa	316	sub xmiDeref {
	317	my $self = shift;
	318	my ($node, @params) = @_;
	319	if (@params > 1) {
	320	die "xmiDeref() function takes one or no parameters\n";
	321	}
	322	elsif (@params) {
	323	my $nodeset = shift(@params);
	324	return $nodeset unless $nodeset->size;
	325	$node = $nodeset->get_node(1);
	326	}
	327	die "xmiDeref() needs an Element node."
	328	unless $node->isa("XML::XPath::Node::Element");
1223c9b2	329
f8ec05fa	330	my $id = $node->getAttribute("xmi.idref") or return $node;
	331	return $node->getRootNode->find('//*[@xmi.id="'.$id.'"]');
	332	}
	333
	334	{
	335	my %vislevel = (
	336	public => 1,
	337	protected => 2,
	338	private => 3,
	339	);
	340
	341	sub xmiVisible {
	342	my $self = shift;
	343	my ($node, @params) = @_;
	344	if (@params < 1 or @params > 2) {
	345	die "xmiVisible() function takes 1 or 2 parameters\n";
	346	}
	347	elsif (@params == 2) {
	348	my $nodeset = shift(@params);
	349	return unless $nodeset->size;
	350	$node = $nodeset->get_node(1);
	351	}
	352	die "xmiVisible() needs an Element node."
	353	unless $node->isa("XML::XPath::Node::Element");
	354
	355	my $vis = shift(@params) \|\| return XML::XPath::Boolean->True;
	356	my $nodevis = $node->getAttribute("visibility")
	357	\|\| return XML::XPath::Boolean->True;
	358	return XML::XPath::Boolean->True
	359	if $vislevel{$vis} >= $vislevel{$nodevis};
	360	return XML::XPath::Boolean->False;
	361	}
	362	}
	363
	364	# Test of custom xpath function.
	365	sub hello {
	366	return XML::XPath::Literal->new("Hello World");
	367	}
	368
	369	#=============================================================================
	370	package main;
	371
	372
	373	=pod
1223c9b2	374
	375	=head1 BUGS
	376
ef2d7798	377	Seems to be slow. I think this is because the XMI files can get pretty
	378	big and complex, especially all the diagram info.
	379
1223c9b2	380	=head1 TODO
1223c9b2	381
ef2d7798	382	B<field sizes> Don't think UML does this directly so may need to include
1223c9b2	383	it in the datatype names.
1223c9b2	384
ef2d7798	385	B<table_visibility and field_visibility args> Seperate control over what is
	386	parsed, setting visibility arg will set both.
	387
1223c9b2	388	Everything else! Relations, fkeys, constraints, indexes, etc...
	389
	390	=head1 AUTHOR
	391
	392	Mark D. Addison E<lt>mark.addison@itn.co.ukE<gt>.
	393
	394	=head1 SEE ALSO
	395
	396	perl(1), SQL::Translator, XML::XPath, SQL::Translator::Producer::XML::SQLFairy,
	397	SQL::Translator::Schema.
	398
	399	=cut
f8ec05fa	400
f8ec05fa	401