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

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

# -------------------------------------------------------------------
# $Id: XMI.pm,v 1.4 2003-09-09 01:00:44 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.4 $ =~ /(\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;

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

# _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
		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;
    }
    return wantarray ? @$attributes : $attributes;
}


# SQLFairy Parser
#-----------------------------------------------------------------------------

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

    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	# -------------------------------------------------------------------
91ed9c32	4	# $Id: XMI.pm,v 1.4 2003-09-09 01:00:44 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 ];
91ed9c32	85	$VERSION = sprintf "%d.%02d", q$Revision: 1.4 $ =~ /(\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
91ed9c32	98	# XMI XPath parsing
	99	#-----------------------------------------------------------------------------
	100
1223c9b2	101	#
f8ec05fa	102	# get_classes( XPATHOBJ, ARGS );
1223c9b2	103	#
f8ec05fa	104	# XPATHOBJ - An XML::XPath object setup and ready to use. You can also use any
f8ec05fa	105	# Node to search from as this sub just calls findnodes() on the arg.
ef2d7798	106	#
f8ec05fa	107	# ARGS - Name/Value list of args.
ef2d7798	108	#
f8ec05fa	109	# xpath => The xpath to use for finding classes. Default is //UML:Classes
f8ec05fa	110	# which will find all the classes in the XMI.
ef2d7798	111	#
91ed9c32	112	# test => An XPath predicate (ie the bit between [] ) to test the
	113	# classes with to decide if we should parse them. ie
	114	# test => '@name' would only pass out classes with a name.
	115	# Can also give it an array ref and it will and the tests.
	116	# It gets tacked onto to xpath so don't put any [] on
	117	# xpath if you use test as well.
	118	#
	119	# attribute_test => An XPath predicate to pass onto get_attributes.
f8ec05fa	120	#
91ed9c32	121
	122	# _add_xpath_tests $path, [qw/@name xmiVisible("public")/]; # and
	123	# _add_xpath_tests $path, [qw/@name xmiVisible("public")/], "or";
	124	sub _add_xpath_tests {
	125	my ($path,$tests,$join) = @_;
	126	return $path unless defined $tests;
	127	my @tests = ref($tests) ? @$tests : $tests;
	128	return $path unless @tests;
	129	$join \|\|= "and";
	130	return $path."[".join(" $join ", @tests)."]";
	131	}
	132
	133	sub get_stereotype {
	134	my ($xp) = @_;
	135	return "".$xp->findvalue(
	136	'xmiDeref(UML:ModelElement.stereotype/UML:Stereotype)/@name');
	137	# TODO Test for difference between it existing or being "" ?
	138	}
	139
f8ec05fa	140	sub get_classes {
f8ec05fa	141	my ($xp,%args) = @_;
91ed9c32	142	my $classes;
f8ec05fa	143
f8ec05fa	144	my $xpath = $args{xpath} \|\|= '//UML:Class'; # Default: all classes
91ed9c32	145	$xpath = _add_xpath_tests $xpath, $args{test};
91ed9c32	146	debug "Searching for Classes using:$xpath";
f8ec05fa	147
	148	my @nodes = $xp->findnodes($xpath);
	149	return unless @nodes;
	150
	151	for my $classnode (@nodes) {
	152	my $class = {};
91ed9c32	153
91ed9c32	154	foreach (
f8ec05fa	155	qw/name visibility isSpecification
	156	isRoot isLeaf isAbstract isActive/
	157	) {
	158	$class->{$_} = $classnode->getAttribute($_);
	159	}
91ed9c32	160	$class->{stereotype} = get_stereotype($classnode);
f8ec05fa	161
f8ec05fa	162	# Class Attributes
f8ec05fa	163	my $xpath = 'UML:Classifier.feature/UML:Attribute';
91ed9c32	164	$class->{attributes} = get_attributes( $classnode,
	165	xpath => $xpath, test => $args{attribute_test} );
	166
f8ec05fa	167	push @$classes, $class;
f8ec05fa	168	}
91ed9c32	169	return wantarray ? @$classes : $classes;
f8ec05fa	170	};
ef2d7798	171
91ed9c32	172	sub get_attributes {
	173	my ($xp, %args) = @_;
	174
	175	my $xpath = $args{xpath} \|\|= '//UML:Classifier.feature/UML:Attribute';
	176	$xpath = _add_xpath_tests $xpath, $args{test};
	177	debug "Searching for Attributes using:$xpath";
	178
	179	my $attributes;
	180	foreach my $node ( $xp->findnodes($xpath) ) {
	181	my $attr = {};
	182
	183	foreach (qw/name visibility isSpecification ownerScope/) {
	184	$attr->{$_} = $node->getAttribute($_);
	185	}
	186	$attr->{stereotype} = get_stereotype($node);
	187
	188	# Get datatype name and the name body of the initial value
	189	$attr->{datatype} = "".$node->find(
	190	'xmiDeref(UML:StructuralFeature.type/UML:DataType)/@name');
	191	if ( my @body = $node->findnodes(
	192	'UML:Attribute.initialValue/UML:Expression/@body')
	193	) {
	194	$attr->{initialValue} = $body[0]->getData;
	195	}
	196
	197	push @$attributes, $attr;
	198	}
	199	return wantarray ? @$attributes : $attributes;
	200	}
	201
	202
	203
	204	# SQLFairy Parser
	205	#-----------------------------------------------------------------------------
	206
1223c9b2	207	sub parse {
f8ec05fa	208	eval {
f8ec05fa	209
1223c9b2	210	my ( $translator, $data ) = @_;
	211	local $DEBUG = $translator->debug;
	212	my $schema = $translator->schema;
ef2d7798	213	my $pargs = $translator->parser_args;
1223c9b2	214
ef2d7798	215	debug "Visibility Level:$pargs->{visibility}" if $DEBUG;
	216
	217	my $xp = XML::XPath->new(xml => $data);
1223c9b2	218	$xp->set_namespace("UML", "org.omg.xmi.namespace.UML");
	219	#
	220	# TODO
	221	# - Options to set the initial context node so we don't just
	222	# blindly do all the classes. e.g. Select a diag name to do.
ef2d7798	223
f8ec05fa	224	#
	225	# Build an XPath for the classes and attributes we want...
	226	#
91ed9c32	227	# Only classes with an id (so we don't get any refs to classes ie
	228	# xmi.idref classes). They also need a name to be usefull.
	229	my @tests = ('@xmi.id and @name');
f8ec05fa	230	push @tests, "xmiVisible('$pargs->{visibility}')" if $pargs->{visibility};
f8ec05fa	231
91ed9c32	232	my $attrib_test = '@name and @xmi.id';
f8ec05fa	233	$attrib_test .= " and xmiVisible('$pargs->{visibility}')"
	234	if $pargs->{visibility};
	235
	236	# ...and parse them out
f8ec05fa	237	my $classes = get_classes( $xp,
91ed9c32	238	xpath => "//UML:Class", test => [@tests], attribute_test => $attrib_test);
f8ec05fa	239
	240	debug "Found ".scalar(@$classes)." Classes: ".join(", ",
	241	map {$_->{"name"}} @$classes) if $DEBUG;
	242	debug "Classes:",Dumper($classes);
	243
	244	#
	245	# Turn the data from get_classes into a Schema
	246	#
	247	foreach my $class (@$classes) {
	248	next unless $class->{stereotype} eq "Table";
ef2d7798	249
1223c9b2	250	# Add the table
f8ec05fa	251	debug "Adding class: $class->{name}" if $DEBUG;
f8ec05fa	252	my $table = $schema->add_table( name => $class->{name} )
1223c9b2	253	or die "Schema Error: ".$schema->error;
	254
	255	#
	256	# Fields from Class attributes
	257	#
ef2d7798	258	# name data_type size default_value is_nullable
1223c9b2	259	# is_auto_increment is_primary_key is_foreign_key comments
1223c9b2	260	#
f8ec05fa	261	foreach my $attr ( @{$class->{attributes}} ) {
	262	my %data = (
	263	name => $attr->{name},
	264	data_type => $attr->{datatype},
	265	is_primary_key => $attr->{stereotype} eq "PK" ? 1 : 0,
1223c9b2	266	#is_foreign_key => $stereotype eq "FK" ? 1 : 0,
1223c9b2	267	);
f8ec05fa	268	$data{default_value} = $attr->{initialValue}
f8ec05fa	269	if exists $attr->{initialValue};
1223c9b2	270
	271	debug "Adding field:",Dumper(\%data);
	272	my $field = $table->add_field( %data ) or die $schema->error;
	273
	274	$table->primary_key( $field->name ) if $data{'is_primary_key'};
	275	#
	276	# TODO:
ef2d7798	277	# - We should be able to make the table obj spot this when
1223c9b2	278	# we use add_field.
	279	#
	280	}
	281
	282	} # Classes loop
	283
	284	return 1;
f8ec05fa	285
	286	};
	287	print "ERROR: $@\n" if $@;
	288	return 1;
1223c9b2	289	}
	290
	291	1;
	292
f8ec05fa	293	#=============================================================================
	294	#
	295	# XML::XPath extensions
	296	#
	297	#=============================================================================
1223c9b2	298
f8ec05fa	299	package XML::XPath::Function;
1223c9b2	300
f8ec05fa	301	=head1 XMI XPath Functions
1223c9b2	302
f8ec05fa	303	The Parser adds the following extra XPath functions.
1223c9b2	304
f8ec05fa	305	=head2 xmiDeref
1223c9b2	306
f8ec05fa	307	Deals with xmi.id/xmi.idref pairs of attributes. You give it an
	308	xPath e.g 'UML:ModelElement.stereotype/UML:stereotype' if the the
	309	tag it points at has an xmi.idref it looks up the tag with that
	310	xmi.id and returns it.
1223c9b2	311
f8ec05fa	312	If it doesn't have an xmi.id, the path is returned as normal.
1223c9b2	313
f8ec05fa	314	e.g. given
1223c9b2	315
f8ec05fa	316	<UML:ModelElement.stereotype>
	317	<UML:Stereotype xmi.idref = 'stTable'/>
	318	</UML:ModelElement.stereotype>
	319	...
	320	<UML:Stereotype xmi.id='stTable' name='Table' visibility='public'
	321	isAbstract='false' isSpecification='false' isRoot='false' isLeaf='false'>
	322	<UML:Stereotype.baseClass>Class</UML:Stereotype.baseClass>
	323	</UML:Stereotype>
1223c9b2	324
f8ec05fa	325	Using xmideref(//UML:ModelElement.stereotype/UML:stereotype) would return the
f8ec05fa	326	<UML:Stereotype xmi.id = '3b4b1e:f762a35f6b:-7fb6' ...> tag.
1223c9b2	327
f8ec05fa	328	Using xmideref(//UML:ModelElement.stereotype/UML:stereotype)/@name would give
f8ec05fa	329	"Table".
1223c9b2	330
f8ec05fa	331	=head xmiVisible
1223c9b2	332
f8ec05fa	333	is_visible( VISLEVEL )
1223c9b2	334
f8ec05fa	335	Returns true or false for whether the visibility of something e.g. a Class or
f8ec05fa	336	Attribute, is visible at the level given. e.g.
1223c9b2	337
f8ec05fa	338	//UML:Class[xmiVisible('public')] - Find all public classes
f8ec05fa	339	//UML:Class[xmiVisible('protected')] - Find all public and protected classes
1223c9b2	340
f8ec05fa	341	Supports the 3 UML visibility levels of public, protected and private.
1223c9b2	342
f8ec05fa	343	Note: Currently any element tested that doesn't have a visibility="" attribute
	344	is assumed to be visible and so xmiVisible will return true. This is probably
	345	the wrong thing to do and is very likley to change. It is probably best to
	346	throw an error if we try to test something that doesn't do visibility.
1223c9b2	347
f8ec05fa	348	=cut
1223c9b2	349
f8ec05fa	350	sub xmiDeref {
	351	my $self = shift;
	352	my ($node, @params) = @_;
	353	if (@params > 1) {
	354	die "xmiDeref() function takes one or no parameters\n";
	355	}
	356	elsif (@params) {
	357	my $nodeset = shift(@params);
	358	return $nodeset unless $nodeset->size;
	359	$node = $nodeset->get_node(1);
	360	}
	361	die "xmiDeref() needs an Element node."
	362	unless $node->isa("XML::XPath::Node::Element");
1223c9b2	363
f8ec05fa	364	my $id = $node->getAttribute("xmi.idref") or return $node;
	365	return $node->getRootNode->find('//*[@xmi.id="'.$id.'"]');
	366	}
	367
	368	{
	369	my %vislevel = (
	370	public => 1,
	371	protected => 2,
	372	private => 3,
	373	);
	374
	375	sub xmiVisible {
	376	my $self = shift;
	377	my ($node, @params) = @_;
	378	if (@params < 1 or @params > 2) {
	379	die "xmiVisible() function takes 1 or 2 parameters\n";
	380	}
	381	elsif (@params == 2) {
	382	my $nodeset = shift(@params);
	383	return unless $nodeset->size;
	384	$node = $nodeset->get_node(1);
	385	}
	386	die "xmiVisible() needs an Element node."
	387	unless $node->isa("XML::XPath::Node::Element");
	388
	389	my $vis = shift(@params) \|\| return XML::XPath::Boolean->True;
	390	my $nodevis = $node->getAttribute("visibility")
	391	\|\| return XML::XPath::Boolean->True;
	392	return XML::XPath::Boolean->True
	393	if $vislevel{$vis} >= $vislevel{$nodevis};
	394	return XML::XPath::Boolean->False;
	395	}
	396	}
	397
	398	# Test of custom xpath function.
	399	sub hello {
	400	return XML::XPath::Literal->new("Hello World");
	401	}
	402
	403	#=============================================================================
	404	package main;
	405
	406
	407	=pod
1223c9b2	408
	409	=head1 BUGS
	410
ef2d7798	411	Seems to be slow. I think this is because the XMI files can get pretty
	412	big and complex, especially all the diagram info.
	413
1223c9b2	414	=head1 TODO
1223c9b2	415
ef2d7798	416	B<field sizes> Don't think UML does this directly so may need to include
1223c9b2	417	it in the datatype names.
1223c9b2	418
ef2d7798	419	B<table_visibility and field_visibility args> Seperate control over what is
	420	parsed, setting visibility arg will set both.
	421
1223c9b2	422	Everything else! Relations, fkeys, constraints, indexes, etc...
	423
	424	=head1 AUTHOR
	425
	426	Mark D. Addison E<lt>mark.addison@itn.co.ukE<gt>.
	427
	428	=head1 SEE ALSO
	429
	430	perl(1), SQL::Translator, XML::XPath, SQL::Translator::Producer::XML::SQLFairy,
	431	SQL::Translator::Schema.
	432
	433	=cut
f8ec05fa	434
f8ec05fa	435