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

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

# -------------------------------------------------------------------
# $Id$
# -------------------------------------------------------------------
# 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
# -------------------------------------------------------------------

=pod

=head1 NAME

SQL::Translator::XMI::Parser - XMI Parser class for use in SQL Fairy's XMI 
parser.

=cut

use strict;
use 5.006_001;

use Data::Dumper;
use XML::XPath;
use XML::XPath::XMLParser;
use Storable qw/dclone/;

# Spec
#------
# See SQL::Translator::XMI::Parser::V12 and SQL::Translator::XMI::Parser:V10
# for examples.
#
# Hash ref used to describe 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.
#
# TODO
# 
# * 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.
#
#
# XmiSpec( $spec )
#
# Call as class method to set up the parser from a spec (see above). This
# generates the get_ methods for the version of XMI the spec is for. Called by
# the sub-classes (e.g. V12 and V10) to create parsers for each version.
#
sub XmiSpec {
	my ($me,$spec) = @_;
	_init_specs($spec);
	$me->_mk_gets($spec);
}

# Build lookups etc. Its important that each spec item becomes self contained
# so we can build good closures, therefore we do all the lookups 1st.
sub _init_specs {
	my $specs = shift;

	foreach my $spec ( values %$specs ) {
		# Look up for kids get method
		foreach ( @{$spec->{kids}} ) {
            $_->{get_method} = "get_".$specs->{$_->{class}}{plural};
        }

		# Add xmi.id ti all specs. Everything we want at the moment (in both
		# versions) has an id. The tags that don't seem to be used for
		# structure.
		my $attrib_data = $spec->{attrib_data} ||= [];
		push @$attrib_data, "xmi.id";
	}

}

# Create get methods from spec
#
sub _mk_gets {
    my ($proto,$specs) = @_;
    my $class = ref($proto) || $proto;
    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($_);

		# Create _get_* method with get_* as an alias unless the user has
		# defined it. Allows for override. Note the alias is in this package
		# so we can add overrides to both specs.
		no strict "refs";
		my $meth = "_get_$spec->{plural}";
		*{$meth} = _mk_get($spec);
		*{__PACKAGE__."::get_$spec->{plural}"} = sub {shift->$meth(@_);}
		 	unless $class->can("get_$spec->{plural}");
    }
}

#
# Sets up the XML::XPath object and then checks the version of the XMI file and
# blesses its self into either the V10 or V12 class.
#
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 return as that sub class 
	my $xmiv = $args{xmi_version}
	    || "".$xp->findvalue('/XMI/@xmi.version')
        || die "Can't find XMI version";
	$xmiv =~ s/[.]//g;
	$class = __PACKAGE__."::V$xmiv";
	eval "use $class;";
	die "Failed to load version sub class $class : $@" if $@;

	return bless $me, $class;
}

#
# _mk_get
#
# Generates and returns a get_ sub for the spec given.
# So, if you want to change how the get methods (e.g. get_classes) 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.
#
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);
#warn "None.\n" unless @nodes;
	return unless @nodes;

	for my $node (@nodes) {
#warn "    Found $spec->{name} xmi.id=".$node->getAttribute("xmi.id")." name=".$node->getAttribute("name")."\n";
		my $thing = {};
        # my $thing = { xpNode => $node };

		# Have we seen this before? If so just use the ref we have.
        if ( my $id = $node->getAttribute("xmi.id") ) {
            if ( my $foo = $me->{model}{things}{$id} ) {
#warn "    Reffing from model **********************\n";
                push @$things, $foo; 
				next;
			}
        }

		# Get the Tag attributes
#warn "    getting attribs: ",join(" ",@{$spec->{attrib_data}}),"\n";
        foreach ( @{$spec->{attrib_data}} ) {
			$thing->{$_} = $node->getAttribute($_);
		}
#warn "    got attribs: ",(map "$_=$thing->{$_}", keys %$thing),"\n";

        # Add the path data
        foreach ( @{$spec->{path_data}} ) {
#warn "    getting path data $_->{name} : $_->{path}\n";
            my @nodes = $node->findnodes($_->{path});
            $thing->{$_->{name}} = @nodes ? $nodes[0]->getData
                : (exists $_->{default} ? $_->{default} : undef);
#warn "    got path data $_->{name}=$thing->{$_->{name}}\n";
        }

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

        # Add anything with an id to the things lookup
        push @$things, $thing;
		if ( exists $thing->{"xmi.id"} and defined $thing->{"xmi.id"}
            and my $id = $thing->{"xmi.id"} 
        ) {
			$me->{model}{things}{$id} = $thing; }

        # Kids
        #
        foreach ( @{$spec->{kids}} ) {
			my $data;
            my $meth = $_->{get_method};
            my $path = $_->{path};

			# Variable subs on the path from thing
			$path =~ s/\$\{(.*?)\}/$thing->{$1}/g;
			$data = $me->$meth( _context => $node, _xpath => $path,
                filter => $args{"filter_$_->{name}"} );
            if ( $_->{multiplicity} eq "1" ) {
                $thing->{$_->{name}} = shift @$data;
            }
            else {
                my $kids = $thing->{$_->{name}} = $data || [];
				if ( my $key = $_->{"map"} ) {
					$thing->{"_map_$_->{name}"} = _mk_map($kids,$key);
				}
            }
        }
	}

	if ( $spec->{isRoot} ) {
		push(@{$me->{model}{$spec->{plural}}}, $_) foreach @$things;
	}
	return $things;
} # /closure sub

} # /_mk_get

sub _mk_map {
	my ($kids,$key) = @_;
	my $map = {};
	foreach (@$kids) {
		$map->{$_->{$key}} = $_ if exists $_->{$key};
	}
	return $map;
}

sub get_associations {
	my $assoc = shift->_get_associations(@_);
	foreach (@$assoc) {
		next unless defined $_->{associationEnds}; # Wait until we get all of an association
		my @ends = @{$_->{associationEnds}};
		if (@ends != 2) {
			warn "Sorry can't handle otherEnd associations with more than 2 ends"; 
			return $assoc;
		}
		$ends[0]{otherEnd} = $ends[1];
		$ends[1]{otherEnd} = $ends[0];
	}
	return $assoc;
}

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) = @_;
    my $nodeset;
    if (@params > 1) {
        die "xmiDeref() function takes one or no parameters\n";
    }
    elsif (@params) {
        $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") || return ($nodeset || $node);
    return $node->getRootNode->find('//*[@xmi.id="'.$id.'"]');
    # TODO We should use the tag name to search from the source 
}


# 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 C<filename>, C<xml> or C<ioref> for the XMI
data you want to parse.

The version of XMI to use either 1.0 or 1.2 is worked out from the file. You
can also use a C<xmi_version> arg to set it explicitley.

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

=cut
Commit	Line	Data
f42065cb	1	package SQL::Translator::XMI::Parser;
f42065cb	2
93f4a354	3	# -------------------------------------------------------------------
821a0fde	4	# $Id$
93f4a354	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
f42065cb	23	=pod
	24
	25	=head1 NAME
	26
93f4a354	27	SQL::Translator::XMI::Parser - XMI Parser class for use in SQL Fairy's XMI
93f4a354	28	parser.
f42065cb	29
	30	=cut
	31
	32	use strict;
	33	use 5.006_001;
f42065cb	34
93f4a354	35	use Data::Dumper;
f42065cb	36	use XML::XPath;
	37	use XML::XPath::XMLParser;
	38	use Storable qw/dclone/;
	39
	40	# Spec
93f4a354	41	#------
	42	# See SQL::Translator::XMI::Parser::V12 and SQL::Translator::XMI::Parser:V10
	43	# for examples.
f42065cb	44	#
93f4a354	45	# Hash ref used to describe the 2 xmi formats 1.2 and 1.0. Neither is complete!
f42065cb	46	#
	47	# NB The names of the data keys MUST be the same for both specs so the
	48	# data structures returned are the same.
	49	#
93f4a354	50	# TODO
	51	#
	52	# * There is currently no way to set the data key name for attrib_data, it just
f42065cb	53	# uses the attribute name from the XMI. This isn't a problem at the moment as
	54	# xmi1.0 names all these things with tags so we don't need the attrib data!
	55	# Also use of names seems to be consistant between the versions.
	56	#
f42065cb	57	#
93f4a354	58	# XmiSpec( $spec )
f42065cb	59	#
93f4a354	60	# Call as class method to set up the parser from a spec (see above). This
	61	# generates the get_ methods for the version of XMI the spec is for. Called by
	62	# the sub-classes (e.g. V12 and V10) to create parsers for each version.
f42065cb	63	#
93f4a354	64	sub XmiSpec {
93f4a354	65	my ($me,$spec) = @_;
42b5b9b6	66	_init_specs($spec);
42b5b9b6	67	$me->_mk_gets($spec);
93f4a354	68	}
f42065cb	69
f42065cb	70	# Build lookups etc. Its important that each spec item becomes self contained
b4b9f867	71	# so we can build good closures, therefore we do all the lookups 1st.
42b5b9b6	72	sub _init_specs {
f42065cb	73	my $specs = shift;
	74
	75	foreach my $spec ( values %$specs ) {
b4b9f867	76	# Look up for kids get method
b4b9f867	77	foreach ( @{$spec->{kids}} ) {
f42065cb	78	$_->{get_method} = "get_".$specs->{$_->{class}}{plural};
f42065cb	79	}
0b3f94e0	80
b4b9f867	81	# Add xmi.id ti all specs. Everything we want at the moment (in both
	82	# versions) has an id. The tags that don't seem to be used for
	83	# structure.
	84	my $attrib_data = $spec->{attrib_data} \|\|= [];
	85	push @$attrib_data, "xmi.id";
f42065cb	86	}
	87
	88	}
	89
93f4a354	90	# Create get methods from spec
93f4a354	91	#
42b5b9b6	92	sub _mk_gets {
93f4a354	93	my ($proto,$specs) = @_;
	94	my $class = ref($proto) \|\| $proto;
	95	foreach ( values %$specs ) {
	96	# Clone from specs and sort out the lookups into it so we get a
	97	# self contained spec to use as a proper closure.
	98	my $spec = dclone($_);
	99
	100	# Create _get_* method with get_* as an alias unless the user has
	101	# defined it. Allows for override. Note the alias is in this package
	102	# so we can add overrides to both specs.
	103	no strict "refs";
	104	my $meth = "_get_$spec->{plural}";
42b5b9b6	105	*{$meth} = _mk_get($spec);
93f4a354	106	*{__PACKAGE__."::get_$spec->{plural}"} = sub {shift->$meth(@_);}
93f4a354	107	unless $class->can("get_$spec->{plural}");
f42065cb	108	}
	109	}
	110
93f4a354	111	#
	112	# Sets up the XML::XPath object and then checks the version of the XMI file and
	113	# blesses its self into either the V10 or V12 class.
	114	#
f42065cb	115	sub new {
	116	my $proto = shift;
	117	my $class = ref($proto) \|\| $proto;
	118	my %args = @_;
	119	my $me = {};
93f4a354	120
f42065cb	121	# Create the XML::XPath object
	122	# TODO Docs recommend we only use 1 XPath object per application
	123	my $xp;
	124	foreach (qw/filename xml ioref/) {
	125	if ($args{$_}) {
	126	$xp = XML::XPath->new( $_ => $args{$_});
	127	$xp->set_namespace("UML", "org.omg.xmi.namespace.UML");
	128	last;
	129	}
	130	}
	131	$me = { xml_xpath => $xp };
93f4a354	132
	133	# Work out the version of XMI we have and return as that sub class
	134	my $xmiv = $args{xmi_version}
b4b9f867	135	\|\| "".$xp->findvalue('/XMI/@xmi.version')
b4b9f867	136	\|\| die "Can't find XMI version";
93f4a354	137	$xmiv =~ s/[.]//g;
	138	$class = __PACKAGE__."::V$xmiv";
	139	eval "use $class;";
	140	die "Failed to load version sub class $class : $@" if $@;
f42065cb	141
93f4a354	142	return bless $me, $class;
f42065cb	143	}
f42065cb	144
93f4a354	145	#
42b5b9b6	146	# _mk_get
f42065cb	147	#
93f4a354	148	# Generates and returns a get_ sub for the spec given.
	149	# So, if you want to change how the get methods (e.g. get_classes) work do it
	150	# here!
f42065cb	151	#
	152	# The get methods made have the args described in the docs and 2 private args
	153	# used internally, to call other get methods from paths in the spec.
f42065cb	154	# NB: DO NOT use publicly as you will break the version independance. e.g. When
	155	# using _xpath you need to know which version of XMI to use. This is handled by
	156	# the use of different paths in the specs.
b2a00f50	157	#
f42065cb	158	# _context => The context node to use, if not given starts from root.
b2a00f50	159	#
f42065cb	160	# _xpath => The xpath to use for finding stuff.
b2a00f50	161	#
42b5b9b6	162	sub _mk_get {
f42065cb	163	my $spec = shift;
b2a00f50	164
f42065cb	165	# get_* closure using $spec
	166	return sub {
	167	my ($me, %args) = @_;
	168	my $xp = delete $args{_context} \|\| $me->{xml_xpath};
	169	my $things;
	170
	171	my $xpath = $args{_xpath} \|\|= $spec->{default_path};
	172	#warn "Searching for $spec->{plural} using:$xpath\n";
	173
	174	my @nodes = $xp->findnodes($xpath);
0b3f94e0	175	#warn "None.\n" unless @nodes;
f42065cb	176	return unless @nodes;
	177
	178	for my $node (@nodes) {
0b3f94e0	179	#warn " Found $spec->{name} xmi.id=".$node->getAttribute("xmi.id")." name=".$node->getAttribute("name")."\n";
f42065cb	180	my $thing = {};
f42065cb	181	# my $thing = { xpNode => $node };
b2a00f50	182
0b3f94e0	183	# Have we seen this before? If so just use the ref we have.
	184	if ( my $id = $node->getAttribute("xmi.id") ) {
	185	if ( my $foo = $me->{model}{things}{$id} ) {
	186	#warn " Reffing from model **********************\n";
	187	push @$things, $foo;
	188	next;
	189	}
	190	}
	191
f42065cb	192	# Get the Tag attributes
6e694599	193	#warn " getting attribs: ",join(" ",@{$spec->{attrib_data}}),"\n";
f42065cb	194	foreach ( @{$spec->{attrib_data}} ) {
	195	$thing->{$_} = $node->getAttribute($_);
	196	}
6e694599	197	#warn " got attribs: ",(map "$_=$thing->{$_}", keys %$thing),"\n";
b2a00f50	198
f42065cb	199	# Add the path data
f42065cb	200	foreach ( @{$spec->{path_data}} ) {
6e694599	201	#warn " getting path data $_->{name} : $_->{path}\n";
f42065cb	202	my @nodes = $node->findnodes($_->{path});
	203	$thing->{$_->{name}} = @nodes ? $nodes[0]->getData
	204	: (exists $_->{default} ? $_->{default} : undef);
6e694599	205	#warn " got path data $_->{name}=$thing->{$_->{name}}\n";
f42065cb	206	}
b2a00f50	207
	208	# Run any filters set
	209	#
f42065cb	210	# Should we do this after the kids as we may want to test them?
	211	# e.g. test for number of attribs
	212	if ( my $filter = $args{filter} ) {
	213	local $_ = $thing;
	214	next unless $filter->($thing);
	215	}
b2a00f50	216
0b3f94e0	217	# Add anything with an id to the things lookup
	218	push @$things, $thing;
	219	if ( exists $thing->{"xmi.id"} and defined $thing->{"xmi.id"}
	220	and my $id = $thing->{"xmi.id"}
	221	) {
	222	$me->{model}{things}{$id} = $thing; }
	223
f42065cb	224	# Kids
	225	#
	226	foreach ( @{$spec->{kids}} ) {
b2a00f50	227	my $data;
f42065cb	228	my $meth = $_->{get_method};
b2a00f50	229	my $path = $_->{path};
0b3f94e0	230
	231	# Variable subs on the path from thing
	232	$path =~ s/\$\{(.*?)\}/$thing->{$1}/g;
b2a00f50	233	$data = $me->$meth( _context => $node, _xpath => $path,
f42065cb	234	filter => $args{"filter_$_->{name}"} );
f42065cb	235	if ( $_->{multiplicity} eq "1" ) {
	236	$thing->{$_->{name}} = shift @$data;
	237	}
	238	else {
b2a00f50	239	my $kids = $thing->{$_->{name}} = $data \|\| [];
	240	if ( my $key = $_->{"map"} ) {
	241	$thing->{"_map_$_->{name}"} = _mk_map($kids,$key);
	242	}
f42065cb	243	}
f42065cb	244	}
0b3f94e0	245	}
f42065cb	246
0b3f94e0	247	if ( $spec->{isRoot} ) {
0b3f94e0	248	push(@{$me->{model}{$spec->{plural}}}, $_) foreach @$things;
f42065cb	249	}
0b3f94e0	250	return $things;
f42065cb	251	} # /closure sub
f42065cb	252
42b5b9b6	253	} # /_mk_get
f42065cb	254
b2a00f50	255	sub _mk_map {
	256	my ($kids,$key) = @_;
	257	my $map = {};
	258	foreach (@$kids) {
	259	$map->{$_->{$key}} = $_ if exists $_->{$key};
	260	}
	261	return $map;
	262	}
	263
42b5b9b6	264	sub get_associations {
	265	my $assoc = shift->_get_associations(@_);
	266	foreach (@$assoc) {
30744474	267	next unless defined $_->{associationEnds}; # Wait until we get all of an association
30744474	268	my @ends = @{$_->{associationEnds}};
42b5b9b6	269	if (@ends != 2) {
	270	warn "Sorry can't handle otherEnd associations with more than 2 ends";
	271	return $assoc;
	272	}
	273	$ends[0]{otherEnd} = $ends[1];
	274	$ends[1]{otherEnd} = $ends[0];
	275	}
	276	return $assoc;
	277	}
	278
f42065cb	279	1; #===========================================================================
	280
	281
	282	package XML::XPath::Function;
	283
	284	#
	285	# May need to look at doing deref on all paths just to be on the safe side!
	286	#
	287	# Will also want some caching as these calls are expensive as the whole doc
	288	# is used but the same ref will likley be requested lots of times.
	289	#
	290	sub xmiDeref {
	291	my $self = shift;
	292	my ($node, @params) = @_;
6e694599	293	my $nodeset;
f42065cb	294	if (@params > 1) {
	295	die "xmiDeref() function takes one or no parameters\n";
	296	}
	297	elsif (@params) {
6e694599	298	$nodeset = shift(@params);
f42065cb	299	return $nodeset unless $nodeset->size;
	300	$node = $nodeset->get_node(1);
	301	}
	302	die "xmiDeref() needs an Element node."
	303	unless $node->isa("XML::XPath::Node::Element");
	304
6e694599	305	my $id = $node->getAttribute("xmi.idref") \|\| return ($nodeset \|\| $node);
f42065cb	306	return $node->getRootNode->find('//*[@xmi.id="'.$id.'"]');
6e694599	307	# TODO We should use the tag name to search from the source
f42065cb	308	}
	309
	310
	311	# compile please
	312	1;
	313
	314	__END__
	315
	316	=head1 SYNOPSIS
	317
	318	use SQL::Translator::XMI::Parser;
	319	my $xmip = SQL::Translator::XMI::Parser->new( xml => $xml );
	320	my $classes = $xmip->get_classes();
	321
	322	=head1 DESCRIPTION
	323
	324	Parses XMI files (XML version of UML diagrams) to perl data structures and
	325	provides hooks to filter the data down to what you want.
	326
	327	=head2 new
	328
b4b9f867	329	Pass in name/value arg of either C<filename>, C<xml> or C<ioref> for the XMI
	330	data you want to parse.
	331
	332	The version of XMI to use either 1.0 or 1.2 is worked out from the file. You
	333	can also use a C<xmi_version> arg to set it explicitley.
f42065cb	334
	335	=head2 get_* methods
	336
	337	Doc below is for classes method, all the other calls follow this form.
	338
	339	=head2 get_classes( ARGS )
	340
	341	ARGS - Name/Value list of args.
	342
	343	filter => A sub to filter the node to see if we want it. Has the nodes data,
	344	before kids are added, referenced to $_. Should return true if you
	345	want it, false otherwise.
	346
	347	e.g. To find only classes with a "Foo" stereotype.
	348
	349	filter => sub { return $_->{stereotype} eq "Foo"; }
	350
	351	filter_attributes => A filter sub to pass onto get_attributes.
	352
	353	filter_operations => A filter sub to pass onto get_operations.
	354
	355	Returns a perl data structure including all the kids. e.g.
	356
	357	{
	358	'name' => 'Foo',
	359	'visibility' => 'public',
	360	'isActive' => 'false',
	361	'isAbstract' => 'false',
	362	'isSpecification' => 'false',
	363	'stereotype' => 'Table',
	364	'isRoot' => 'false',
	365	'isLeaf' => 'false',
	366	'attributes' => [
	367	{
	368	'name' => 'fooid',
	369	'stereotype' => 'PK',
	370	'datatype' => 'int'
	371	'ownerScope' => 'instance',
	372	'visibility' => 'public',
	373	'initialValue' => undef,
	374	'isSpecification' => 'false',
	375	},
	376	{
	377	'name' => 'name',
	378	'stereotype' => '',
	379	'datatype' => 'varchar'
	380	'ownerScope' => 'instance',
	381	'visibility' => 'public',
	382	'initialValue' => '',
	383	'isSpecification' => 'false',
	384	},
	385	]
	386	'operations' => [
	387	{
	388	'name' => 'magic',
	389	'isQuery' => 'false',
	390	'ownerScope' => 'instance',
	391	'visibility' => 'public',
	392	'isSpecification' => 'false',
	393	'stereotype' => '',
	394	'isAbstract' => 'false',
	395	'isLeaf' => 'false',
	396	'isRoot' => 'false',
	397	'concurrency' => 'sequential'
398	'parameters' => [
399	{
400	'kind' => 'inout',
401	'isSpecification' => 'false',
402	'stereotype' => '',
403	'name' => 'arg1',
404	'datatype' => undef
405	},
406	{
407	'kind' => 'inout',
408	'isSpecification' => 'false',
409	'stereotype' => '',
410	'name' => 'arg2',
411	'datatype' => undef
412	},
413	{
414	'kind' => 'return',
415	'isSpecification' => 'false',
416	'stereotype' => '',
417	'name' => 'return',
418	'datatype' => undef
419	}
420	],
421	}
422	],
423	}
424
425	=head1 XMI XPath Functions
426
93f4a354	427	The Parser adds the following extra XPath functions for use in the Specs.
f42065cb	428
	429	=head2 xmiDeref
	430
	431	Deals with xmi.id/xmi.idref pairs of attributes. You give it an
	432	xPath e.g 'UML:ModelElement.stereotype/UML:stereotype' if the the
	433	tag it points at has an xmi.idref it looks up the tag with that
	434	xmi.id and returns it.
	435
	436	If it doesn't have an xmi.id, the path is returned as normal.
	437
	438	e.g. given
	439
	440	<UML:ModelElement.stereotype>
	441	<UML:Stereotype xmi.idref = 'stTable'/>
	442	</UML:ModelElement.stereotype>
	443	...
	444	<UML:Stereotype xmi.id='stTable' name='Table' visibility='public'
	445	isAbstract='false' isSpecification='false' isRoot='false' isLeaf='false'>
	446	<UML:Stereotype.baseClass>Class</UML:Stereotype.baseClass>
	447	</UML:Stereotype>
	448
	449	Using xmideref(//UML:ModelElement.stereotype/UML:stereotype) would return the
	450	<UML:Stereotype xmi.id = '3b4b1e:f762a35f6b:-7fb6' ...> tag.
	451
	452	Using xmideref(//UML:ModelElement.stereotype/UML:stereotype)/@name would give
	453	"Table".
	454
	455	=head1 SEE ALSO
	456
	457	perl(1).
	458
	459	=head1 TODO
	460
	461	=head1 BUGS
	462
	463	=head1 VERSION HISTORY
	464
	465	=head1 AUTHOR
	466
	467	grommit <mark.addison@itn.co.uk>
	468
f42065cb	469	=cut